diff --git a/vmworkshop-vmarcs/1995/README.md b/vmworkshop-vmarcs/1995/README.md new file mode 100644 index 0000000..d31edc0 --- /dev/null +++ b/vmworkshop-vmarcs/1995/README.md @@ -0,0 +1,3 @@ +## Source + +Code from VMARCs distributed as part of the 1995 VM Workshop. diff --git a/vmworkshop-vmarcs/1995/cray2i95/README.md b/vmworkshop-vmarcs/1995/cray2i95/README.md new file mode 100644 index 0000000..7f5bdb9 --- /dev/null +++ b/vmworkshop-vmarcs/1995/cray2i95/README.md @@ -0,0 +1,68 @@ +# ibm-cray(3,L) - IBM-Cray data conversion + +"", 3 June 1991 + + + + +# Purpose + +Converts arrays of floating point numbers between IBM and Cray data formats. + + + +# Library + +faux, Cornell's Fortran Auxiliary Subroutine Library (libfaux.a) + + + +# Syntax + +``` +call cfdc(ibm, cray, n) + +call cfcd(cray, ibm, n) + +where: + ibm Array of IBM floating point numbers, REAL*8 values. + cray Array of CRAY floating point numbers. + n Number of elements in arrays to convert, integer. +``` + + + +# Description + +cfdc converts floating point double precision numbers to Cray floating point numbers + +cfcd converts floating point Cray numbers to floating point double precision IBM numbers + +Routines are written in VS FORTRAN and thus are available for both CMS and AIX/370 systems. They could be compiled by either 'fortvs' command under VM/CMS or 'fvs' command under AIX/370. + +Precision of the conversion is the best possible. When floating point formats differ in number of bits for mantissa, which affects data precision, the least mantissa bits are rounded. When formats differ in number of bits for exponent, which affects the range of data, the biggest possible value or zero value is assigned if the old number can't be represented. + +Routines convert data in memory and must be invoked with three arguments: input array name, output array name, and number of elements in each of two arrays. When called from a C program, the last parameter must be passed by the pointer. The same variable name can be used for the first and the second arguments. This means that conversion can be done "in place" thus saving memory space, if necessary. + +The table below shows a summary of conversion time per element in microseconds of virtual cpu time on a 3090 J processor. Each entry represents the average value of one thousand conversions of an array with a thousand elements. + +``` +---------------------------------- +| Routine name | Time to convert | +---------------------------------- +| cfdc | 0.83 | +| cfcd | 0.75 | +---------------------------------- +``` + + + +# Notes + +1. Non-normalized numbers with zero exponents are kept intact. + +2. In IBM to CRAY conversion, precision in the mantissa could be lost by rounding off the least significant bits. 0 <= |error| <= .18E-14 (From 5 to 8 least significant bits out of 56 mantissa bits could be rounded.) + +3. CRAY to IBM conversion does not incur the lost of mantissa accuracy. + +4. CRAY values that don't fit IBM standard are converted to either the biggest IBM values (positive or negative) or to zero. diff --git a/vmworkshop-vmarcs/1995/cray2i95/cfcd.assemble b/vmworkshop-vmarcs/1995/cray2i95/cfcd.assemble new file mode 100644 index 0000000..ba1e919 --- /dev/null +++ b/vmworkshop-vmarcs/1995/cray2i95/cfcd.assemble @@ -0,0 +1,119 @@ +* ------------------------------------------------------------------- * +* * +* copyright - virtual machine / system product * +* contains restricted materials of cornell university * +* 5664-167 (c) copyright cornell university 1990 * +* licensed materials - property of cornell university * +* refer to copyright instructions * +* form number g120-2083 * +* ------------------------------------------------------------------- * +* processor - assebmler release 5.0 5/1/83 under aix/370 * +* * +* dependences - none * +* * +* attributes - reenterant * +* * +* entry point - _cfcd_ * +* * +* errors - not found * +* * +* 06/16/89 valery i. garger, technology integration * +* group, cnsf, cornell university * +* ------------------------------------------------------------------- * +* change log: some minor changes and bugs fixed 09/13/89 * +* converted to aix/370 05/01/90 * +* valery garger * +* ------------------------------------------------------------------- * +* convert floating point, cray 64-bit to ibm 64-bit (fortran real*8). * +* call this subroutine by: * +* * +* call cfcd(cray, ibm, n) * +* * +* input: cray array of 64-bit cray floating point numbers. * +* n number of elements in cray to convert, integer. * +* output:ibm array of ibm floating point numbers, real*8 values. * +* * +* format (bits, left to right): | exponent bias: * +* sign exponent mantissa | * +* ibm 1 7 56 | 64 hex * +* cray 1 15 48 | 16384 binary * +* | * +* latency: 1.064 microsecond per conversion of one element * +* on one of the ibm 3090-600e processors. * +* * +* usage notes: * +* 1. cray values that doesn't fit ibm standard are converted to * +* either the biggest ibm values (positive or negative) or to zero. * +* 2. non-normalized numbers with zero exponents are kept intact * +* (suspected to be integer values). * +* 3. conversion does not incur the lost of mantissa accuracy. * +* ------------------------------------------------------------------- * +_cfcd_ csect + entry _cfcd_ + b 34(,15) + dc al1(6+22) + dc cl6'cfcd ' + dc cl22'05-01-90/vesion#1.9' + stm 2,15,x'10'(13) + lr 12,13 + la 11,x'68' + slr 13,11 + st 12,4(13) + lr 12,15 + using _cfcd_,12 +* ----------------------------------------------- + lr 4,2 pointer to n + lr 3,1 pointer to ibm + lr 2,0 pointer to cray + l 4,00(,4) g4: n +next ds 0h do j = 1,n + lm 8,9,00(2) gr8,gr9: for tiss, now intact + lr 6,8 + n 6,=x'80000000' gr6: sign + lr 7,8 + n 7,=x'7fff0000' gr7: exponent + lr 1,8 + n 1,=x'00008000' gr1: nrmbit + or 1,7 + bz done if so, keep intact + n 8,=x'0000ffff' tiss(1) +expon ds 0h + srl 7,16 + s 7,=f'16128' exp = exp - 16384 + 256 + lr 5,7 + n 5,=f'3' .and. last two bits + bz *+8 avoid if mod(exp,4)=0 + a 7,=f'4' +1 to next to two last bits + sra 7,2 see whole new exponent + ltr 7,7 + bnm expos to exponet is positive + sr 8,8 + sr 9,9 + b strsgn store zero w/sign +expos ds 0h exp is pos + c 7,=f'127' + bnp exprng to exponent in a range + l 8,=x'7fffffff' + l 9,=x'ffffffff' + b strsgn +exprng ds 0h + sll 7,24 exponent on place +tissa ds 0h + sldl 8,5 at least on 5 bits left + ltr 5,5 + bnz *+8 + la 5,4 + s 5,=f'1' + bz *+8 + sldl 8,00(5) logically double +store ds 0h + or 8,7 +strsgn or 8,6 +done stm 8,9,00(3) + la 2,8(2) + la 3,8(3) + bct 4,next enddo +* --------- epiloge ----------------------------------------------- +exit lm 2,14,x'78'(13) + br 14 + end \ No newline at end of file diff --git a/vmworkshop-vmarcs/1995/cray2i95/cfdc.assemble b/vmworkshop-vmarcs/1995/cray2i95/cfdc.assemble new file mode 100644 index 0000000..96548dc --- /dev/null +++ b/vmworkshop-vmarcs/1995/cray2i95/cfdc.assemble @@ -0,0 +1,114 @@ +* ------------------------------------------------------------------- * +* * +* copyright - virtual machine / system product * +* contains restricted materials of cornell university * +* 5664-167 (c) copyright cornell university 1990 * +* licensed materials - property of cornell university * +* refer to copyright instructions * +* form number g120-2083 * +* ------------------------------------------------------------------- * +* processor - assembler 5.0 5/1/83 under aix/370 * +* * +* dependences - none * +* * +* attributes - reenterant * +* * +* entry point - _cfdc_ * +* * +* 06/16/89 valery i. garger, technology integration * +* group, cnsf, cornell university * +*-------------------------------------------------------------------- * +* change log: some minor changes and bugs fixed. 09/13/89 * +* converted to aix/370 05/01/90 * +* valery garger * +* ------------------------------------------------------------------- * +* convert floating point numbers from a double precision ibm format * +* to a cray floating point standard. * +* call this subroutine by: * +* * +* call cfdc(ibm, cray, n) * +* * +* input : ibm array of ibm floating point numbers, real*8 values. * +* n number of elements in ibm to convert, integer. * +* output: cray array of cray floating point numbers. * +* * +* format (bits, left to right): | exponent bias: * +* sign exponent mantissa | * +* ibm 1 7 56 | 64 hex * +* cray 1 15 48 | 16384 * +* | * +* latency: 1.288 microseconds per conversion of one element * +* on one of ibm 3090-600e processors. * +* * +* usage notes: * +* 1. non-normalized numbers with zero exponents are kept intact * +* (suspected to be integer values). * +* 2. precision in the mantissa could be lost by rounding off the * +* least significant bits. 0 <= |error| <= .18e-14 * +* (from 5 to 8 least significant bits out of 56 mantissa bits * +* could be rounded.) * +* --------------------------------------------------------------------* +_cfdc_ csect + entry _cfdc_ + b 34(,15) + dc al1(6+22) + dc cl6'cfdc ' + dc cl22'05-01-90/vesion#1.9' + stm 2,15,x'10'(13) + lr 12,13 + la 11,x'68' + slr 13,11 + st 12,4(13) + lr 12,15 + using _cfdc_,12 +* ----------------------------------------------- + lr 4,2 => n + lr 3,1 => cray + lr 2,0 => ibm + l 4,00(,4) n +next ds 0h + lm 8,9,00(2) gr8,gr9 -- tiss, gr8 now ibmf(j) + lr 6,8 + n 6,=x'80000000' gr6 - sign + lr 7,8 + n 7,=x'7f000000' gr7 - exponent + n 8,=x'00ffffff' tiss(1) +tissa ds 0h + lr 10,8 gr10 - ibntiss + lr 11,9 + sldl 10,8 + la 1,1 gr4 - nmrlzd = .true. + la 5,4 k = 4,1,-1 +tishft ds 0h + ltr 10,10 + bm l777 + sldl 10,1 + bct 5,tishft + sr 1,1 nrmlzd = .false. + la 5,4 k = 4 + srdl 10,4 +l777 ds 0h + or 1,7 if(expn == 0 && ^nrmlzd) + bz store + lr 8,10 + lr 9,11 + srdl 8,15 tiss to the place with rounding + al 9,=f'1' + bc 8+4,*+8 branch no carry + al 8,=f'1' propagate the carry + srdl 8,1 to rounded value +exp srl 7,22 pure quadrupled exponent + a 7,=f'16124' - 256 + 16384 - 4 + ar 7,5 + j; i.e. -256 + 16384 - k + 1 + sll 7,16 expn in place +store ds 0h + or 8,7 .or. exponent + or 8,6 .or. sign +done stm 8,9,00(3) + la 2,8(2) + la 3,8(3) + bct 4,next +* --------- epiloge ----------------------------------------------- +exit lm 2,14,x'78'(13) + br 14 + end \ No newline at end of file diff --git a/vmworkshop-vmarcs/1995/cray2i95/ibm-cray.man b/vmworkshop-vmarcs/1995/cray2i95/ibm-cray.man new file mode 100644 index 0000000..24dedac --- /dev/null +++ b/vmworkshop-vmarcs/1995/cray2i95/ibm-cray.man @@ -0,0 +1,67 @@ +.TH IBM-CRAY 3,L "3 June 1991" "" "Faux Library" +.SH NAME +cfdc cfcd - IBM-Cray data conversion +.SH PURPOSE +Converts arrays of floating point numbers between IBM and Cray data formats. +.SH LIBRARY +faux, Cornell's Fortran Auxiliary Subroutine Library (libfaux.a) +.SH SYNTAX +.nf +call cfdc(ibm, cray, n) + +call cfcd(cray, ibm, n) + +where: +ibm Array of IBM floating point numbers, REAL*8 values. +cray Array of CRAY floating point numbers. +n Number of elements in arrays to convert, integer. +.SH DESCRIPTION +cfdc converts floating point double precision numbers to + Cray floating point numbers + +cfcd converts floating point Cray numbers to floating point + double precision IBM numbers + +Routines are written in VS FORTRAN and thus are available for both CMS and +AIX/370 systems. They could be compiled by either 'fortvs' command under +VM/CMS or 'fvs' command under AIX/370. + +Precision of the conversion is the best possible. When floating point formats +differ in number of bits for mantissa, which affects data precision, the least +mantissa bits are rounded. When formats differ in number of bits for +exponent, which affects the range of data, the biggest possible value or zero +value is assigned if the old number can't be represented. + +Routines convert data in memory and must be invoked with three arguments: +input array name, output array name, and number of elements in each of two +arrays. When called from a C program, the last parameter must be passed by +the pointer. The same variable name can be used for the first and the second +arguments. This means that conversion can be done "in place" thus saving +memory space, if necessary. + +The table below shows a summary of conversion time per element in microseconds +of virtual cpu time on a 3090 J processor. Each entry represents the average +value of one thousand conversions of an array with a thousand elements. + + Table + ---------------------------------- + | Routine name | Time to convert | + ---------------------------------- + | cfdc | 0.83 | + | cfcd | 0.75 | + ---------------------------------- +.SH NOTES +1. Non-normalized numbers with zero exponents are kept + intact. + +2. In IBM to CRAY conversion, precision in the mantissa + could be lost by rounding off the least significant + bits. 0 <= |error| <= .18E-14 (From 5 to 8 least sig- + nificant bits out of 56 mantissa bits could be rounded.) + +3. CRAY to IBM conversion does not incur the lost of + mantissa accuracy. + +4. CRAY values that don't fit IBM standard are converted + to either the biggest IBM values (positive or negative) + or to zero. diff --git a/vmworkshop-vmarcs/1995/ieee2i95/README.md b/vmworkshop-vmarcs/1995/ieee2i95/README.md new file mode 100644 index 0000000..fd9b29e --- /dev/null +++ b/vmworkshop-vmarcs/1995/ieee2i95/README.md @@ -0,0 +1,67 @@ +# IBM TO/FROM IEEE FORMAT CONVERSION ROUTINES + +Original: 09/13/89 +Last version: 08/08/90 +vig@eagle.cnsf.cornell.edu + +A set of subroutines callable from Fortran and C programs to convert arrays of floating point numbers between IBM and IEEE formats is available for our users at the CNSF. + +CFSI32 -- convert floating point single precision IBM data format to IEEE 32 bit long format + +CFDI64 -- convert floating point double precision IBM data format to IEEE 64 bit long format + +CFDI32 -- convert floating point double precision IBM data format to IEEE 32 bit long format + +CFI32S -- convert floating point IEEE 32 bit long format to a single precision IBM data format + +CFI64D -- convert floating point IEEE 64 bit long format to a double precision IBM data format + +CFI32D -- convert floating point IEEE 32 bit long format to a double precision IBM data format + +All routines are written in VS FORTRAN and thus are available for both CMS and AIX/370 systems. They could be compiled by either 'fortvs' command under VM/CMS or 'fvs' command under AIX/370. Versions of these same routines written in System/370 Assembly language are also available under both CMS ('hasm' command to compile) and AIX conventions ('as' command to compile) which ensure efficient object code. Versions in C are available for portability with other systems. + +Object code (TEXT) of routines is kept in FORTAUX TXTLIB library for VM/CMS and in usr/local/pp/lib/libfaux.a for AIX/370. Both include codes of routines originally written in System/370 Assembly. + +Precision of the conversion is the best possible. When floating point formats differ in number of bits for mantissa, which affects data precision, the least mantissa bits are rounded (as oppose to truncated). When formats differ in number of bits for exponent, which affects the range of data, the biggest possible value or zero value is assigned if the old number can't be represented. + +Routines convert data in memory and must be invoked with three arguments: input array name, output array name, and number of elements in each of two arrays. When called from a C program, the last parameter must be passed by the pointer. The same variable name can be used for the first and the second arguments. This means that conversion can be done "in place" thus saving memory space, if necessary. + +## EXAMPLE +``` +call cfsi32(ibm, ieee, n) + +where + ibm input array of IBM floating point numbers, REAL*4 values. + n number of elements in ibm to convert, integer. + ieee output array of 32-bit IEEE floating point numbers, single precision. +``` + +## NOTES + + 1. IBM values that do not "fit" to IEEE standard are converted to + either infinite IEEE values (positive or negative) or to zero. + + 2. Non-normalized with zero exponent IBM values are not converted. + + 3. Using CFSI32, CFI32D, CFI64D does not incur the loss of mantissa accuracy. + + Precision in the mantissa could be lost by rounding off from 0 to 3 least significant bits when using CFDI64 and/or CFI32S. + + Precision in the mantissa could be lost by rounding off from from 29 to 32 least significant bits when using CFDI32. + +Details specific to each routine could be found in comments at the top of its source. + +The table below shows a summary of conversion time per element in microseconds of virtual CPU time on a 3090 J processor under VM/CMS. Each entry represents the average value of one thousand conversions of an array with a thousand elements. + +``` + --------------------------------------------------------------------- + | Program name | Assembly version | VS FORTRAN version | C version | + --------------------------------------------------------------------- + | cfi32s | 0.67 | 2.26 | 1.02 | + | cfsi32 | 0.78 | 1.56 | 1.29 | + | cfi32d | 0.64 | 2.97 | 1.25 | + | cfdi32 | 0.98 | 4.09 | 1.53 | + | cfi64d | 0.73 | 3.29 | 3.28 | + | cfdi64 | 0.80 | 3.83 | 3.82 | + --------------------------------------------------------------------- +``` diff --git a/vmworkshop-vmarcs/1995/ieee2i95/begin.copy b/vmworkshop-vmarcs/1995/ieee2i95/begin.copy new file mode 100644 index 0000000..9427b0d --- /dev/null +++ b/vmworkshop-vmarcs/1995/ieee2i95/begin.copy @@ -0,0 +1,107 @@ + MACRO standard entrance +.* +.*------------------------------------------------------------------- * +.* * +.* COPYRIGHT - VAL GARGER, CORNELL NATIONAL SUPERCOMPUTE FACILITY, * +.* (JUNE 1990) CORNELL UNIVERSITY, ITHACA, N. * +.* CONTAINS RESTRICTED MATERIALS OF CORNELL NIVERSITY, * +.* (C) COPYRIGHT CORNELL UNIVERSITY 1990 * +.* * +.*------------------------------------------------------------------- * +.* +&CSECT BEGIN &BASE=13,&TEMP=2,&SAVEA=,&REQU=YES,&LABEL=,&DATE= +.*COPY *** BEGIN *** + GBLA &M + LCLA &L,&D,&T +.* +.* &CSECT = CSECT NAME +.* &BASE = BASE REGISTER /INTEGER/ +.* &TEMP = TEMP REGISTER (FOR SAVE AREA LINKAGE) /INTEGER/ +.* &SAVEA = ADDRESS OF EXTERNALLY DEFINED SAVE AREA /SYMBOL/ +.* &REQU = REGISTER EQUATES INCLUSION /YES OR NO/ +.* &LABEL = LABEL ON SAVEAREA /SYMBOL/ +.* &DATE = ADDITIONAL INFORMATION: DATE, VERSION, ETC. /TEXT/ +.* +&L SETA K'&CSECT +&T SETA K'&DATE +&D SETA ((&L+&T+2)/2)*2+4 +.* + AIF ('&CSECT' EQ '').ERROR1 + AIF ('&REQU' NE 'YES' AND '&REQU' NE 'NO').ERROR2 + AIF (&BASE EQ 13 AND '&SAVEA' NE '').ERROR3 + AIF (&TEMP GE 13 OR &TEMP LE 1).ERROR4 +.* +&CSECT CSECT + USING &CSECT,15 + B &D.(,15) BRANCH AROUND IDENTIFIER + DC AL1(&L+&T) IDENTIFIER LENGTH + DC CL&L.'&CSECT' IDENTIFIER + AIF ('&DATE' EQ '').STM + DC CL&T.'&DATE' DATE OF CODE PREPARATION +.STM ANOP + STM 14,12,12(13) SAVE REGISTERS + AIF ('&SAVEA' EQ '').SAVE + LA &TEMP,&SAVEA LOAD ROUTINE SAVE AREA ADDRESS + AGO .LINK +.* +.SAVE ANOP + CNOP 0,4 + BAS &TEMP,*+76 LOAD SAVE AREA ADDRESS + AIF (&BASE NE 13 OR '&LABEL' NE '').SAREA + AIF ('&LABEL' NE '').SAREA +&M SETA &M+1 +$$SA00&M DC 18F'0' + AGO .LINK +.SAREA ANOP +&LABEL DC 18F'0' SAVE AREA +.* +.LINK ANOP + ST &TEMP,8(,13) LINK ROUTINE SAVE AREA + ST 13,4(,&TEMP) LINK CALLER'S SAVE AREA + LR 13,&TEMP LOAD SAVE AREA ADDRESS + AIF (&BASE EQ 15).REQU + AIF (&BASE NE 13).ALLSET + AIF ('&LABEL' NE '').GIVEN + USING $$SA00&M,&BASE + AGO .DROP +.GIVEN ANOP + USING &LABEL,&BASE +.DROP ANOP + DROP 15 + AGO .REQU +.ALLSET ANOP + LR &BASE,15 LOAD ROUTINE BASE REGISTER + DROP 15 +.* +.USING ANOP + USING &CSECT,&BASE ESTABLISH ROUTINE BASE REGISTER + SPACE +.REQU ANOP + AIF ('&REQU' EQ 'NO').EXIT +R0 EQU 0 SYMBOLIC REGISTER EQUATES +R1 EQU 1 +R2 EQU 2 +R3 EQU 3 +R4 EQU 4 +R5 EQU 5 +R6 EQU 6 +R7 EQU 7 +R8 EQU 8 +R9 EQU 9 +R10 EQU 10 +R11 EQU 11 +R12 EQU 12 +R13 EQU 13 +R14 EQU 14 +R15 EQU 15 + SPACE +.EXIT MEXIT +.* +.ERROR1 MNOTE 30,'NO CSECT NAME PROVIDE' + MEXIT +.ERROR2 MNOTE 30,'INVALID REQU SPECIFICATION' + MEXIT +.ERROR3 MNOTE 50,'INVALID COMBINATION OF BASE AND SAVEA SPECICATIONS' + MEXIT +.ERROR4 MNOTE 30,'ILLEGAL USE OF TEMP REGISTER' + MEND \ No newline at end of file diff --git a/vmworkshop-vmarcs/1995/ieee2i95/cfdi32.assemble b/vmworkshop-vmarcs/1995/ieee2i95/cfdi32.assemble new file mode 100644 index 0000000..a8c2fa6 --- /dev/null +++ b/vmworkshop-vmarcs/1995/ieee2i95/cfdi32.assemble @@ -0,0 +1,224 @@ + TITLE ' Convert Floating Single => IEEE 32 bit long ' CFD00010 + MACRO standard entrance CFD00020 +.* CFD00030 +.*------------------------------------------------------------------- * CFD00040 +.* * CFD00050 +.* COPYRIGHT - VAL GARGER, CORNELL NATIONAL SUPERCOMPUTE FACILITY, * CFD00060 +.* (JUNE 1990) CORNELL UNIVERSITY, ITHACA, N. * CFD00070 +.* CONTAINS RESTRICTED MATERIALS OF CORNELL NIVERSITY, * CFD00080 +.* (C) COPYRIGHT CORNELL UNIVERSITY 1990 * CFD00090 +.* * CFD00100 +.*------------------------------------------------------------------- * CFD00110 +.* CFD00120 +&CSECT BEGIN &BASE=13,&TEMP=2,&SAVEA=,&REQU=YES,&LABEL=,&DATE= CFD00130 +.*COPY *** BEGIN *** CFD00140 + GBLA &M CFD00150 + LCLA &L,&D,&T CFD00160 +.* CFD00170 +.* &CSECT = CSECT NAME CFD00180 +.* &BASE = BASE REGISTER /INTEGER/ CFD00190 +.* &TEMP = TEMP REGISTER (FOR SAVE AREA LINKAGE) /INTEGER/ CFD00200 +.* &SAVEA = ADDRESS OF EXTERNALLY DEFINED SAVE AREA /SYMBOL/ CFD00210 +.* &REQU = REGISTER EQUATES INCLUSION /YES OR NO/ CFD00220 +.* &LABEL = LABEL ON SAVEAREA /SYMBOL/ CFD00230 +.* &DATE = ADDITIONAL INFORMATION: DATE, VERSION, ETC. /TEXT/ CFD00240 +.* CFD00250 +&L SETA K'&CSECT CFD00260 +&T SETA K'&DATE CFD00270 +&D SETA ((&L+&T+2)/2)*2+4 CFD00280 +.* CFD00290 + AIF ('&CSECT' EQ '').ERROR1 CFD00300 + AIF ('&REQU' NE 'YES' AND '&REQU' NE 'NO').ERROR2 CFD00310 + AIF (&BASE EQ 13 AND '&SAVEA' NE '').ERROR3 CFD00320 + AIF (&TEMP GE 13 OR &TEMP LE 1).ERROR4 CFD00330 +.* CFD00340 +&CSECT CSECT CFD00350 + USING &CSECT,15 CFD00360 + B &D.(,15) BRANCH AROUND IDENTIFIER CFD00370 + DC AL1(&L+&T) IDENTIFIER LENGTH CFD00380 + DC CL&L.'&CSECT' IDENTIFIER CFD00390 + AIF ('&DATE' EQ '').STM CFD00400 + DC CL&T.'&DATE' DATE OF CODE PREPARATION CFD00410 +.STM ANOP CFD00420 + STM 14,12,12(13) SAVE REGISTERS CFD00430 + AIF ('&SAVEA' EQ '').SAVE CFD00440 + LA &TEMP,&SAVEA LOAD ROUTINE SAVE AREA ADDRESS CFD00450 + AGO .LINK CFD00460 +.* CFD00470 +.SAVE ANOP CFD00480 + CNOP 0,4 CFD00490 + BAS &TEMP,*+76 LOAD SAVE AREA ADDRESS CFD00500 + AIF (&BASE NE 13 OR '&LABEL' NE '').SAREA CFD00510 + AIF ('&LABEL' NE '').SAREA CFD00520 +&M SETA &M+1 CFD00530 +$$SA00&M DC 18F'0' CFD00540 + AGO .LINK CFD00550 +.SAREA ANOP CFD00560 +&LABEL DC 18F'0' SAVE AREA CFD00570 +.* CFD00580 +.LINK ANOP CFD00590 + ST &TEMP,8(,13) LINK ROUTINE SAVE AREA CFD00600 + ST 13,4(,&TEMP) LINK CALLER'S SAVE AREA CFD00610 + LR 13,&TEMP LOAD SAVE AREA ADDRESS CFD00620 + AIF (&BASE EQ 15).REQU CFD00630 + AIF (&BASE NE 13).ALLSET CFD00640 + AIF ('&LABEL' NE '').GIVEN CFD00650 + USING $$SA00&M,&BASE CFD00660 + AGO .DROP CFD00670 +.GIVEN ANOP CFD00680 + USING &LABEL,&BASE CFD00690 +.DROP ANOP CFD00700 + DROP 15 CFD00710 + AGO .REQU CFD00720 +.ALLSET ANOP CFD00730 + LR &BASE,15 LOAD ROUTINE BASE REGISTER CFD00740 + DROP 15 CFD00750 +.* CFD00760 +.USING ANOP CFD00770 + USING &CSECT,&BASE ESTABLISH ROUTINE BASE REGISTER CFD00780 + SPACE CFD00790 +.REQU ANOP CFD00800 + AIF ('&REQU' EQ 'NO').EXIT CFD00810 +R0 EQU 0 SYMBOLIC REGISTER EQUATES CFD00820 +R1 EQU 1 CFD00830 +R2 EQU 2 CFD00840 +R3 EQU 3 CFD00850 +R4 EQU 4 CFD00860 +R5 EQU 5 CFD00870 +R6 EQU 6 CFD00880 +R7 EQU 7 CFD00890 +R8 EQU 8 CFD00900 +R9 EQU 9 CFD00910 +R10 EQU 10 CFD00920 +R11 EQU 11 CFD00930 +R12 EQU 12 CFD00940 +R13 EQU 13 CFD00950 +R14 EQU 14 CFD00960 +R15 EQU 15 CFD00970 + SPACE CFD00980 +.EXIT MEXIT CFD00990 +.* CFD01000 +.ERROR1 MNOTE 30,'NO CSECT NAME PROVIDE' CFD01010 + MEXIT CFD01020 +.ERROR2 MNOTE 30,'INVALID REQU SPECIFICATION' CFD01030 + MEXIT CFD01040 +.ERROR3 MNOTE 50,'INVALID COMBINATION OF BASE AND SAVEA SPECICATIONS' CFD01050 + MEXIT CFD01060 +.ERROR4 MNOTE 30,'ILLEGAL USE OF TEMP REGISTER' CFD01070 + MEND CFD01080 +* ------------------------------------------------------------------- * CFD01090 +* subroutine cfdi32(ibm, ieee, n) * CFD01100 +* integer n, ibm(2*n), ieee(n) * CFD01110 +*-------------------------------------------------------------------- * CFD01120 +* PROCESSOR - ASSEMBLER H VERSION 2, RELEASE 1, CMS VM/XA. * CFD01130 +* * CFD01140 +* DEPENDENCIES - NONE * CFD01150 +* * CFD01160 +* ATTRIBUTES - SERIALLY REUSABLE * CFD01170 +* * CFD01180 +* ENTRY POINT - CFDI32 * CFD01190 +* * CFD01200 +* STATUS - NEW: 16 June 1989 * CFD01210 +* LAST REVISION: 07 June 1990 * CFD01220 +* * CFD01230 +* Val I. Garger, Technology Integration * CFD01240 +* Group, CNSF, Cornell University * CFD01250 +* * CFD01260 +* vig@cornellf.tn.cornell.edu * CFD01270 +* vig@eagle.cnsf.cornell.edu * CFD01280 +* vig@cornellf.bitnet * CFD01290 +*-------------------------------------------------------------------- * CFD01300 +* * CFD01310 +* COPYRIGHT - VAL GARGER, CORNELL NATIONAL SUPERCOMPUTER FACILITY, * CFD01320 +* (JUNE 1990) CORNELL UNIVERSITY, ITHACA, NY. * CFD01330 +* CONTAINS RESTRICTED MATERIALS OF CORNELL UNIVERSITY, * CFD01340 +* (C) COPYRIGHT CORNELL UNIVERSITY 1990 * CFD01350 +* * CFD01360 +*-------------------------------------------------------------------- * CFD01370 +* Change log: * CFD01380 +* Rounding up is fixed * CFD01390 +* 02 May 1990 Val Garger * CFD01400 +* ------------------------------------------------------------------- * CFD01410 +* Convert floating point, 64-bit IBM to 32-bit IEEE standard. * CFD01420 +* * CFD01430 +* Example: call cfdi32(ibm, ieee, n) * CFD01440 +* * CFD01450 +* input: ibm Array of IBM floating point numbers, REAL*8 values. * CFD01460 +* n Number of elements in ibm to convert, integer. * CFD01470 +* output: ieee Array of 32-bit IEEE floating point numbers, * CFD01480 +* single precision. * CFD01490 +* * CFD01500 +* Format (bits, left to right): | Exponent bias: * CFD01510 +* sign exponent mantissa | * CFD01520 +* IBM 1 7 56 | 64 hex * CFD01530 +* IEEE 1 11 52 | 1023 * CFD01540 +* | * CFD01550 +* Usage notes: * CFD01560 +* 1. Data could be converted "inplace" in which case an ieee array * CFD01570 +* will occupy the first half of ibm data space. * CFD01580 +* 2. IBM values that didn't fit to IEEE standard are converted to * CFD01590 +* either infinite IEEE values (positive or negative) or to zero. * CFD01600 +* 3. Non-normalized with zero exponent values are kept intact. * CFD01610 +* 4. Precision in the mantissa could be lost by rounding off the * CFD01620 +* least significant bits. 0 =< |error| = < 0.3E-7 * CFD01630 +* (29 to 32 least significant bits out of 56 mantissa bits could * CFD01640 +* be rounded.) * CFD01650 +* =================================================================== * CFD01660 +CFDI32 RMODE ANY CFD01670 +CFDI32 AMODE ANY CFD01680 +CFDI32 BEGIN DATE=/5-02-90/version#1.9/ CFD01690 + LM R2,R4,00(R1) CFD01700 + L R11,00(,R4) r11: n CFD01710 + LTR R11,R11 CFD01720 + BZ EXIT CFD01730 +* CFD01740 +NEXT DS 0H CFD01750 + L R8,00(,R2) current number CFD01760 + L R9,04(,R2) CFD01770 + LR R6,R8 CFD01780 + N R6,=X'80000000' r6: sign CFD01790 + LR R7,R8 CFD01800 + N R7,=X'7F000000' r7: exponent CFD01810 + N R8,=X'00FFFFFF' r8-r9: mantissa CFD01820 +* CFD01830 +TISSA DS 0H CFD01840 + SLDL R8,8 CFD01850 + LA R5,4 see if normalized for ieee CFD01860 +TISHFT DS 0H CFD01870 + LTR R8,R8 CFD01880 + SLDL R8,1 CFD01890 + BM TISNRM CFD01900 + BCT R5,TISHFT CFD01910 + SRDL R8,12 denormalized, reload back CFD01920 + B STORE and save as is CFD01930 +TISNRM DS 0H accepted for conversion CFD01940 + SRDL R8,8 tiss to the place with CFD01950 + LA R8,1(R8) rounding: last bit will be CFD01960 + SRDL R8,1 shifted away CFD01970 +* CFD01980 +EXP SRL R7,22 quadruple exponent as is CFD01990 + S R7,=F'134' - 256 + 127 - 5 CFD02000 + AR R7,R5 + j; i.e. -256 + 127 - k(see F) CFD02010 + BNM EXPOS CFD02020 + SR R8,R8 CFD02030 + B STSGN store with sign CFD02040 +EXPOS DS 0H CFD02050 + C R7,=F'255' CFD02060 + BM EXPRDY CFD02070 + LA R7,=F'255' CFD02080 + SR R8,R8 CFD02090 +EXPRDY SLL R7,23 CFD02100 +* CFD02110 +STORE DS 0H CFD02120 + OR R8,R7 .or. exponent CFD02130 +STSGN OR R8,R6 .or. sign CFD02140 +* CFD02150 +DONE ST R8,00(,R3) CFD02160 + LA R2,8(R2) CFD02170 + LA R3,4(R3) CFD02180 + BCT R11,NEXT CFD02190 +* ----------------------------------------------------------------- CFD02200 +EXIT L R13,4(R13) CFD02210 + RETURN (14,12),,RC=0 Reload caller's registers and ret. CFD02220 +* ----------------------------------------------------------------- CFD02230 + END CFD02240 \ No newline at end of file diff --git a/vmworkshop-vmarcs/1995/ieee2i95/cfdi64.assemble b/vmworkshop-vmarcs/1995/ieee2i95/cfdi64.assemble new file mode 100644 index 0000000..bfaf1fa --- /dev/null +++ b/vmworkshop-vmarcs/1995/ieee2i95/cfdi64.assemble @@ -0,0 +1,125 @@ + TITLE ' Convert Floating Double => IEEE 64 bit long ' +* ------------------------------------------------------------------- * +* subroutine cfdi64(ibm, ieee, n) * +* integer n, ibm(2*n), ieee(2*n) * +* ------------------------------------------------------------------- * +* PROCESSOR - ASSEMBLER H, VERSION 2, RELEASE 1 VM/CMS * +* * +* DEPENDENCES - NONE * +* * +* ATTRIBUTES - SERIALLY REUSABLE * +* * +* ENTRY POINT - CFDI64 * +* * +* STATUS - NEW: 16 JUNE 1989 * +* LAST REVISION: 18 JULY 1990 * +* * +* Val I. Garger, Technology Integration * +* Group, CNSF, Cornell University * +* * +* vig@cornellf.tn.cornell.edu * +* vig@eagle.cnsf.cornell.edu * +* vig@cornellf.bitnet * +*-------------------------------------------------------------------- * +* * +* COPYRIGHT - VAL GARGER, CORNELL NATIONAL SUPERCOMPUTER FACILITY, * +* (JUNE 1990) CORNELL UNIVERSITY, ITHACA, NY. * +* CONTAINS RESTRICTED MATERIALS OF CORNELL UNIVERSITY, * +* (C) COPYRIGHT CORNELL UNIVERSITY 1990 * +* * +*-------------------------------------------------------------------- * +* Change log: * +* ------------------------------------------------------------------- * +* Convert floating point, 64-bit IBM to 64-bit IEEE standard * +* * +* Example: call cfdi64(ibm , ieee, n) * +* * +* input: ibm Array of IBM floating point numbers, REAL*8 values. * +* n Number of elements in ibm to convert, integer. * +* output: ieee Array of 64-bit IEEE floating point numbers, * +* double precision. * +* * +* Format (bits, left to right): | Exponent bias: * +* sign exponent mantissa | * +* IBM 1 7 56 | 64 hex * +* IEEE 1 11 52 | 1023 * +* | * +* Usage notes: * +* 1. Data could be converted "inplace". * +* 2. Non-normalized with zero exponent values are kept intact. * +* 3. Precision in the mantissa could be lost by rounding off the * +* least significant bits. 0 <= |error| <= .56E-16 * +* (From 0 to 3 least significant bits out of 56 mantissa bits * +* could be rounded.) * +* =================================================================== * +CFDI64 RMODE ANY +CFDI64 AMODE ANY +CFDI64 BEGIN DATE=/7-18-90/version#1.9/ + LM R2,R4,00(R1) + L R11,00(,R4) GR11 - numb of elem + LTR R11,R11 + BZ EXIT +NEXT DS 0H + LM R8,R9,00(R2) ibt = ibm(j) + LR R6,R8 + N R6,=X'80000000' sign + LR R7,R8 + N R7,=X'7F000000' exponent + N R8,=X'00FFFFFF' ibt1, GR9 - ibt2 +* + LR R0,R8 if (ibt1 == 0 && ibt2 == 0) + OR R0,R9 + BNE NORM + SR R7,R7 then ibe = 0 also, so store the result + B STORE +* +NORM DS 0H + LTR R0,R7 if (ibe != 0 + BZ TISSA + LR R0,R8 + N R0,=X'00F00000' and yet non-normalized + BNZ TISSA + LM R8,R9,00(R2) then + STM R8,R9,RBT + LD R0,RBT normalize it + AD R0,=D'0.0' + STD R0,RBT + LM R8,R9,RBT and save back in ibt1 & 2 + LR R7,R8 + N R7,=X'7F000000' exponent + N R8,=X'00FFFFFF' ibt1 +* +TISSA DS 0H + SLDL R8,8 + LA R5,4 see for 1 in a first nibble +TISHFT DS 0H + LTR R8,R8 + SLDL R8,1 + BM TISNMR + BCT R5,TISHFT + SRDL R8,12 non-normalized, must be integer + B STORE +TISNMR DS 0H j = 5 - k (see fortran version) + SRDL R8,11 ibt to the place with rounding + AL R9,=F'1' + BC 8+4,*+8 Branch no carry + AL R8,=F'1' Propagate the carry + SRDL R8,1 To rounded value +EXP SRL R7,22 pure quadrupled exponent + A R7,=F'762' - 256 + 1023 - 5 + AR R7,R5 + j; i.e. -256 + 1023 - k + SLL R7,20 +STORE DS 0H + OR R8,R7 .or. exponent + OR R8,R6 .or. sign +DONE STM R8,R9,00(R3) + LA R2,8(R2) + LA R3,8(R3) + BCT R11,NEXT +* ----------------------------------------------------------------- +EXIT L R13,4(R13) epiloge + RETURN (14,12),,RC=0 +* ----------------------------------------------------------------- +RBT DC D'0.0' +* ----------------------------------------------------------------- + END CFDI64 \ No newline at end of file diff --git a/vmworkshop-vmarcs/1995/ieee2i95/cfi32d.assemble b/vmworkshop-vmarcs/1995/ieee2i95/cfi32d.assemble new file mode 100644 index 0000000..00e16b6 --- /dev/null +++ b/vmworkshop-vmarcs/1995/ieee2i95/cfi32d.assemble @@ -0,0 +1,114 @@ + TITLE ' Convert Floating point IEEE, 32 bit length, to Double' +* --------------------------------------------------------------------* +* subroutine cfi32d(ieee, ibm, n) * +* integer n, ieee(n), ibm(2*n) * +* ------------------------------------------------------------------- * +* PROCESSOR - ASSEMBLER H, VERSION 2, RELEASE 1 * +* * +* DEPENDENCES - NONE * +* * +* ATTRIBUTES - SERIALLY REUSABLE * +* * +* ENTRY POINT - CFI32D * +* * +* STATUS - NEW: 16 JUNE 1989 * +* LAST REVISION: 05 MAY 1990 * +* * +* Val I. Garger, Technology Integration * +* Group, CNSF, Cornell University * +* * +* vig@cornellf.tn.cornell.edu * +* vig@eagle.cnsf.cornell.edu * +* vig@cornellf.bitnet * +*-------------------------------------------------------------------- * +* * +* COPYRIGHT - VAL GARGER, CORNELL NATIONAL SUPERCOMPUTER FACILITY, * +* (JUNE 1990) CORNELL UNIVERSITY, ITHACA, NY. * +* CONTAINS RESTRICTED MATERIALS OF CORNELL UNIVERSITY, * +* (C) COPYRIGHT CORNELL UNIVERSITY 1990 * +* * +* ------------------------------------------------------------------- * +* Change log: * +* Small fixes * +* 05/02/90 Val Garger * +* ------------------------------------------------------------------- * +* Convert floating point, IEEE 32-bit to IBM 64-bit (Fortran REAL*8). * +* * +* Example: call cfi32d(ieee, ibm, n) * +* * +* input: ieee Array of 32-bit IEEE floating point numbers, * +* single precision. * +* n Number of elements in ieee to convert, integer. * +* output: ibm Array of IBM floating point numbers, REAL*8 values. * +* * +* Format (bits, left to right): | Exponent bias: * +* sign exponent mantissa | * +* IBM 1 7 56 | 64 hex * +* IEEE 1 8 23 | 127 * +* | * +* Usage notes: * +* 1. Data could be converted "inplace" in which case an ieee array * +* must occupy the first half of ibm data space. * +* 2. Infinite IEEE values are converted to the largest IBM values * +* which are x'7FFFFFFF' and x'FFFFFFFF' for positive and negative * +* respectively. * +* 3. Like infinite values, NaN (Not a Number) values are converted to * +* the largest values. * +* 4. Conversion does not incur the loss of mantissa accuracy. * +* =================================================================== * +CFI32D RMODE ANY +CFI32D AMODE ANY +CFI32D BEGIN DATE=/5-02-90/version#1.9/ prologe + LM R2,R4,00(R1) + L R11,00(,R4) n + LTR R10,R11 + BZ EXIT + BCT R10,*+4 + SLL R10,2 + AR R2,R10 + SLL R10,1 + AR R3,R10 +* +NEXT DS 0H + L R8,00(,R2) ie(1) + LA R9,0 tiss(2) = 0 + LR R6,R8 + N R6,=X'80000000' sign + LR R7,R8 + N R7,=X'7F800000' exponent + BZ DONE if so, keep intact + N R8,=X'007FFFFF' tiss(1) +EXPON DS 0H + C R7,=X'7F800000' is it infinite/Nan ? + BNE EXPINR to EXPonent IN Range if not. + L R8,=X'7FFFFFFF' + L R9,=X'FFFFFFFF' + B STORE +EXPINR DS 0H + SRL R7,1 + A R7,=X'20800000' exp = exp - 127 + 256 + 1 + LR R5,R7 + N R5,=X'00C00000' .and. last two bits + BZ *+8 avoid if mod(exp,4)=0 + A R7,=X'01000000' +1 to next to two last bits + N R7,=X'7F000000' +TISSA DS 0H + O R8,=X'00800000' + SRL R5,22 + LTR R5,R5 + BZ STORE + LA R10,4 + SR R10,R5 + SRDL R8,00(10) logically right double +STORE DS 0H + OR R8,R7 +STRSGN OR R8,R6 +DONE STM R8,R9,00(R3) + SL R2,=F'4' + SL R3,=F'8' + BCT R11,NEXT +* ----------------------------------------------------------------- +EXIT L R13,4(R13) + RETURN (14,12),,RC=0 Epiloge +* ----------------------------------------------------------------- + END CFI32D \ No newline at end of file diff --git a/vmworkshop-vmarcs/1995/ieee2i95/cfi32s.assemble b/vmworkshop-vmarcs/1995/ieee2i95/cfi32s.assemble new file mode 100644 index 0000000..db2d4c0 --- /dev/null +++ b/vmworkshop-vmarcs/1995/ieee2i95/cfi32s.assemble @@ -0,0 +1,111 @@ + TITLE ' Convert Floating point IEEE, 32 bit length, to REAL*4' +* --------------------------------------------------------------------* +* subroutine cfi32s(ieee, ibm, n) * +* integer n, ieee(*), ibm(*) * +* ------------------------------------------------------------------- * +* PROCESSOR - VS ASSEMBLER H, VERSION 2, RELEASE 1. * +* * +* DEPENDENCES - NONE * +* * +* ATTRIBUTES - SERIALLY REUSABLE * +* * +* ENTRY POINT - CFI32S * +* * +* STATUS - NEW: 16 June 1989 * +* LAST REVISION: 07 June 1990 * +* * +* Val I. Garger, Technology Integration * +* Group, CNSF, Cornell University * +* * +* vig@cornellf.tn.cornell.edu * +* vig@eagle.cnsf.cornell.edu * +* vig@cornellf.bitnet * +*-------------------------------------------------------------------- * +* * +* COPYRIGHT - VAL GARGER, CORNELL NATIONAL SUPERCOMPUTER FACILITY, * +* (JUNE 1990) CORNELL UNIVERSITY, ITHACA, NY. * +* CONTAINS RESTRICTED MATERIALS OF CORNELL UNIVERSITY, * +* (C) COPYRIGHT CORNELL UNIVERSITY 1990 * +* * +*-------------------------------------------------------------------- * +* Change log: * +* ------------------------------------------------------------------- * +* Convert floating point, IEEE 32-bit to IBM 32-bit (REAL in Fortran).* +* * +* Example: call cfi32s(ieee, ibm, n) * +* * +* input: ieee Array of 32-bit IEEE floating point numbers, * +* single precision. * +* n Number of elements in ieee to convert, integer. * +* output: ibm Array of IBM floating point numbers, REAL*4 values. * +* * +* Format (bits, left to right): | Exponent bias: * +* sign exponent mantissa | * +* IBM 1 7 24 | 64 hex * +* IEEE 1 8 23 | 127 * +* | * +* Usage notes: * +* 1. Data could be converted "inplace". * +* 2. Infinite IEEE values are converted to the largest IBM values * +* which are x'7FFFFFFF' and x'FFFFFFFF' for positive and negative * +* respectively. * +* 3. Like infinite values, NaN (Not a Number) values are converted to * +* the largest values. * +* 4. Precision in the mantissa could be lost by rounding off the * +* least significant bits. 0 <= |error| <= 0.24E-6 * +* (From 0 to 3 least significant bits out of 24 mantissa bits * +* could be rounded.) * +* =================================================================== * +CFI32S RMODE ANY +CFI32S AMODE ANY +CFI32S BEGIN DATE=/6-01-89/version#1.7/ + LM R2,R4,00(R1) + L R11,00(,R4) numb of elem + LTR R11,R11 + BZ EXIT +NEXT DS 0H + L R9,00(,R2) next element + LR R8,R9 sign + LR R5,R9 exponent + LR R6,R9 mantissa +SIGN N R8,=X'80000000' .and. sign +EXPON SRL R5,23 + N R5,=F'255' see exponent + LTR R5,R5 is it zero? + BZ DONE if so, keep intact + C R5,=F'255' + BNE EXPORD + L R5,=X'7FFFFFFF' the biggest in IBM + B STORE +EXPORD DS 0H it's ordinary exponent + LA R5,130(R5) add 130 to it + LR R7,R5 + N R7,=F'3' + BZ *+8 avoid if mod(exp,4)=0 + LA R5,4(R5) +1 to next to two last bits + SRL R5,2 devide by four + SLL R5,24 exponent on the place +TISSA DS 0H + N R6,=X'007FFFFF' + O R6,=X'00800000' + LTR R7,R7 + BZ STORE + LA R10,3 + SR R10,R7 shift right on (4-R7) + SRL R6,00(R10) logically + LA R6,1(R6) & round + SRL R6,1 mantissa +STORE DS 0H + SR R9,R9 + OR R9,R8 + OR R9,R5 + OR R9,R6 +DONE ST R9,00(,R3) + LA R2,4(R2) + LA R3,4(R3) + BCT R11,NEXT +* ----------------------------------------------------------------- +EXIT L R13,4(R13) + RETURN (14,12),,RC=0 Reload caller's registers and ret. +* ----------------------------------------------------------------- + END CFI32S \ No newline at end of file diff --git a/vmworkshop-vmarcs/1995/ieee2i95/cfi64d.assemble b/vmworkshop-vmarcs/1995/ieee2i95/cfi64d.assemble new file mode 100644 index 0000000..95bed9a --- /dev/null +++ b/vmworkshop-vmarcs/1995/ieee2i95/cfi64d.assemble @@ -0,0 +1,109 @@ + TITLE ' Convert Floating point IEEE, 64 bit length, to Double' +* --------------------------------------------------------------------* +* subroutine cfi64d(ieee, ibm, n) * +* integer n, ieee(2*n), ibm(2*n) * +* ------------------------------------------------------------------- * +* PROCESSOR - ASSEBMLER H, VERSION 2, RELEASE 1 VM/CMS * +* * +* DEPENDENCES - NONE * +* * +* ATTRIBUTES - SERIALLY REUSABLE * +* * +* ENTRY POINT - CFI64D * +* * +* STATUS - NEW: 16 June 1989 * +* LAST REVISION: 05 May 1990 * +* * +* Val I. Garger, Technology Integration * +* Group, CNSF, Cornell University * +* * +* vig@cornellf.tn.cornell.edu * +* vig@eagle.cnsf.cornell.edu * +* vig@cornellf.bitnet * +*-------------------------------------------------------------------- * +* * +* COPYRIGHT - VAL GARGER, CORNELL NATIONAL SUPERCOMPUTER FACILITY, * +* (JUNE 1990) CORNELL UNIVERSITY, ITHACA, NY. * +* CONTAINS RESTRICTED MATERIALS OF CORNELL UNIVERSITY, * +* (C) COPYRIGHT CORNELL UNIVERSITY 1990 * +* * +* ------------------------------------------------------------------- * +* Change log: * +* ------------------------------------------------------------------- * +* Convert floating point, IEEE 64-bit to IBM 64-bit (Fortran REAL*8). * +* * +* Example: call cfi64d(ieee, ibm, n) * +* * +* input: ieee Array of 64-bit IEEE floating point numbers, * +* double precision. * +* n Number of elements in ieee to convert, integer. * +* output: ibm Array of IBM floating point numbers, REAL*8 values. * +* * +* Format (bits, left to right): | Exponent bias: * +* sign exponent mantissa | * +* IBM 1 7 56 | 64 hex * +* IEEE 1 11 52 | 1023 * +* | * +* Usage notes: * +* 1. Data could be converted "inplace". * +* 2. The infinite numbers and NaN (Not a Number) values are converted * +* to the largest IBM values. * +* 3. IEEE values that do not fit to IBM standard are converted to * +* either the biggest IBM values (positive or negative) or to zero. * +* 4. Conversion does not incur the loss of mantissa accuracy. * +* =================================================================== * +CFI64D RMODE ANY +CFI64D AMODE ANY +CFI64D BEGIN DATE=/6-09-89/version#1.8/ prologe + LM R2,R4,00(R1) + L R11,00(,R4) n + LTR R11,R11 + BZ EXIT +NEXT DS 0H + LM R8,R9,00(R2) ie(j) + LR R6,R8 + N R6,=X'80000000' sign + LR R7,R8 + N R7,=X'7FF00000' exponent + BZ DONE if so, keep intact + N R8,=X'000FFFFF' tiss(1) +EXPON DS 0H + S R7,=X'2FE00000' exp = exp - 1023 + 256 + 1 + LR R5,R7 + N R5,=X'00300000' .and. last two bits + BZ *+8 avoid if mod(exp,4)=0 + A R7,=X'00400000' +1 to next to two last bits + N R7,=X'FFC00000' see whole new exponent + LTR R7,R7 + BNM EXPOS to exponet is positive + SR R8,R8 + SR R9,R9 + B STRSGN store zero w/sign +EXPOS DS 0H exp is pos + C R7,=X'1FC00000' ='127' + BNP EXPRNG to exponent in a range + L R8,=X'7FFFFFFF' + L R9,=X'FFFFFFFF' + B STRSGN +EXPRNG DS 0H + SLL R7,2 exponent on the place +TISSA DS 0H + O R8,=X'00100000' + SRA R5,20 + BNZ *+8 + LA R5,4 + S R5,=F'1' + BZ *+8 + SLDL R8,00(5) logically double +STORE DS 0H + OR R8,R7 +STRSGN OR R8,R6 +DONE STM R8,R9,00(R3) + LA R2,8(R2) + LA R3,8(R3) + BCT R11,NEXT +* ----------------------------------------------------------------- +EXIT L R13,4(R13) + RETURN (14,12),,RC=0 Epiloge +* ----------------------------------------------------------------- + END CFI64D \ No newline at end of file diff --git a/vmworkshop-vmarcs/1995/ieee2i95/cfsi32.assemble b/vmworkshop-vmarcs/1995/ieee2i95/cfsi32.assemble new file mode 100644 index 0000000..c0114f9 --- /dev/null +++ b/vmworkshop-vmarcs/1995/ieee2i95/cfsi32.assemble @@ -0,0 +1,126 @@ + TITLE ' Convert IBM Floating Single => IEEE 32 bit long ' +* ------------------------------------------------------------------- * +* subroutine cfsi32(ibm, ieee, n) * +* integer ibm(*), ieee(*), n * +* ------------------------------------------------------------------- * +* PROCESSOR - ASSEMBLER H, VERSION 2, RELEASE 1 * +* * +* DEPENDENCES - NONE * +* * +* ATTRIBUTES - SERIALLY REUSABLE * +* * +* ENTRY POINT - CFSI32 * +* * +* STATUS - NEW: 16 June 1989 * +* LAST REVISION: 19 July 1990 * +* * +* Val I. Garger, Technology Integration * +* Group, CNSF, Cornell University * +* * +* vig@cornellf.tn.cornell.edu * +* vig@eagle.cnsf.cornell.edu * +* vig@cornellf.bitnet * +*-------------------------------------------------------------------- * +* * +* COPYRIGHT - VAL GARGER, CORNELL NATIONAL SUPERCOMPUTER FACILITY, * +* (JUNE 1990) CORNELL UNIVERSITY, ITHACA, NY. * +* CONTAINS RESTRICTED MATERIALS OF CORNELL UNIVERSITY, * +* (C) COPYRIGHT CORNELL UNIVERSITY 1990 * +* * +*-------------------------------------------------------------------- * +* Change log: * +* ------------------------------------------------------------------- * +* Convert floating point, 32-bit IBM to 32-bit IEEE standard. * +* * +* Example: call cfsi32(ibm, ieee, n) * +* * +* input: ibm Array of IBM floating point numbers, REAL*4 values. * +* n Number of elements in ibm to convert, integer. * +* output: ieee Array of 32-bit IEEE floating point numbers, * +* single precision. * +* * +* Format (bits, left to right): | Exponent bias: * +* sign exponent mantissa | * +* IBM 1 7 24 | 64 hex * +* IEEE 1 8 23 | 127 * +* | * +* Usage notes: * +* 1. Data could be converted "inplace". * +* 2. IBM values that do not conform to IEEE standard are converted to * +* either infinite IEEE values (positive or negative) or to zero. * +* 3. Non-normalized with zero exponent values are kept intact. * +* 4. Conversion does not incur the loss of mantissa accuracy. * +* =================================================================== * +CFSI32 RMODE ANY +CFSI32 AMODE ANY +CFSI32 BEGIN DATE=/7-19-90/version#1.9/ + LM R2,R4,00(R1) + L R11,00(,R4) numb of elem + LTR R11,R11 + BZ EXIT +NEXT DS 0H + L R9,00(,R2) next element + LR R8,R9 ibs + LR R5,R9 ibe + LR R6,R9 ibt + N R8,=X'80000000' .and. sign +* + N R6,=X'00FFFFFF' + BNE NRML + SR R5,R5 then ibe = 0 also, so store the result + B STORE +* +NRML DS 0H + N R5,=X'7F000000' + BZ TISSA + LR R0,R6 + N R0,=X'00F00000' and yet non-normalized + BNZ TISSA + ST R9,RBT + LE R0,RBT normalize it + AE R0,=E'0.0' + STE R0,RBT + L R9,RBT + LR R5,R9 + LR R6,R5 +* +TISSA DS 0H + SLL R6,8 + LA R7,4 see for one in a first nibble +TISHFT DS 0H + LTR R6,R6 + SLL R6,1 + BM TISNMR + BCT R7,TISHFT + LR R8,R9 denormalized, reload back + B DONE WITH NEXT +TISNMR DS 0H GR7 keeps (4-numb of zero) + SRL R6,9 tiss in ieee place +EXP SRL R5,22 pure quadrupled exponent + N R5,=X'000001FC' .and. it + S R5,=F'134' - 256 - 4 - 1 + 127 + AR R5,R7 + BNM TRYBIG it's not small, may be big? + LA R5,0 too small, make zero of it + LA R6,0 + B STORE +TRYBIG C R5,=F'255' is too big? + BNP EXPRDY + L R5,=X'7F800000' make +/- infinite of it + LA R6,0 + B STORE +EXPRDY SLL R5,23 +STORE DS 0H + OR R8,R5 + OR R8,R6 +DONE ST R8,00(,R3) + LA R2,4(R2) + LA R3,4(R3) + BCT R11,NEXT +* ----------------------------------------------------------------- +EXIT L R13,4(R13) + RETURN (14,12),,RC=0 Reload caller's registers and ret. +* ----------------------------------------------------------------- +RBT DC E'0.0' +* ----------------------------------------------------------------- + END CFSI32 \ No newline at end of file diff --git a/vmworkshop-vmarcs/1995/laflam95/README.md b/vmworkshop-vmarcs/1995/laflam95/README.md new file mode 100644 index 0000000..c4a9fc0 --- /dev/null +++ b/vmworkshop-vmarcs/1995/laflam95/README.md @@ -0,0 +1,16 @@ +## ORIGINAL README + +``` +Enclosed are my DCF macroes for printing HTML, my PH EXEC and its +associated files, and my EXECs for my SQL based To Do list. + +The PH PACKAGE stuff is production quality. The rest is the basis +for further work. + +Nick Laflamme +The Genix Group +5225 Auto Club Dr. +Dearborn, MI 48126 +(313) 337-4896 +USMCNJRN@IBMMAIL.COM +``` diff --git a/vmworkshop-vmarcs/1995/laflam95/dsmanchr.copy b/vmworkshop-vmarcs/1995/laflam95/dsmanchr.copy new file mode 100644 index 0000000..d76deba --- /dev/null +++ b/vmworkshop-vmarcs/1995/laflam95/dsmanchr.copy @@ -0,0 +1,36 @@ +.* dsmanchr copy +.* anchor for HTML handling +.* OK, look for HREF value. +.se @href = NONE +.gs attval href as @href name as @name +.* +.* Now handle "name=" like GML4 "refid=" handling. +.* That is, if it's a name, set an anchor point. +.* +.se @dc = &@dc + 1 +.* IF &D1@.... EXISTS, GENERATE A STRING CONTAINING THE IDENTIFIER +.se *D = 'D' +.se DR@&@dc = & +.if &E'&D1@&dsm@href eq 0 .an &E'&d1@&dsm@href eq 0 .go unknown +.if &E'&D1@&dsm@href eq 0 .se *D = d +.if &E'&dR@&@dc ne 0 .se *R = d +.el .se *R = D +.su off +.se *cw = &$CW +.dc cw off +.* GENERATE THE TEXT OF THE LIST ITEM REFERENCE +.su on +&&*D.1@&dsm@href..&*r.&$CONT. +.dc cw &*cw +.me +.* IF &D1@.... DOES NOT EXIST, USE A CANNED STRING INSTEAD +...unknown +.* for examples, figures and title pages, SV is already off +.if &@state = Exmpl .or &@state = F .or &@state = TtlPg +.el .sv off +-- &LL@LIun --&$CONT +.el .sv on +.* +.* For href's, if the length is less than eight, it must be internal? +.* For longer than eight, make it a footnote? +.* diff --git a/vmworkshop-vmarcs/1995/laflam95/dsmcntr.copy b/vmworkshop-vmarcs/1995/laflam95/dsmcntr.copy new file mode 100644 index 0000000..52af5c0 --- /dev/null +++ b/vmworkshop-vmarcs/1995/laflam95/dsmcntr.copy @@ -0,0 +1,2 @@ +.* dsmcntr copy +.ce on diff --git a/vmworkshop-vmarcs/1995/laflam95/dsmecntr.copy b/vmworkshop-vmarcs/1995/laflam95/dsmecntr.copy new file mode 100644 index 0000000..b16e8d9 --- /dev/null +++ b/vmworkshop-vmarcs/1995/laflam95/dsmecntr.copy @@ -0,0 +1,2 @@ +.* dsmecntr copy +.ce off diff --git a/vmworkshop-vmarcs/1995/laflam95/dsmnoop.copy b/vmworkshop-vmarcs/1995/laflam95/dsmnoop.copy new file mode 100644 index 0000000..9ef7ba0 --- /dev/null +++ b/vmworkshop-vmarcs/1995/laflam95/dsmnoop.copy @@ -0,0 +1,2 @@ +.* dsmnoop copy +.* diff --git a/vmworkshop-vmarcs/1995/laflam95/fromhtml.script b/vmworkshop-vmarcs/1995/laflam95/fromhtml.script new file mode 100644 index 0000000..3c56f3f --- /dev/null +++ b/vmworkshop-vmarcs/1995/laflam95/fromhtml.script @@ -0,0 +1,33 @@ +.* fromhtml script +.* modeled after DSMPROFx, so imbed that first +.im dsmprof4 +.* following changed 3/16/95 by Nick Laflamme +.dc gml < < / +.* following added 3/16/95 by Nick Laflamme +.dc mcs > +.aa title dsm#cntx dsmnoop +.aa cite dsmcit (noatt) dsmecit +.aa center dsmcntr dsmecntr +.aa html dsmgdoc dsmegdoc +.aa h1 dsmhead1 (noatt) dsmnoop +.aa h2 dsmhead2 (noatt) dsmnoop +.aa h3 dsmhead3 (noatt) dsmnoop +.aa h4 dsmhead4 +.aa h5 dsmhead5 +.aa h6 dsmhead6 +.aa dfn dsmhp1 (noatt) dsmehp +.aa i dsmhp1 (noatt) dsmehp +.aa var dsmhp1 (noatt) dsmehp +.aa b dsmhp2 (noatt) dsmehp +.aa strong dsmhp2 (noatt) dsmehp +.aa kbd dsmhp2 (noatt) dsmehp +.aa samp dsmhp3 (noatt) dsmehp +.aa blockqu dsmlquot (noatt) dsmelqu +.aa head dsmttlep (noatt) dsmettlp +.aa code dsmxmp dsmexmp +.aa pre dsmxmp dsmexmp +.aa tt dsmxmp dsmexmp +.aa body dsmbody (noatt) null +.aa a dsmanchr null +.tr " ' +.* above to fix anchor definitions? Please? diff --git a/vmworkshop-vmarcs/1995/laflam95/moretodo.exec b/vmworkshop-vmarcs/1995/laflam95/moretodo.exec new file mode 100644 index 0000000..6cf2653 --- /dev/null +++ b/vmworkshop-vmarcs/1995/laflam95/moretodo.exec @@ -0,0 +1,122 @@ +/*******************************************************************/ +/* OUC, University of Notre Dame, IRISHVMA */ +/* EXEC Name: LOADTODO EXEC */ +/* Function: Add to VMToDo table from keyboard. */ +/* Author Name: Nick Laflamme */ +/* Date: January, 1992 */ +/* Updates: */ +/*******************************************************************/ + +Signal Prologue + +/* Error Trap for syntax errors */ +Syntax: +rcs = rc +$error="REXX error" rcs "in line" Sigl":" Errortext(rcs) +Say $error +Say "Line" Sigl":" Sourceline(Sigl) +Nop +exit rcs + +/* Error Trap for undefined variables */ +Novalue: +$error = "Novalue error in line" Sigl +say $error +say Sourceline(Sigl) +Trace "?r"; Nop +exit 100 + +Prologue: +signal on Novalue +signal on Syntax +Parse source . intype progfn progfm progft calledas addressee + +/* Get local RSCS machine name */ +"IDENTIFY (STACK" +parse pull me . here . rscsid . + +address command +say "What needs doing?" +parse pull task +if task = '' then + do + say "Nothing, apparently." + exit + end +task = left(task,30) +say "Due when?" +parse pull when . +if when = '' then + drop when +say "How important? (1-5)" +parse pull prio . +if prio = '' then + prio = 3 +say "How long will it take? (1-5)" +parse pull length . +if length = '' then + length = 3 +say "For whom?" +parse pull whom +if whom = '' then + drop whom +else + whom = left(whom,8) +assigned = '19'||translate(date('O'),'-','/') +/* assign I! */ +select2 = "SELECT MAX(TASKNUM) FROM NLAFLAMM.VMTODO" + +'RXSQL PREP SELECT2' select2 /* Prepare the SELECT statement */ +'RXSQL OPEN SELECT2' /* Open the SELECT statement */ +If rc = 0 then + Do /* If no errors occurred then */ + RXC = 0 + Do Forever /* Load REXX variables from SQL/DS */ + + 'RXSQL FETCH SELECT2 :I' + If rc ^= 0 then + Leave /* If there is no more */ + rxc = rxc + 1 + End /* do forever */ + 'RXSQL CLOSE SELECT2' /* Close the SELECT statement */ + End /* RC = 0 */ +'RXSQL COMMIT' /* Commit the transaction */ +'RXSQL PURGE SELECT2' /* Purge Preped statement */ +i = i+1 /* increment */ + +insert_data = 'INSERT INTO NLAFLAMM.VMTODO', + 'VALUES (:Assigned,:due,:prio,:done,:task,:length,:i,:whom)' +'RXSQL PREP STMT1' insert_data + 'RXSQL CALL STMT1' + rxrc = rc + step = "CALL" + call sanity_check + 'RXSQL COMMIT STMT1' + rxrc = rc + step = "COMMIT" + call sanity_check +'RXSQL PURGE STMT1' +rxrc = rc +step = "PURGE" +call sanity_check + +exit + +sanity_check: +select + when rxrc = 8 then + do + say "RXSQL return code:" rxrc step + say "SQLCode:" sqlcode "SQLSTATE:" sqlstate + end + when rxrc < 0 then + do + say "RXSQL return code:" rxrc step + say "SQLCode:" sqlcode + end + when rxrc > 0 then + say "RXSQL return code:" rxrc step + otherwise + nop +end +return diff --git a/vmworkshop-vmarcs/1995/laflam95/ph.helpcms b/vmworkshop-vmarcs/1995/laflam95/ph.helpcms new file mode 100644 index 0000000..5d5c1ae --- /dev/null +++ b/vmworkshop-vmarcs/1995/laflam95/ph.helpcms @@ -0,0 +1,145 @@ +.CM Created June, 1995, by Nick Laflamme +.cm with contributions from John Hammond of UConn +PH EXEC +version 2.57 +June 13, 1995 +.CS BRIEF ON + + PH EXEC does phone book lookups against phone book servers, also known as qi + server, on the Internet. You can view the results either entry by entry or all + at once. + + FORMAT: PH ( + + EXAMPLES: + +-------------------------------------------------------------------+ + |PH | + |PH (HOST host.domain | + |PH first_name middle_initial last_name | + |PH email=userid@host.domain ( HOST host2.domain PORT 106 | + |PH first_name last_name email=userid@host.domain (HOST host3.domain| + |PH last_name email=userid@host.domain (PORT 205 STACK | + |PH part_of_last_name* | + +-------------------------------------------------------------------+ + +.CS BRIEF OFF +.CS DESCRIPT ON + ¢|Description¢% + + ¢|PH¢% (CMS command) + + Use the PH command to issue a query to a phonebook (CSO/qi/ph) server. you + may supply only a name and get local directory information. You may also + supply a host name and port number with the command for a phonebook server at + another site. The default host and port are the phonebook server host name + and port number configured by your site. + + You will be presented with an input screen. Fill in the name of the person + you know for the entry that you wish to view, and then press Enter. If an + entry or entries are found which match your query, they will be displayed in + response. By default, the Name field is searched. + + If you wish to search a different field, chose the keyword associated with + the field name and enter keyword=value and press Enter. Multiple fields may + be entered for the same search. Use "*" as the wildcard character. + + This command is also issued from within Gopher and WWW when you open a menu + entry of type¢|.¢% Gopher and WWW will automatically supply the + correct host name and port number. + +.CS DESCRIPT OFF +.CS FORMAT ON + ¢|Format¢% + + +-------+------------------------------------------------------------------+ + | PH | ( | + +-------+------------------------------------------------------------------+ + +.CS FORMAT OFF +.CS PARMS ON + ¢|Operands¢% + + ¢|whom¢% is the personal name of the person for whom you are searching. It + may also be a keyword=value (e.g. email=userid@host.domain) for other + fields that are searchable or a combination of both. This argument + is optional. + +.CS PARMS OFF +.CS OPTIONS ON + ¢|Options¢% + + ¢|host¢% represents the name or IP address of the desired host. If + omitted, the GLOBALV group PHCMS will be queried for the name HOST + and this used instead. If the name HOST is undefined, then the + default phonebook server configured by your site will be used. + + ¢|port¢% represents the port number to use on the remote host. If + omitted, the GLOBALV group PHCMS will be queried for the name PORT + and this used instead. If the name PORT is undefined, then port 105, + the standard port for a CSO/qi/PH server, will be used. This + argument is optional. + + ¢|STACK¢% entries which are accepted (PF5) by the user will be placed in + the program stack for retrieval by another program. This parameter + is optional. + + ¢|STACKALL¢% entries which are matches will be placed in program stack for + retrieval by another program. This parameter is optional. + + ¢|UNIQUE¢% will either return one entry to the stack or a return code 8 + indicating that the query did not specify only one entry. This + parameter is optional. + +.CS OPTIONS OFF +.CS NOTES ON + ¢|Usage Notes¢% + + 1) When searching for entries that match your query, case is not significant: + upper and lower case letters are treated as equivalent. + +.CS NOTES OFF +.CS ERRORS ON + ¢|Return Codes¢% + + ¢|0¢% The query or command was successful. + + ¢|1¢% The server couldn't find any matches for your query. + + ¢|2¢% The server found more entries that matched your query than it's + allowed to return. This often reflects privacy issues and regulations. + + ¢|3¢% The server rejected your query as being invalid. One common cause of + this is asking for a non-existent field. Remember: there are almost no + standards for what fields are valid.¢% + + ¢|4¢% The response from the server was incomplete and aborted. This is + beyond your control and probably is temporary. + + ¢|5¢% Part of the conversation with the server failed. This is beyond your + control and probably is temporary. + + ¢|6¢% Something in the PH program went very wrong. Tell your systems people + how you got this error and ask them to contact the author. If you are + your systems people, well.... + + ¢|7¢% The user used PF12 to indicate that she or he wishes to break out of + any loop one might be in. + + ¢|8¢% You used the UNIQUE option but got more than one entry from the + server. + + ¢|9¢% The host and port combination you were querying don't seem to be a qi + server. This may have been specified for you by a Gopher or Web client + and may be the result bad data on the Internet. + + ¢|10¢% That PH command, while legal, is not implemented in this client. a + + ¢|100¢%You called PH using old parameters or an old syntax. + +.CS ERRORS OFF +.CS RELATED ON + ¢|Related Help¢% + + Be sure to try the PHMAIL and PH2NAMES commands. + +.CS RELATED OFF diff --git a/vmworkshop-vmarcs/1995/laflam95/ph.package b/vmworkshop-vmarcs/1995/laflam95/ph.package new file mode 100644 index 0000000..d91e623 --- /dev/null +++ b/vmworkshop-vmarcs/1995/laflam95/ph.package @@ -0,0 +1,15 @@ +* +* PH EXEC by Nick Laflamme +* nlaflamm@irishvma.bitnet +* nlaflamm@vma.cc.nd.edu +* USMCNJRN@IBMMAIL.COM +* +PH200 EXEC * For use with RXSOCKET V1 - rename to PH EXEC +PH257 EXEC * For use with RXSOCKET V2 - rename to PH EXEC +PH RELNOTES * Release notes +PHADD XEDIT * Add a recipient in MAILBOOK +PHFORWRD XEDIT * Forward a note in MAILBOOK +PHMAIL EXEC * Start a MAIL command +PH2NAMES EXEC * Build a NAMES file entry +PH HELPCMS * high level help, return codes, etc. +PHSRC HELPCMS * source file for ph helpcms; use helpconv if needed. diff --git a/vmworkshop-vmarcs/1995/laflam95/ph.relnotes b/vmworkshop-vmarcs/1995/laflam95/ph.relnotes new file mode 100644 index 0000000..50d607f --- /dev/null +++ b/vmworkshop-vmarcs/1995/laflam95/ph.relnotes @@ -0,0 +1,98 @@ +11 June 95 + +Bug reports now go to USMCNJRN@IBMMAIL.COM, my new work address. + +PH HELPCMS now exists. Thanks to John Hammond, among others, for sending +me materials that helped me start with more than just a blank file. + +Entries that are longer than your screen can now be scrolled with F10 and +F11. I have to sometimes disable F11 due to a CMS bug that makes the +window disappear. F10 stays active all the time. Sorry! (No, the on +screen menu doesn't reflect that. Maybe in 2.58 or 3.00?) Try + +PH ns-servers (host ns.uiuc.edu + +to see this work! + +F2 now lets you toggle between the traditional formatted data and raw +data. F7 and F8 become inert; use F10 and F11. + +The bug that mixed the results of a FIELDS command with entries 10 through +the end if you used the input panel should be fixed. I think. I hope. +:-) + +Speaking of which, the "help", "fields", and one or two other commands are +now allowed. They no longer get changed to "query help" or "query fields." +If you need to look up M. Fields, use "Fields"; only the lower case +version gets treated as a command. Or use "ph fields" or "query fields" as +your search argument. + +Other minor bugs fixed as found or reported.... + +11 October 1994 + +PH 2.56a + +2.56 didn't handle having "too many hits" returned when invoked +with the STACK option. Whoops. + +For those of you waiting the long rumored 2.57, sorry, this isn't +it, that's why this is 2.56a, to avoid that confusion. + +10 August 1993 + +PH 2.54 + +Error handling in PH 2.50 was wrong; some variables I thought were +automagically set weren't. + +This release also includes a cosmetic change meant to not confuse +Gopher users; PH uses a full screen, not a partial screen, when +invoked under Gopher. (2.53 got this right, 2.52 reversed the +results.) + +Enjoy! + +25 February 1993 + +I, Dominique.P.Laflamme.1@nd.edu, being of reasonably sound mind, do +hereby release releases 2.00 and 2.50 of PH EXEC for CMS. + +2.00 was designed to work with Rick Troth's GOPHER EXEC. It includes +a screen to solicit a query from a user of no arguments are passed. +2.50 is 2.00 for RXSOCKET version 2.0. + +PH now is less fussy about some messages coming back from qi servers. +Thanks to Jim Colten, David Singer, and Yossie Silverman for pointing +out my overspecification of what I was expecting. + +2.00 has most debugging messages removed, compared to, say, 1.97, +which went out with Gopher 2.4. + +The output of the UNIQUE option has changed slightly. Sorry, at some +point I realized I didn't like the form in which I was returning data. + +In PH, HHOST defaults to ns.nd.edu as distributed. Feel free to +customize that and HPORt as necessary. :-) + +Included in PH $PACKAGE is: + +PH EXEC - currently at release 2.00, uses RXSocket version 1. +PH250 EXEC - release 2.50, also known as 2.00 for RXSocket version 2. +PH2NAMES EXEC - build an entry in a names file. + +And, for the RiceMail users in the crowd: + +PHMAIL EXEC +PHADD XEDIT +PHFORWRD XEDIT + +Build MAIL commands, INCLUDE commands, and FORWARD commands. Seperate +names with commas: + +phmail troth, boyes, cc: richard schafer (host ns.rice.edu + +Enjoy! + +Nick Laflamme +nlaflamm@irishvma.bitnet diff --git a/vmworkshop-vmarcs/1995/laflam95/ph250.exec b/vmworkshop-vmarcs/1995/laflam95/ph250.exec new file mode 100644 index 0000000..ae12a65 --- /dev/null +++ b/vmworkshop-vmarcs/1995/laflam95/ph250.exec @@ -0,0 +1,877 @@ +/* ph exec - query name server for person. */ +/* Nick Laflamme - U. of Notre Dame */ +/* Dominique.P.Laflamme.1@nd.edu */ +/* UDM/Nick */ +/* */ +/* based heavily on GOPHER EXEC by Rick Troth, Rice U. */ +/* which in turn relies heavily on Arty Ecoky's RXSOCKET */ +/* May, 1992 */ +/* modified: June 4, 1992: add stack option */ +/* also pull in improvements from FIXAFSID */ +/* modified: September 2, 1992: add UNIQUE, STACKALL, HOST, PORT*/ +/* options, changed calling conventions. */ +/* modified: December 4, 1992 - January 8, 1993: GLOBALV for */ +/* host, port, support for FIELDS and */ +/* fill-in-the-blanks queries */ +/* Adapted: February 8, 1993: Handle more servers. */ +/* modified: February 24, 1993: display host's name */ +/* modified: February 24, 1993: RXSocket 2.0 support */ +/* modified: March 8, 1993: shortened one line length */ +/* modified: May 4, 1993: (2.52) don't use variable window sizes*/ +/* when called using GLOBALV for HOST definition to */ +/* avoid confusion when used under Gopher. */ +/* modified: June 29, 1993: (2.53) 2.52 was exactly wrong. Fix. */ +/* modified: 2 August 1993: (2.54) Better error handling. */ +/* modified: 2 September 1993: (2.55) Allow self-escaping ( */ +/* modified: 13 October 1993: (2.56) Missing terminate in fields*/ +/* Last modified: 11 October 1994: (2.56a) STACK opt RC 2 bombs */ + +/* return codes: */ +/* 0: no problem */ +/* 1: no matches */ +/* 2: too many matches */ +/* 3: bad parameters */ +/* 4: no end of data? */ +/* 5: Read or Write failed */ +/* 6: internal error */ +/* 7: user signalled done */ +/* 8: not unique */ +/* 9: not a qi host */ +/*100: incorrect use/environ */ + +signal prologue /* skip to start of code */ + +/* SYNTAX: and NOVALUE: come first so REXX can always find them */ + +syntax: /* in case of syntax error */ +erc = rc /* preserve error code */ +$error='REXX error' erc 'in line' sigl':' errortext(erc) +say $error /* get excited */ +say "Line" sigl':' sourceline(sigl) /* show offending line */ +trace '?r'; nop /* start trace mode for debug */ +Parse Value Socket('Terminate') With rc . +exit erc + +novalue: +$error='Novalue error in line' sigl +say $error /* get excited */ +say sourceline(sigl) /* show offending line */ +trace '?r'; nop /* start trace mode for debug */ +Parse Value Socket('Terminate') With rc . +exit 100 + +prologue: /* start of real code */ +signal on novalue /* complain about missing vairables */ +signal on syntax /* semi-graceful exit for syntax errors */ +parse source . invocation progfn progft progfm calledas addressee + +parse arg wanthelp . /* check first argument */ +select +when wanthelp='?' then + signal somehelp /* break to explanation */ +when wanthelp='??' then + signal morehelp /* break to long explanation */ +otherwise + nop /* on with life */ +end /* of select on wanthelp */ + +/* trace i */ + +/************* START OF CODE *************************/ + +Address "COMMAND" + +progid = "CMS PH 2.56" /* 2.50: RXSocket V2 */ + +Signal on SYNTAX + +'STATE RXSOCKET MODULE *' +If rc ^= 0 Then Do +Say "You must have RXSOCKET to run" progid +Exit rc +End /* If .. Do */ + +Parse Value Socket('Version') With rc name version date text +If version<2.00 Then Do + Say "PH 2.50 (and later) requires RXSOCKET Version 2" + Exit 100 + End /* If .. Do */ + +'STATE TCPIP DATA *' +If rc ^= 0 Then Do +Say "You must have VM TCP/IP V2 accessed to run" progid +Exit rc +End /* If .. Do */ + +'STATE PIPE MODULE *' +If rc ^= 0 Then Do +Say "You must have CMS Pipelines to run" progid +Exit rc +End /* If .. Do */ + +HHOST = "ns.nd.edu" +HPORT = 105 +unique = 0 /* by default, not looking for just one */ +stackall = 0 /* by default, don't dump all to stack */ +stack = 0 /* not going for stacked output */ +exitrc = 0 /* optimistic default */ +rawdata.0 = 0 +input.0 = 0 +input.current = 1 /* Start with the first line... */ + +/* Parse Arg whom "(" host hport "(" all */ +parse arg args +'PIPE (end \) var args', +'| change /((/{/', +'| a: chop before (', +'| change /{/(/', +'| var whom', +'\ a:', +'| specs 2-* 1', +'| b: chop before ( ', +'| change /{/(/', +'| var optstring', +'\ b: ', +'| specs 2-* 1', /* '| append literal Never mind....', */ +'| change /{/(/', +'| var whoops' +/* Parse Arg whom "(" optstring "(" whoops */ +if whoops /= '' then /* if whoops /= 'Never mind....' then */ +do +say "Calling conventions have changed." +exit 100 +end +optstring = translate(optstring,' ','=') /* allow "=" as whitespace */ +do while optstring /= '' +parse var optstring thisopt optstring +select +when translate(thisopt) = 'HOST' then +parse var optstring hhost optstring +when translate(thisopt) = 'PORT' then +parse var optstring hport optstring +when translate(thisopt) = 'UNIQUE' then +do +stack = 1 +unique = 1 +end +when translate(thisopt) = 'STACK' then +stack = 1 +when translate(thisopt) = 'STACKALL' then +do +stack = 1 +stackall = 1 +end +otherwise +say "Unknown option:" thisopt +end /* select */ +end /* do while optstring isn't null */ + +helpstuff = '"Quit" means leave PH. "Accept" means return this entry.' +helpstuff = helpstuff '"Done" means leave PH and the calling program.' + +/* now check global variables in case this is a Gopher-callee */ +'GLOBALV SELECT PHCMS GET HOST PORT' +if host = '' then +do +host = hhost +varwin = 'VAR' /* PH 2.52 */ +end +else +varwin = '' +if port /= '' then +do +hport = port +end +if hport /= strip(hport) then +do +hport = strip(hport) +end + +if index(host,'.') = 0 then +do +if ^stack then +say "Hostname" host "doesn't contain a period. Is that correct?" +exit 100 +end +if datatype(hport,'W') = 0 then +do +if ^stack then +say hport "isn't a valid port number." +exit 100 +end + +/* +** Initialize RXSOCKET +*/ + +Parse Value Socket('Initialize', 'phCMS') With rc errno +If rc^=0 Then +do +if ^stack then +say "INITIALIZE" errno +exit 5 +end + +/* much of the following is copied from the RXSOCKET help files */ +Parse Value Socket('Socket', 'AF_INET', 'Sock_Stream') With rc s stuff + +If rc /= 0 Then +Do +errno = s stuff +if ^stack then +say "RXSOCKET subfunction Socket returned error" errno +Parse Value Socket('Terminate') With rc . +exit 5 +End + +/* +** Tell RXSOCKET that we want to speak ASCII across this socket +*/ +Parse Value Socket('SetSockOpt', s, 'SOL_SOCKET', 'SO_ASCII', 'On'), +with rc errno +If rc^=0 Then +Do +if ^stack then +say "RXSocket subfunction Socket returned error" errno +Parse Value Socket('Terminate') With rc . +exit 5 +End + +Parse Value Socket('GetHostByName', host) With rc netaddr stuff +if rc /= 0 then +do +if rc = 2053 then +say stuff +else +say "GetHostByName return code:" rc "error:" stuff +Parse Value Socket('Terminate') With rc . +exit 9 +end + +name = "AF_INET" hport netaddr +Parse Value Socket('Connect', s, name) With Crc errno errtext +if crc /= 0 then +do +if crc = 61 then +say hhost hport "apparently isn't a qi server;" errtext +else +say "Connect return code:" crc "error:" errtext +Parse Value Socket('Terminate') With rc . +exit 9 +end + +abort = 0 + +if whom = '' then +call get_target +else +data = "query" whom||'0D25'x||'quit'||'0D25'x + +if abort then /* from input screen */ +do +Parse Value Socket('Terminate') With rc . +exit 7 +end + +Parse Value Socket('Write', s, data) With rc bytes_sent +if rc^=0 then +do +if ^stack then +say "Write failed. Errno:" bytes_sent +Parse Value Socket('Terminate') With rc . +exit 5 +end + +/* Go get the answer: */ +If (readresp(s) <= 0) Then +Do +Say "Read failed, errno:" errno +Parse Value Socket('Terminate') With rc . +exit 5 +End + +"PIPE (end \) stem rawdata.", +"| c: nfind 501:", +"| d: nfind 502:", +"| a: nfind 102", +"| b: nfind 200:", +"| e: nfind 598:", +"| find 500:", +"| f: faninany", +"| count lines", +"| var badquery", +"\ a:", +"| specs word 3 1", +"| var howmany", +"\ b:", +"| count lines", +"| var OK", +"\ c:", +"| count lines", +"| var NotFound", +"\ e:", +"| f:", +"\ d:", +"| count lines", +"| var TooMany" + +If NotFound then +do +if ^stack then +call qsay("Nothing found for" whom 'at' host) +Parse Value Socket('Terminate') With rc . +exit 1 +end + +If TooMany then +do +if ^stack then +do /* 2.56a fix */ +toomuch = "Too many matches for" whom 'at' host +toomuch = toomuch||'; please be more selective.' +call qsay(toomuch) +end /* 2.56a fix */ +Parse Value Socket('Terminate') With rc . +exit 2 +end + +If BadQuery then +do +if ^stack then +call qsay("Query not resolved by" host||"; possibly bad parameters.") +Parse Value Socket('Terminate') With rc . +exit 3 +end + +/* +** Tell RXSOCKET that we are done with this IUCV path +*/ +Parse Value Socket('Terminate') With rc errno +If rc="-1" Then say "RXSocket termination error:" errno + +if stackall then +do +"PIPE stem rawdata. | stack" /* give it all */ +exit +end + +/* Limit the data */ +'PIPE stem rawdata.|', + 'a: find -200:|', + 'stem cooked.|', + 'take last|', + 'change /:/ /|', + 'spec w2|', + 'var howmany' + +if unique then +do +if howmany = 1 then +"PIPE (name NewPH1) stem rawdata.", +"| locate /:1:/", +"| specs 9-* 1", /* strip off line prefixes */ +"| strip both", +"| stack" +else +exitrc = 8 +exit exitrc +end + +do i = 1 to howmany +ph.i. = '' /* set default value */ +"PIPE (name NewPH1) stem cooked.", +"| locate /:"||i||":/", +"| specs 9-* 1", /* strip off line prefixes */ +"| strip trailing", +"| stem ph."||i||'.' +end +ph.0 = howmany + +/* set up windowing environment */ +"QUERY DISPLAY (LIFO" +parse pull . lines cols devtype addrtype dbcs color exthi pss pssets +/* wlines = (lines * .75)%1 +wcols = (cols * .75)%1 +Wpsline = lines%8 +Wpscol = cols%8 */ +wlines = lines-2 /* allow for borders */ +wcols = cols - 4 /* allow for borders again */ +Wpsline = 2 +Wpscol = 3 +Vlines = wlines - 2 +Vcols = wcols - 1 +VProtTop = 1 /* protected lines at top */ +VProtBot = 1 /* protected lines at bottom */ +"WINDOW DEFINE PH" Wlines Wcols Wpsline Wpscol "(BOR" varwin +"VSCREEN DEFINE PH" Vlines Vcols VProtTop VProtBot "(PROT" +"WINDOW SHOW PH ON PH" +"VMFCLEAR" +Flen = length(host) + 1 +"VSCREEN WRITE PH 1" 1 flen "(RES HI PROT FIELD" host + +/* Now we start to display entries, one at a time. */ +i=1 +done = 0 +parse var whom aa ' return ' . +do while ^done +Ftitle = "PH Lookup Entry:" aa i "of" ph.0 +Flen = length(Ftitle) + 1 +Fcol = (vcols-flen)%2 +"VSCREEN WRITE PH 1" fcol flen "(RES HI PROT FIELD" Ftitle +if stack then +select +when ph.0 = 1 then +PFMenu = 'F1: Help F3: Quit F5: Accept F12: Done' +when i = ph.0 then +PFMenu = 'F1: Help F3: Quit F5: Accept F7: Prior F12: Done' +when i = 1 then +PFMenu = 'F1: Help F3: Quit F5: Accept F8: Next F12: Done' +otherwise +PFMenu = 'F1: Help F3: Quit F5: Accept F7: Prior F8: Next F12: Done' +end /* select */ +else +select +when ph.0 = 1 then +PFMenu = 'F1: Help F3: Quit ' +when i = ph.0 then +PFMenu = 'F1: Help F3: Quit F7: Prior ' +when i = 1 then +PFMenu = 'F1: Help F3: Quit F8: Next' +otherwise +PFMenu = 'F1: Help F3: Quit F7: Prior F8: Next' +end /* select */ +"VSCREEN WRITE PH -1 1" length(pfmenu)+1 "(RES FIELD" PFMenu +do j = 1 to ph.i.0 +"VSCREEN WRITE PH" j+1 1 length(ph.i.j)+1 "( HI PROT FIELD" ph.i.j +end /* for each line of entry */ + +if ph.i.0 = 0 then +do +if ^stack then +call qsay("Severe Error: 0 fields present for" i 'at' host) +abort = 1 /* ending early */ +done = 1 +exitrc = 6 +leave +end +else +"VSCREEN WAITREAD PH" /* wait for user input */ +/* now waitread.0 is the variable count, */ +/* waitread.1 is the attention key just used, */ +/* waitread.2 is the cursor position. */ +/* all variables after those are changed fields. */ + +parse var waitread.1 ktype num +select +when (ktype = "PFKEY") & (find("1 13",num) /= 0) then +call qsay(helpstuff) +when (ktype = "PFKEY") & (find("5 17",num) /= 0) then +done = 1 +when (ktype = "PFKEY") & (find("3 15",num) /= 0) then +do +abort = 1 /* ending early */ +done = 1 +end +when (ktype = "PFKEY") & (find("12 24",num) /= 0) then +do +abort = 1 /* ending early */ +done = 1 +if stack then +exitrc = 7 /* really quit */ +end +when (ktype = "PFKEY") & (find("7 19",num) /= 0) then +do +if i > 1 then +i = i-1 +else +call qsay("Already at the first entry.") +end +when (ktype = "PFKEY") & (find("8 20",num) /= 0) then +do +if i < ph.0 then +i = i+1 +else +call qsay("That's the last entry.") +end +when ktype = "PFKEY" then +call qsay("PFKey" num "was used. That's fine, nothing wrong", +"with that, it just doesn't do anything special. ") +otherwise +nop /* no biggie */ +end +if done & ^abort then /* we have a winner.... */ +if stack then +"PIPE STEM PH.I. | stack LIFO" + +"VSCREEN CLEAR PH" + +end /* wander through entries */ + +"WINDOW DELETE PH" +"VSCREEN DELETE PH" + +Exit exitrc + +somehelp: +say 'Give a name and get local directory information.' +exit 100 /* non-zero RC for explanation mode */ + +morehelp: +say 'Give a name and get local directory information.' +say 'By default, it looks for you and returns brief information from' +say 'Notre Dame. Options include who you are looking for, where from,' +say 'and if you want all the server knows about the person.' +say 'Use "*" as the wildcard character.' +say '' +say 'Specify HOST by name, PORT by decimal number. STACK, STACKALL,' +say 'and UNIQUE are other CMS programs to use.' +say '' +say 'To use a "(" in a query, type "(("' +say '' +say 'Syntax:' progfn '{whom} {( {HOST host} {PORT port}' +say '{STACK|STACKALL|UNIQUE} }' +exit 100 + + +Qsay: /* cheap SAY command for fullscreen */ +procedure +parse arg message + +"QUERY DISPLAY (LIFO" +parse pull . lines cols devtype addrtype dbcs color exthi pss pssets +wlines = (lines * .75)%1 +wcols = (cols * .75)%1 +Wpsline = lines%8 +Wpscol = cols%8 +Vlines = wlines - 2 +Vcols = wcols - 1 +VProtTop = 1 /* protected lines at top */ +VProtBot = 1 /* protected lines at bottom */ +"WINDOW DEFINE QUICKIE" Wlines Wcols Wpsline Wpscol "(BOR VAR" +"VSCREEN DEFINE QUICKIE" Vlines Vcols VProtTop VProtBot "(PROT" +"WINDOW SHOW QUICKIE ON QUICKIE" +PFMenu = 'Hit to Continue' +a=(vcols-length(pfmenu))%2 +"VSCREEN WRITE QUICKIE -1" a length(PFMenu)+1 "(RES FIELD" PFMenu +fields = 1 +Field.Row.1 = 1 +Field.title.1 = "Quick Message" +Field.len.1 = length(Field.title.1) + 1 +Field.col.1 = (vcols-field.len.1)%2 +Field.opts.1 = "HI PROT" + +parse var message nextword message +fields = fields + 1 +field.title.fields = '' + +do while nextword ^= '' +if length(nextword) > vcols then +do +say "Too long word:" nextword +say "No message sent." +return +end +if length(nextword) + length(field.title.fields) < vcols then +do +field.title.fields = field.title.fields nextword +parse var message nextword message +end +else +do +fields = fields+1 +field.title.fields = '' +end +end +do i = 2 to fields +Field.Row.i = i +Field.len.i = length(Field.title.i) + 1 +Field.col.i = 1 +Field.opts.i = "HI PROT" +end + +do i = 1 to fields +"VSCREEN WRITE QUICKIE" Field.row.i Field.col.i Field.len.i, + "(" Field.opts.i "FIELD" Field.title.i +if length(field.title.i) >= field.len.i then +say "Trouble: field" i +end +"VSCREEN WAITREAD QUICKIE" /* wait for user input */ + +"VSCREEN CLEAR QUICKIE" +"WINDOW DELETE QUICKIE" +"VSCREEN DELETE QUICKIE" + +return + +get_target: + +data = 'fields'||'0D25'x +Parse Value Socket('Write', s, data) With rc bytes_sent +if rc /= 0 then +do +say "Write failed. Errno:" bytes_sent +Parse Value Socket('Terminate') With rc . +exit 5 +end +if (ReadResp(s) <= 0) Then +do +say "Read failed. Errno:" errno +Parse Value Socket('Terminate') With rc . +exit 5 +end + +"PIPE (end \)", +"| stem rawdata.", +"| b: nfind 200:", +"| e: nfind 598:", +"| find 500:", +"| f: faninany", +"| count lines", +"| var badquery", +"\ b:", +"| count lines", +"| var OK", +"\ e:", +"| f:" + +If BadQuery then +do +say "Severe error: fields query failed at" host +Parse Value Socket('Terminate') With rc . /* 2.56 */ +exit 3 +end + +/* display code goes here. */ +do i = 1 to rawdata.0 +parse var rawdata.i msg ':' id ':' stuff +rawdata.i = msg||':'||right(id,2,'0')||":" stuff +end +'PIPE (end \) stem rawdata. ', +'| sort 1.8', +'| a: unique 1.8 first', +'| locate /Public/', +'| locate /Indexed/', +'| buffer', /* when in doubt.... */ +'| b: lookup 1.8 master', +'| specs 10-* 1', +'| split /:/', +'| pad 9', +'| join / /', +'| stem indices.', +'\ a:', +'| buffer', /* when in doubt.... */ +'| b:', +'| hole' + +stuff.1='Type the name (first, last, nickname or a combination) of the' +stuff.2='person you wish to look up.' +stuff.3='' +stuff.4="Or, for lookups involving information other than the person's" +stuff.5="name, use the following keywords:" + +if (indices.0 <> 0) then + do + stuff.0 = 5 + 'PIPE STEM INDICES. | STEM STUFF. APPEND' + end +else + stuff.0 = 3 + +"QUERY DISPLAY (LIFO" +parse pull . lines cols devtype addrtype dbcs color exthi pss pssets +Pscreen = "PHCMSQ" +Pwindow = "PHCMSQ" +Wlines = lines - 4 +Wcols = cols - 4 +Wpsline = 3 +Wpscol = 3 +Vlines = wlines - 1 +Vcols = wcols - 1 +VProtTop = 1 /* protected lines at top */ +VProtBot = 1 /* protected lines at bottom */ + +"VMFCLEAR" /* clear the screen if possible/easy */ +"WINDOW DEFINE" Pwindow Wlines Wcols Wpsline Wpscol "(BOR VAR" +"VSCREEN DEFINE" Pscreen Vlines Vcols VProtTop VProtBot "(PROT" +"WINDOW SHOW" Pwindow "ON" Pscreen +PFMenu = 'PF Keys: 3: Quit 5: Go 12: Quit' +"VSCREEN WRITE" Pscreen "-1 1" length(PFMenu)+1 "(RES FIELD" PFMenu + +fields = 3 + stuff.0 /* count of currently known fields */ +done = 0 +abort = 0 +qpt1 = '' +qpt2 = '' +/* display host info */ +Flen = length(host) + 1 +"VSCREEN WRITE" pscreen 1 1 flen "(RES HI PROT FIELD" host + +do i = 1 to fields +Field.opts.i = 'PROTECT' +Field.change.i = 1 /* write all lines to ensure state. */ +end +/* now define fields to be used later. */ +Field.Row.1 = 1 +Field.title.1 = "PH Input Screen" +Field.len.1 = length(Field.title.1) + 1 +Field.col.1 = (cols-Field.len.1)%2 +Field.opts.1 = "RES NOHIGH PROTECT" + +Field.row.2 = 3 +Field.col.2 = 3 +Field.title.2 = left(qpt1,65,' ') +Field.len.2 = length(Field.title.2) + 1 +Field.opts.2 = "NOHIGH NOPROTECT" + +Field.row.3 = 4 +Field.col.3 = 3 +Field.len.3 = 66 +Field.title.3 = copies(' ',65) +Field.opts.3 = "NOHIGH NOPROTECT" + +lastrow = 5 /* don't write message lines in row 5 or above. */ + +do i = 1 to stuff.0 +lastrow = lastrow + 1 +j = i+3 +Field.row.j = lastrow +Field.col.j = 3 +Field.Title.j = stuff.i +Field.len.j = length(stuff.i) + 1 +Field.opts.j = "PROTECT HIGH" +end + +/* Set the initial cursor position */ +CurPosRow = Field.row.2 /* start on first query field */ +CurPosCol = Field.col.2 + 1 + +do while done /= 1 +do i = 1 to fields +if Field.change.i then +do +if Field.title.i = '' then +"VSCREEN WRITE" Pscreen Field.row.i Field.col.i Field.len.i, +"(" Field.opts.i +else +"VSCREEN WRITE" Pscreen Field.row.i Field.col.i Field.len.i, +"(" Field.opts.i "FIELD" Field.title.i +Field.change.i = 0 /* Reset flag */ +if length(field.title.i) >= field.len.i then +say "Trouble: field" i +end +end + +"VSCREEN CURSOR" Pscreen CurPosRow CurPosCol +"VSCREEN WAITREAD" Pscreen /* wait for user input */ +/* now waitread.0 is the variable count, */ +/* waitread.1 is the attention key just used, */ +/* waitread.2 is the cursor position. */ +/* all variables after those are changed fields. */ +parse var waitread.1 ktype num +if ktype = "PFKEY" & find("3 12 15 24",num) /= 0 then +do +abort = 1 /* ending early */ +done = 1 +leave /* don't process changes */ +end +if ktype = "CLEAR" then +do +abort = 1 /* ending early */ +done = 1 +leave /* don't process changes */ +end +if ktype = "PFKEY" & find("5 17",num) /= 0 then +done = 1 +if ktype = "ENTER" then +done = 1 + +parse var waitread.2 . CurPosRow CurPosCol . + +DO varcount= 3 to waitread.0 /* changed fields */ +PARSE VAR waitread.varcount KWord ChngRow ChngCol NewVal +SELECT +WHEN ChngRow= 3 THEN /* query pt 1 */ +DO +qpt1 = NewVal +field.change.2 = 1 +field.title.2 = qpt1 +End +WHEN ChngRow= 4 THEN /* query part 2 */ +DO +qpt2 = NewVal +field.change.3 = 1 +field.title.3 = qpt2 +End +OTHERWISE +say "Error: unrecognized changed field." +say waitread.varcount +END /* select on changed fields */ +END /* parse changed fields */ +end /* do while not done loop */ +"VSCREEN CLEAR" Pscreen +"WINDOW DELETE" Pwindow +"VSCREEN DELETE" Pscreen + +whom = strip(qpt1) strip(qpt2) +data = 'query' whom||'0D25'x + +return + +ReadResp: +Procedure expose input. rawdata. errno +Arg s +/* Read from the other end of the socket through a line beginning + with "200" or more. CR/LFs are stripped. Results go into the + "rawdata." stemmed array. Uses the "input." stemmed array as + a work area -- nobody else better play with it! */ + +/* Returns -1 for failure, otherwise 0. */ + +If (^datatype(rawdata.0, 'W')) Then + rawdata.0 = 0 + +buffer = '' + +Do Forever + +/* See if there's anything in input. already to work with: */ +If (datatype(input.current,'W')) Then +Do i = input.current to input.0 +Parse Var input.i code ':' . +'PIPE VAR INPUT.I | STEM RAWDATA. APPEND' +If (datatype(code,'W')) Then +If (code >= 200) Then +Do +input.current = i + 1 +Return code /* Give a secret */ +End +End + +/* Either nothing was there, or we have to read some more. */ +input.0 = 0 /* Guaranteed */ +input.current = 1 /* Starting next time */ +Parse Value Socket('Read', s) With rc bytes_read inbuffer +If rc /= 0 Then +do +errno = bytes_read inbuffer +Return rc /* We're done */ +end +buffer = buffer || inbuffer +"PIPE (end \) var buffer ", +"| deblock linend 25 ", +"| change /" || '0d'x || '//', +"| stem input." + +/* If the buffer didn't end in '25'x, save the last partial line: */ +If (Right(buffer,1) <> '25'x) Then +Do +i = input.0 +buffer = input.i +input.0 = input.0 - 1 +End +Else +buffer = '' + +/* Here we go again! */ + +End diff --git a/vmworkshop-vmarcs/1995/laflam95/ph257.exec b/vmworkshop-vmarcs/1995/laflam95/ph257.exec new file mode 100644 index 0000000..e203ab9 --- /dev/null +++ b/vmworkshop-vmarcs/1995/laflam95/ph257.exec @@ -0,0 +1,1113 @@ +/* ph exec - query name server for person. */ +/* Nick Laflamme - U. of Notre Dame */ +/* Dominique.P.Laflamme.1@nd.edu */ +/* UDM/Nick */ +/* */ +/* based heavily on GOPHER EXEC by Rick Troth, Rice U. */ +/* which in turn relies heavily on Arty Ecoky's RXSOCKET */ +/* May, 1992 */ +/* modified: June 4, 1992: add stack option */ +/* also pull in improvements from FIXAFSID */ +/* modified: September 2, 1992: add UNIQUE, STACKALL, HOST, PORT*/ +/* options, changed calling conventions. */ +/* modified: December 4, 1992 - January 8, 1993: GLOBALV for */ +/* host, port, support for FIELDS and */ +/* fill-in-the-blanks queries */ +/* Adapted: February 8, 1993: Handle more servers. */ +/* modified: February 24, 1993: display host's name */ +/* modified: February 24, 1993: RXSocket 2.0 support */ +/* modified: March 8, 1993: shortened one line length */ +/* modified: May 4, 1993: (2.52) don't use variable window sizes*/ +/* when called using GLOBALV for HOST definition to */ +/* avoid confusion when used under Gopher. */ +/* modified: June 29, 1993: (2.53) 2.52 was exactly wrong. Fix. */ +/* modified: 2 August 1993: (2.54) Better error handling. */ +/* modified: 2 September 1993: (2.55) Allow self-escaping ( */ +/* modified: 13 October 1993: (2.56) Missing terminate in fields*/ +/* modified: 14 February 1994: (2.57) More data than lines? */ +/* modified: 23 March 1994: Finish 2.57. :-) NOT. */ +/* modified: 11 October 1994: (2.56a) Fix rc=2 with (STACK opt */ +/* Last modified: June, 1995: (2.57) Finish 2.57, really. */ + +/* return codes: */ +/* 0: no problem */ +/* 1: no matches */ +/* 2: too many matches */ +/* 3: bad parameters */ +/* 4: no end of data? */ +/* 5: Read or Write failed */ +/* 6: internal error */ +/* 7: user signalled done */ +/* 8: not unique */ +/* 9: not a qi host */ +/*100: incorrect use/environ */ + +signal prologue /* skip to start of code */ + +/* SYNTAX: and NOVALUE: come first so REXX can always find them */ + +syntax: /* in case of syntax error */ +erc = rc /* preserve error code */ +$error='REXX error' erc 'in line' sigl':' errortext(erc) +say $error /* get excited */ +say "Line" sigl':' sourceline(sigl) /* show offending line */ +trace '?r'; nop /* start trace mode for debug */ +Parse Value Socket('Terminate') With rc . +exit erc + +novalue: +$error='Novalue error in line' sigl +say $error /* get excited */ +say sourceline(sigl) /* show offending line */ +trace '?r'; nop /* start trace mode for debug */ +Parse Value Socket('Terminate') With rc . +exit 100 + +prologue: /* start of real code */ +signal on novalue /* complain about missing vairables */ +signal on syntax /* semi-graceful exit for syntax errors */ +parse source . invocation progfn progft progfm calledas addressee + +parse arg wanthelp . /* check first argument */ +select +when wanthelp='?' then + signal somehelp /* break to explanation */ +when wanthelp='??' then + signal morehelp /* break to long explanation */ +otherwise + nop /* on with life */ +end /* of select on wanthelp */ + +/* trace i */ + +/************* START OF CODE *************************/ + +Address "COMMAND" + +progid = "CMS PH 2.57" /* 2.50: RXSocket V2 */ + +Signal on SYNTAX + +'STATE RXSOCKET MODULE *' +If rc ^= 0 Then Do +Say "You must have RXSOCKET to run" progid +Exit rc +End /* If .. Do */ + +Parse Value Socket('Version') With rc name version date text +If version<2.00 Then +Do +Say progid "(and later) requires RXSOCKET Version 2" +Exit 100 +End /* If .. Do */ + +'STATE TCPIP DATA *' +If rc ^= 0 Then +Do +Say "You must have VM TCP/IP V2 accessed to run" progid +Exit rc +End /* If .. Do */ + +'STATE PIPE MODULE *' +If rc ^= 0 Then +Do +Say "You must have CMS Pipelines to run" progid +Exit rc +End /* If .. Do */ + +HHOST = "ns.nd.edu" +HPORT = 105 +unique = 0 /* by default, not looking for just one */ +stackall = 0 /* by default, don't dump all to stack */ +stack = 0 /* not going for stacked output */ +exitrc = 0 /* optimistic default */ +rawdata.0 = 0 +downOK = 1 /* OK initially to scroll forward */ +var = '' +abort = 0 +input.0 = 0 +input.current = 1 /* Start with the first line... */ +newentry = 1 /* 2.57: need to write out new entry or not? */ +rawmode = 0 /* 2.57: by default, an entry at a time */ + +/* Parse Arg whom "(" host hport "(" all */ +parse arg args +'PIPE (end \ name prseargs) var args', +'| change /((/{/', +'| a: chop before (', +'| change /{/(/', +'| var whom', +'\ a:', +'| specs 2-* 1', +'| b: chop before ( ', +'| change /{/(/', +'| var optstring', +'\ b: ', +'| specs 2-* 1', /* '| append literal Never mind....', */ +'| change /{/(/', +'| var whoops' +/* Parse Arg whom "(" optstring "(" whoops */ +if whoops /= '' then /* if whoops /= 'Never mind....' then */ +do +say "Calling conventions have changed." +exit 100 +end +optstring = translate(optstring,' ','=') /* allow "=" as whitespace */ +do while optstring /= '' +parse var optstring thisopt optstring +select +when translate(thisopt) = 'HOST' then +parse var optstring hhost optstring +when translate(thisopt) = 'PORT' then +parse var optstring hport optstring +when translate(thisopt) = 'UNIQUE' then +do +stack = 1 +unique = 1 +end +when translate(thisopt) = 'STACK' then +stack = 1 +when translate(thisopt) = 'VAR' then +var = 'VAR' +when translate(thisopt) = 'NOVAR' then +var = '' +when translate(thisopt) = 'STACKALL' then +do +stack = 1 +stackall = 1 +end +otherwise +say "Unknown option:" thisopt +end /* select */ +end /* do while optstring isn't null */ + +helpstuff = '"Quit" means leave PH. "Accept" means return this entry.' +helpstuff = helpstuff '"Done" means leave PH and the calling program.' + +/* now check global variables in case this is a Gopher-callee */ +'GLOBALV SELECT PHCMS GET HOST PORT' +if host = '' then +do +host = hhost +varwin = 'VAR' /* PH 2.52 */ +end +else +varwin = var +if port /= '' then +do +hport = port +end +if hport /= strip(hport) then +do +hport = strip(hport) +end + +if index(host,'.') = 0 then +do +if ^stack then +say "Hostname" host "doesn't contain a period. Is that correct?" +exit 100 +end +if datatype(hport,'W') = 0 then +do +if ^stack then +say hport "isn't a valid port number." +exit 100 +end + +/* +** Initialize RXSOCKET +*/ + +Parse Value Socket('Initialize', 'phCMS') With rc errno +If rc^=0 Then +do +if ^stack then +say "INITIALIZE" errno +exit 5 +end + +/* much of the following is copied from the RXSOCKET help files */ +Parse Value Socket('Socket', 'AF_INET', 'Sock_Stream') With rc s stuff + +If rc /= 0 Then +Do +errno = s stuff +if ^stack then +say "RXSOCKET subfunction Socket returned error" errno +Parse Value Socket('Terminate') With rc . +exit 5 +End + +/* +** Tell RXSOCKET that we want to speak ASCII across this socket +*/ +Parse Value Socket('SetSockOpt', s, 'SOL_SOCKET', 'SO_ASCII', 'On'), +with rc errno +If rc^=0 Then +Do +if ^stack then +say "RXSocket subfunction Socket returned error" errno +Parse Value Socket('Terminate') With rc . +exit 5 +End + +Parse Value Socket('GetHostByName', host) With rc netaddr stuff +if rc /= 0 then +do +if rc = 2053 then +say stuff +else +say "GetHostByName return code:" rc "error:" stuff +Parse Value Socket('Terminate') With rc . +exit 9 +end + +name = "AF_INET" hport netaddr +Parse Value Socket('Connect', s, name) With Crc errno errtext +if crc /= 0 then +do +if crc = 61 then +say "That system isn't a qi server;" errtext +else +say "Connect return code:" crc "error:" errtext +Parse Value Socket('Terminate') With rc . +exit 9 +end + +abort = 0 + +if whom = '' then +call get_target +else +do /* new logic for 2.57: allow more commands than impled query */ +parse var whom phcomm whom +select +when phcomm = 'query' then +data = "query" whom||'0D25'x||'quit'||'0D25'x +when phcomm = 'ph' then +data = "ph" whom||'0D25'x||'quit'||'0D25'x +when phcomm = 'fields' then +data = phcomm whom||'0D25'x||'quit'||'0D25'x +when phcomm = 'id' then +data = phcomm whom||'0D25'x||'quit'||'0D25'x +when phcomm = 'status' then +data = phcomm whom||'0D25'x||'quit'||'0D25'x +when phcomm = 'help' then +data = phcomm whom||'0D25'x||'quit'||'0D25'x +when phcomm = 'quit' then +do +abort = 1 +exitrc = 10 /* 10: command not supported */ +end +when phcomm = 'stop' then +do +abort = 1 +exitrc = 10 /* 10: command not supported */ +end +when phcomm = 'exit' then +do +abort = 1 +exitrc = 10 /* 10: command not supported */ +end +when phcomm = 'change' then +do +abort = 1 +exitrc = 10 /* 10: command not supported */ +end +when phcomm = 'login' then +do +abort = 1 +exitrc = 10 /* 10: command not supported */ +end +when phcomm = 'answer' then +do +abort = 1 +exitrc = 10 /* 10: command not supported */ +end +when phcomm = 'clear' then +do +abort = 1 +exitrc = 10 /* 10: command not supported */ +end +when phcomm = 'logout' then +do +abort = 1 +exitrc = 10 /* 10: command not supported */ +end +when phcomm = 'add' then +do +abort = 1 +exitrc = 10 /* 10: command not supported */ +end +when phcomm = 'delete' then +do +abort = 1 +exitrc = 10 /* 10: command not supported */ +end +when phcomm = 'set' then +do +abort = 1 +exitrc = 10 /* 10: command not supported */ +end +when phcomm = 'clear' then +do +abort = 1 +exitrc = 10 /* 10: command not supported */ +end +when phcomm = 'logout' then +do +abort = 1 +exitrc = 10 /* 10: command not supported */ +end +otherwise +data = "ph" phcomm whom||'0D25'x||'quit'||'0D25'x +end /* select */ +end /* not input panel */ + +if abort then /* from input screen */ +do +Parse Value Socket('Terminate') With rc . +exit 7 +end + +Parse Value Socket('Write', s, data) With rc bytes_sent +if rc^=0 then +do +if ^stack then +say "Write failed. Errno:" bytes_sent +Parse Value Socket('Terminate') With rc . +exit 5 +end + +/* Go get the answer: */ +If (readresp(s) <= 0) Then +Do +Say "Read failed, errno:" errno +Parse Value Socket('Terminate') With rc . +exit 5 +End + +"PIPE (end \ name goodbad) stem rawdata.", +"| c: nfind 501:", +"| d: nfind 502:", +"| a: nfind 102", +"| b: nfind 200:", +"| e: nfind 598:", +"| find 500:", +"| f: faninany", +"| count lines", +"| var badquery", +"\ a:", +"| specs word 3 1", +"| var howmany", +"\ b:", +"| count lines", +"| var OK", +"\ c:", +"| count lines", +"| var NotFound", +"\ e:", +"| f:", +"\ d:", +"| count lines", +"| var TooMany" + +If NotFound then +do +if ^stack then +do +/* call qsay("Nothing found for" whom 'at' host) */ +/* trace r */ /* 2.57 */ +ph.0 = 1 /* start 2.57 change */ +ph.1.0 = 3 +ph.1.1 = "Nothing found for" +ph.1.2 = whom +ph.1.3 = 'at' host +exitrc = 1 +rawmode = 0 /* just for fun */ +howmany = 1 /* fake it - one message to display */ +end +Parse Value Socket('Terminate') With rc . +/* exit exitrc */ /* end 2.57 change */ +end + +If TooMany then +do +if ^stack then +do +/* toomuch = "Too many matches for" whom 'at' host +toomuch = toomuch||'; please be more selective.' +call qsay(toomuch) */ +ph.0 = 1 /* start 2.57 change */ +ph.1.0 = 4 +ph.1.1 = "Too many matches for" +ph.1.2 = whom +ph.1.3 = 'at' host||'.' +ph.1.4 = 'Please be more selective.' +rawmode = 0 /* just for fun */ +howmany = 1 /* fake it - one message to display */ +end +Parse Value Socket('Terminate') With rc . +exitrc = 2 +end + +If BadQuery then +do +if ^stack then +do +/* qsay("Query not resolved by" host||"; possibly bad parameters.") */ +ph.0 = 1 /* start 2.57 change */ +ph.1.0 = 3 +ph.1.1 = "Query not resolved by" +ph.1.2 = host +ph.1.3 = 'possibly bad parameters.' +rawmode = 0 /* just for fun */ +howmany = 1 /* fake it - one message to display */ +end +exitrc = 3 +end + +/* +** Tell RXSOCKET that we are done with this IUCV path +*/ +Parse Value Socket('Terminate') With rc errno +If rc="-1" Then say "RXSocket termination error:" errno + +if stackall then +do +"PIPE stem rawdata. | stack" /* give it all */ +exit +end + +/* Limit the data */ +if exitrc = 0 then +'PIPE (name entries) stem rawdata.|', +'a: locate /200:/ |', +'stem cooked.|', +'take last 2|', +'take 1|', +'change /:/ /|', +'spec w2|', +'var howmany' + +if unique then +do +if (howmany = 1) & (exitrc = 0) then +"PIPE (name NewPH1) stem rawdata.", +"| locate /:1:/", +"| specs 8-* 1", /* strip off line prefixes */ +"| strip both", /* had been col 9; Drexel bug */ +"| stack" +else +exitrc = 8 +exit exitrc +end + +if exitrc = 0 then /* haven't found trouble yet */ +do +do i = 1 to howmany +ph.i. = '' /* set default value */ +"PIPE (name NewPH2) stem cooked.", +"| locate /:"||i||":/", +"| specs 9-* 1", /* strip off line prefixes */ +"| strip trailing", +"| stem ph."||i||'.' +end +ph.0 = howmany +end /* exitrc = 0 */ + +/* set up windowing environment */ +"QUERY DISPLAY (LIFO" +parse pull . lines cols devtype addrtype dbcs color exthi pss pssets +/* wlines = (lines * .75)%1 +wcols = (cols * .75)%1 +Wpsline = lines%8 +Wpscol = cols%8 */ +wlines = lines-2 /* allow for borders */ +wcols = cols - 4 /* allow for borders again */ +Wpsline = 2 +Wpscol = 3 +/* Vlines = wlines - 2 */ +vlines = rawdata.0+2 /* Maybe a longer VScreen than Window. 2.57 */ +Vcols = wcols - 1 +VProtTop = 1 /* protected lines at top */ +VProtBot = 1 /* protected lines at bottom */ +"WINDOW DEFINE PH" Wlines Wcols Wpsline Wpscol "(BOR" varwin +"VSCREEN DEFINE PH" Vlines Vcols VProtTop VProtBot "(PROT" +"WINDOW SHOW PH ON PH" +"VMFCLEAR" +Flen = length(host) + 1 +"VSCREEN WRITE PH 1" 1 flen "(RES HI PROT FIELD" host + +/* Now we start to display entries, one at a time. */ +i=1 +done = 0 +parse var whom aa ' return ' . +do while ^done +/* 2.57: don't write entry out every time; only when needed */ +if NewEntry then +call ShowEntry + +"VSCREEN WAITREAD PH" /* wait for user input */ +/* now waitread.0 is the variable count, */ +/* waitread.1 is the attention key just used, */ +/* waitread.2 is the cursor position. */ +/* all variables after those are changed fields. */ + +parse var waitread.1 ktype num +select +when (ktype = "PFKEY") & (find("1 13",num) /= 0) then +call qsay(helpstuff) +when (ktype = "PFKEY") & (find("5 17",num) /= 0) & ^(rawmode) then +done = 1 +when (ktype = "PFKEY") & (find("3 15",num) /= 0) then +do +abort = 1 /* ending early */ +done = 1 +end +when (ktype = "PFKEY") & (find("12 24",num) /= 0) then +do +abort = 1 /* ending early */ +done = 1 +if stack then +exitrc = 7 /* really quit */ +end +when (ktype = "PFKEY") & (find("7 19",num) /= 0) & ^(rawmode) then +do /* 2.57 */ +if i > 1 then +do +i = i-1 +newentry = 1 /* 2.57 */ +end +else +call qsay("Already at the first entry.") +end +when (ktype = "PFKEY") & (find("8 20",num) /= 0) & ^(rawmode) then +do +if i < ph.0 then +do +i = i+1 +newentry = 1 /* 2.57 */ +end +else +call qsay("That's the last entry.") +end +when (ktype = "PFKEY") & (find("11 23",num) /= 0) then +do /* 2.57 */ +if downOK then +do +"WINDOW FORWARD PH" +if rc = 1 then +downOK = 0 +else +downOK = 1 +end +end +when (ktype = "PFKEY") & (find("10 22",num) /= 0) then +do /* 2.57 */ +"WINDOW BACKWARD PH" +if rc = 1 then +downOK = 0 +else +downOK = 1 +end +when (ktype = "PFKEY") & (find("2 14",num) /= 0) & ^(rawmode) then +do /* 2.57 */ +call ShowRaw +RawMode = 1 +end +when (ktype = "PFKEY") & (find("2 14",num) /= 0) & rawmode then +do +NewEntry = 1 /* 2.57 */ +RawMode = 0 +end +when ktype = "PFKEY" then +call qsay("PFKey" num "was used. That's fine, nothing wrong", +"with that, it just doesn't do anything special. ") +otherwise +nop /* no biggie */ +end +if done & ^abort then /* we have a winner.... */ +if stack then +"PIPE STEM PH.I. | stack LIFO" + +end /* wander through entries */ + +"WINDOW DELETE PH" +"VSCREEN DELETE PH" + +Exit exitrc + +somehelp: +say progid +say 'Give a name and get local directory information.' +exit 100 /* non-zero RC for explanation mode */ + +morehelp: +say progid +say 'Give a name and get local directory information.' +say 'By default, it looks for you and returns brief information from' +say 'Notre Dame. Options include who you are looking for, where from,' +say 'and if you want all the server knows about the person.' +say 'Use "*" as the wildcard character.' +say '' +say 'Specify HOST by name, PORT by decimal number. STACK, STACKALL,' +say 'and UNIQUE are other CMS programs to use.' +say '' +say 'To use a "(" in a query, type "(("' +say '' +say 'Syntax:' progfn '{whom} {( {HOST host} {PORT port}' +say '{STACK|STACKALL|UNIQUE} }' +exit 100 + + +Qsay: /* cheap SAY command for fullscreen */ +procedure +parse arg message + +"QUERY DISPLAY (LIFO" +parse pull . lines cols devtype addrtype dbcs color exthi pss pssets +wlines = (lines * .75)%1 +wcols = (cols * .75)%1 +Wpsline = lines%8 +Wpscol = cols%8 +Vlines = wlines - 2 +Vcols = wcols - 1 +VProtTop = 1 /* protected lines at top */ +VProtBot = 1 /* protected lines at bottom */ +"WINDOW DEFINE QUICKIE" Wlines Wcols Wpsline Wpscol "(BOR VAR" +"VSCREEN DEFINE QUICKIE" Vlines Vcols VProtTop VProtBot "(PROT" +"WINDOW SHOW QUICKIE ON QUICKIE" +PFMenu = 'Hit to Continue' +a=(vcols-length(pfmenu))%2 +"VSCREEN WRITE QUICKIE -1" a length(PFMenu)+1 "(RES FIELD" PFMenu +fields = 1 +Field.Row.1 = 1 +Field.title.1 = "Quick Message" +Field.len.1 = length(Field.title.1) + 1 +Field.col.1 = (vcols-field.len.1)%2 +Field.opts.1 = "HI PROT" + +parse var message nextword message +fields = fields + 1 +field.title.fields = '' + +do while nextword ^= '' +if length(nextword) > vcols then +do +say "Too long word:" nextword +say "No message sent." +return +end +if length(nextword) + length(field.title.fields) < vcols then +do +field.title.fields = field.title.fields nextword +parse var message nextword message +end +else +do +fields = fields+1 +field.title.fields = '' +end +end +do i = 2 to fields +Field.Row.i = i +Field.len.i = length(Field.title.i) + 1 +Field.col.i = 1 +Field.opts.i = "HI PROT" +end + +do i = 1 to fields +"VSCREEN WRITE QUICKIE" Field.row.i Field.col.i Field.len.i, + "(" Field.opts.i "FIELD" Field.title.i +if length(field.title.i) >= field.len.i then +say "Trouble: field" i +end +"VSCREEN WAITREAD QUICKIE" /* wait for user input */ + +"VSCREEN CLEAR QUICKIE" +"WINDOW DELETE QUICKIE" +"VSCREEN DELETE QUICKIE" + +return + +get_target: + +data = 'fields'||'0D25'x +Parse Value Socket('Write', s, data) With rc bytes_sent +if rc /= 0 then +do +say "Write failed. Errno:" bytes_sent +Parse Value Socket('Terminate') With rc . +exit 5 +end +if (ReadResp(s) <= 0) Then +do +say "Read failed. Errno:" errno +Parse Value Socket('Terminate') With rc . +exit 5 +end + +"PIPE (end \ name findEOD)", +"| stem rawdata.", +"| b: nfind 200:", +"| e: nfind 598:", +"| find 500:", +"| f: faninany", +"| count lines", +"| var badquery", +"\ b:", +"| count lines", +"| var OK", +"\ e:", +"| f:" + +If BadQuery then +do +say "Severe error: fields query failed at" host +Parse Value Socket('Terminate') With rc . /* 2.56 */ +exit 3 +end + +/* display code goes here. */ +do i = 1 to rawdata.0 +parse var rawdata.i msg ':' id ':' stuff +rawdata.i = msg||':'||right(id,2,'0')||":" stuff +end +'PIPE (end \ name getflds) stem rawdata. ', +'| sort 1.8', +'| a: unique 1.8 first', +'| locate /Public/', +'| locate /Indexed/', +'| buffer', /* when in doubt.... */ +'| b: lookup 1.8 master', +'| specs 10-* 1', +'| split /:/', +'| pad 9', +'| join / /', +'| stem indices.', +'\ a:', +'| buffer', /* when in doubt.... */ +'| b:', +'| hole' + +stuff.1='Type the name (first, last, nickname or a combination) of the' +stuff.2='person you wish to look up.' +stuff.3='' +stuff.4="Or, for lookups involving information other than the person's" +stuff.5="name, use the following keywords:" + +if (indices.0 <> 0) then + do + stuff.0 = 5 + 'PIPE STEM INDICES. | STEM STUFF. APPEND' + end +else + stuff.0 = 3 + +"QUERY DISPLAY (LIFO" +parse pull . lines cols devtype addrtype dbcs color exthi pss pssets +Pscreen = "PHCMSQ" +Pwindow = "PHCMSQ" +Wlines = lines - 4 +Wcols = cols - 4 +Wpsline = 3 +Wpscol = 3 +Vlines = wlines - 1 +Vcols = wcols - 1 +VProtTop = 1 /* protected lines at top */ +VProtBot = 1 /* protected lines at bottom */ + +"VMFCLEAR" /* clear the screen if possible/easy */ +"WINDOW DEFINE" Pwindow Wlines Wcols Wpsline Wpscol "(BOR VAR" +"VSCREEN DEFINE" Pscreen Vlines Vcols VProtTop VProtBot "(PROT" +"WINDOW SHOW" Pwindow "ON" Pscreen +PFMenu = 'PF Keys: 3: Quit 5: Go 12: Quit' +"VSCREEN WRITE" Pscreen "-1 1" length(PFMenu)+1 "(RES FIELD" PFMenu + +fields = 3 + stuff.0 /* count of currently known fields */ +done = 0 +abort = 0 +qpt1 = '' +qpt2 = '' +/* display host info */ +Flen = length(host) + 1 +"VSCREEN WRITE" pscreen 1 1 flen "(RES HI PROT FIELD" host + +do i = 1 to fields +Field.opts.i = 'PROTECT' +Field.change.i = 1 /* write all lines to ensure state. */ +end +/* now define fields to be used later. */ +Field.Row.1 = 1 +Field.title.1 = "PH Input Screen" +Field.len.1 = length(Field.title.1) + 1 +Field.col.1 = (cols-Field.len.1)%2 +Field.opts.1 = "RES NOHIGH PROTECT" + +Field.row.2 = 3 +Field.col.2 = 3 +Field.title.2 = left(qpt1,65,' ') +Field.len.2 = length(Field.title.2) + 1 +Field.opts.2 = "NOHIGH NOPROTECT" + +Field.row.3 = 4 +Field.col.3 = 3 +Field.len.3 = 66 +Field.title.3 = copies(' ',65) +Field.opts.3 = "NOHIGH NOPROTECT" + +lastrow = 5 /* don't write message lines in row 5 or above. */ + +do i = 1 to stuff.0 +lastrow = lastrow + 1 +j = i+3 +Field.row.j = lastrow +Field.col.j = 3 +Field.Title.j = stuff.i +Field.len.j = length(stuff.i) + 1 +Field.opts.j = "PROTECT HIGH" +end + +/* Set the initial cursor position */ +CurPosRow = Field.row.2 /* start on first query field */ +CurPosCol = Field.col.2 + 1 + +do while done /= 1 +do i = 1 to fields +if Field.change.i then +do +if Field.title.i = '' then +"VSCREEN WRITE" Pscreen Field.row.i Field.col.i Field.len.i, +"(" Field.opts.i +else +"VSCREEN WRITE" Pscreen Field.row.i Field.col.i Field.len.i, +"(" Field.opts.i "FIELD" Field.title.i +Field.change.i = 0 /* Reset flag */ +if length(field.title.i) >= field.len.i then +say "Trouble: field" i +end +end + +"VSCREEN CURSOR" Pscreen CurPosRow CurPosCol +"VSCREEN WAITREAD" Pscreen /* wait for user input */ +/* now waitread.0 is the variable count, */ +/* waitread.1 is the attention key just used, */ +/* waitread.2 is the cursor position. */ +/* all variables after those are changed fields. */ +parse var waitread.1 ktype num +if ktype = "PFKEY" & find("3 12 15 24",num) /= 0 then +do +abort = 1 /* ending early */ +done = 1 +leave /* don't process changes */ +end +if ktype = "CLEAR" then +do +abort = 1 /* ending early */ +done = 1 +leave /* don't process changes */ +end +if ktype = "PFKEY" & find("5 17",num) /= 0 then +done = 1 +if ktype = "ENTER" then +done = 1 + +parse var waitread.2 . CurPosRow CurPosCol . + +DO varcount= 3 to waitread.0 /* changed fields */ +PARSE VAR waitread.varcount KWord ChngRow ChngCol NewVal +SELECT +WHEN ChngRow= 3 THEN /* query pt 1 */ +DO +qpt1 = NewVal +field.change.2 = 1 +field.title.2 = qpt1 +End +WHEN ChngRow= 4 THEN /* query part 2 */ +DO +qpt2 = NewVal +field.change.3 = 1 +field.title.3 = qpt2 +End +OTHERWISE +say "Error: unrecognized changed field." +say waitread.varcount +END /* select on changed fields */ +END /* parse changed fields */ +end /* do while not done loop */ +"VSCREEN CLEAR" Pscreen +"WINDOW DELETE" Pwindow +"VSCREEN DELETE" Pscreen + +whom = strip(qpt1) strip(qpt2) +data = 'query' whom||'0D25'x +rawdata.0 = 0 /* 2.57: clear out old data */ + +return + +ReadResp: +Procedure expose input. rawdata. errno +Arg s +/* Read from the other end of the socket through a line beginning + with "200" or more. CR/LFs are stripped. Results go into the + "rawdata." stemmed array. Uses the "input." stemmed array as + a work area -- nobody else better play with it! */ + +/* Returns -1 for failure, otherwise 0. */ + +If (^datatype(rawdata.0, 'W')) Then + rawdata.0 = 0 + +buffer = '' + +Do Forever + +/* See if there's anything in input. already to work with: */ +If (datatype(input.current,'W')) Then +Do i = input.current to input.0 +Parse Var input.i code ':' . +'PIPE VAR INPUT.I | STEM RAWDATA. APPEND' +If (datatype(code,'W')) Then +If (code >= 200) Then +Do +input.current = i + 1 +Return code /* Give a secret */ +End +End + +/* Either nothing was there, or we have to read some more. */ +input.0 = 0 /* Guaranteed */ +input.current = 1 /* Starting next time */ +Parse Value Socket('Read', s) With rc bytes_read inbuffer +If rc /= 0 Then +do +errno = bytes_read inbuffer +Return rc /* We're done */ +end +buffer = buffer || inbuffer +"PIPE (end \) var buffer ", +"| deblock linend 25 ", +"| change /" || '0d'x || '//', +"| stem input." + +/* If the buffer didn't end in '25'x, save the last partial line: */ +If (Right(buffer,1) <> '25'x) Then +Do +i = input.0 +buffer = input.i +input.0 = input.0 - 1 +End +Else +buffer = '' + +/* Here we go again! */ + +End + +ShowEntry: +/* new in 2.57: write out a single entry */ + +"VSCREEN CLEAR PH" /* 2.57: start off with a clear screen */ +downOK = 1 /* OK initially to scroll forward */ + +Flen = length(host) + 1 +"VSCREEN WRITE PH 1" 1 flen "(RES HI PROT FIELD" host + +Ftitle = "PH Lookup Entry:" aa i "of" ph.0 +Flen = length(Ftitle) + 1 +Fcol = (vcols-flen)%2 +"VSCREEN WRITE PH 1" fcol flen "(RES HI PROT FIELD" Ftitle +PFMenu = 'F1:Help F2:All F3:Quit F5:Accept F7:Prior F8:Next F10:Up', +'F11:Down F12:Done' + +/* +1 : F1 +9 : F2 +17 : F3 +30 : F5 +35 : F7 +44 : F8, +52 : F10 +59 : F11 +68-75: F12 +PFMenu = overlay(' ',PFMenu,25,9) +PFMenu = overlay('F5:Accept',PFMenu,25) +*/ + +if stack then /* figure for F5, F12 (rewritten at 2.57) */ +do +PFMenu = overlay('F5:Accept',PFMenu,24) +PFMenu = overlay('F12:Done',PFMenu,67) +end +else +do +PFMenu = overlay(' ',PFMenu,24,9) +PFMenu = overlay(' ',PFMenu,67,8) +end + +select /* figure for F7/F8 */ +when (ph.0 = 1) then +PFMenu = overlay(' ',PFMenu,34,17) +when i = ph.0 then +PFMenu = overlay('F7:Prior',PFMenu,34,17) +when i = 1 then +PFMenu = overlay(' F8:Next',PFMenu,34,17) +otherwise +PFMenu = overlay('F7:Prior F8:Next',PFMenu,34,17) +end /* select */ + +"VSCREEN WRITE PH -1 1" length(pfmenu)+1 "(RES FIELD" PFMenu +do j = 1 to ph.i.0 +"VSCREEN WRITE PH" j+1 1 length(ph.i.j)+1 "( HI PROT FIELD" ph.i.j +end /* for each line of entry */ + +if ph.i.0 = 0 then +do +if ^stack then +call qsay("Severe Error: 0 fields present for" i 'at' host) +abort = 1 /* ending early */ +done = 1 +exitrc = 6 +leave +end +newentry = 0 /* current entry is on display */ +Return + +ShowRaw: +/* new in 2.57: write out all data raw */ + +"VSCREEN CLEAR PH" /* 2.57: start off with a clear screen */ +downOK = 1 /* OK initially to scroll forward */ + +Flen = vcols - 1 +"VSCREEN WRITE PH 1" 1 vcols "(RES HI PROT FIELD" copies(' ',flen) +/* yes, the above twists the meaning of flen */ +/* what's your point? Live with it. :-) */ + +Ftitle = "Complete Response from Server" +Flen = length(Ftitle) + 1 +Fcol = (vcols-flen)%2 +"VSCREEN WRITE PH 1" fcol flen "(RES HI PROT FIELD" Ftitle + +PFMenu = 'F1:Help F2:One F3:Quit F10:Up', +'F11:Down ' +"VSCREEN WRITE PH -1 1" length(pfmenu)+1 "(RES FIELD" PFMenu + +do j = 1 to rawdata.0 +"VSCREEN WRITE PH" j+1 1 length(rawdata.j)+1 "(HI PROT FIELD", +rawdata.j +end /* for each line of entry */ + +if ph.i.0 = 0 then +do +if ^stack then +call qsay("Severe Error: 0 fields present for" i 'at' host) +abort = 1 /* ending early */ +done = 1 +exitrc = 6 +leave +end +newentry = 0 /* current entry is on display */ +Return diff --git a/vmworkshop-vmarcs/1995/laflam95/ph2names.exec b/vmworkshop-vmarcs/1995/laflam95/ph2names.exec new file mode 100644 index 0000000..5d9a5d8 --- /dev/null +++ b/vmworkshop-vmarcs/1995/laflam95/ph2names.exec @@ -0,0 +1,212 @@ +/* Look up an entry in ph, build a userid() NAMES entry */ +/* Nick Laflamme - U. of Notre Dame */ +/* Dominique.P.Laflamme.1@nd.edu */ +/* UDM/Nick */ +/* */ +/* July, 1992 */ + +signal prologue /* skip to start of code */ + +/* SYNTAX: and NOVALUE: come first so REXX can always find them */ + +syntax: /* in case of syntax error */ +erc = rc /* preserve error code */ +$error='REXX error' erc 'in line' sigl':' errortext(erc) +say $error /* get excited */ +say "Line" sigl':' sourceline(sigl) /* show offending line */ +trace '?r'; nop /* start trace mode for debug */ +rc = Socket('Terminate') +exit erc + +novalue: +$error='Novalue error in line' sigl +say $error /* get excited */ +say sourceline(sigl) /* show offending line */ +trace '?r'; nop /* start trace mode for debug */ +rc = Socket('Terminate') +exit 100 + +prologue: /* start of real code */ +signal on novalue /* complain about missing vairables */ +signal on syntax /* semi-graceful exit for syntax errors */ +parse source . invocation progfn progft progfm calledas addressee + +parse arg wanthelp . /* check first argument */ +select +when wanthelp='?' then +signal somehelp /* break to explanation */ +when wanthelp='??' then +signal morehelp /* break to long explanation */ +otherwise +nop /* on with life */ +end /* of select on wanthelp */ + +/* trace i */ + +/************* START OF CODE *************************/ + +Address "COMMAND" + +progid = "PH to NAMES .9" /* .9 - getting close now. */ + +Signal on SYNTAX + +'STATE PIPE MODULE *' +If rc ^= 0 Then Do +Say "You must have CMS Pipelines to run" progid +Exit rc +End /* If .. Do */ + +host = '' +namesfile = '' +parse arg whom '(' optstring ')' . +optstring = translate(optstring,' ','=') /* allow "=" as whitespace */ +do while optstring /= '' +parse var optstring thisopt optstring +select +when translate(thisopt) = 'HOST' then +parse var optstring host optstring +when translate(thisopt) = 'FILE' then +parse var optstring namesfile optstring +otherwise +say "Unknown option:" thisopt". Making this the NAMES file name" +namesfile = thisopt +end /* select */ +end /* do while optstring isn't null */ +if namesfile = '' then +namesfile = userid() + +if whom = '' then +do +say "You must specify who you're looking up." +exit 100 +end + +if host = '' then +"EXEC PH" whom "( STACK" /* new - call ph API */ +else +'EXEC PH' whom "( STACK HOST" host +QRC = rc +phdata.0 = 0 +select /* on outcome of QueryCSO */ +when QRC = 5 then /* -1: Read or Write failed */ +call QSAY("Read or write failure on CSO Query.") +when QRC = 0 then /* 0: no problem */ +"PIPE STACK | stem PHDATA." /* read from stack */ +when QRC = 4 then /* 4: no end of data? */ +call qsay("Data end never received.") +when QRC = 3 then /* 3: bad parameters */ +call qsay("Bad parameters passed.") +when QRC = 7 then /* 7: User wants out */ +nop +otherwise /* 1: no matches, 2: too many matches */ +call qsay("No luck on" whom". RC=" QRC) +phdata.0 = 0 +end /* select on QRC */ + +if (QRC /= 0) | (phdata.0 = 0) then /* no answer */ +exit + +"PIPE (end \) STEM PHDATA.", +"| strip leading", +"| a: nfind name", +"| find email:", +"| specs w2 1", +"| c: chop after @", +"| chop @", +"| var userid", +"\ a:", +"| b: chop after :", +"| hole", /* don't want prefix*/ +"\ b:", +"| strip", +"| var name", +"\ c:", +"| var node" +say "What nickname shall you give" name||"?" +parse upper pull nick . +line = ":nick."||nick ":userid."||userid ":node."||node ":name."||name +"PIPE var line | >>" namesfile "NAMES A" + +Exit + +somehelp: +say 'Build CMS Nicknames entries from PH.' +exit 100 /* non-zero RC for explanation mode */ + +morehelp: +say 'Build CMS Nicknames entries from PH.' +say +say +say 'Syntax:' progfn "whom {( namesfile }" +exit 100 + +Qsay: /* cheap SAY command for fullscreen */ +procedure +parse arg message + +"QUERY DISPLAY (LIFO" +parse pull . lines cols devtype addrtype dbcs color exthi pss pssets +wlines = (lines * .75)%1 +wcols = (cols * .75)%1 +Wpsline = lines%8 +Wpscol = cols%8 +Vlines = wlines - 2 +Vcols = wcols - 1 +VProtTop = 0 /* protected lines at top */ +VProtBot = 1 /* protected lines at bottom */ +"WINDOW DEFINE QUICKIE" Wlines Wcols Wpsline Wpscol "(BOR VAR" +"VSCREEN DEFINE QUICKIE" Vlines Vcols VProtTop VProtBot "(PROT" +"WINDOW SHOW QUICKIE ON QUICKIE" +PFMenu = 'Hit to Continue' +a=(vcols-length(pfmenu))%2 +"VSCREEN WRITE QUICKIE -1" a length(PFMenu)+1 "(RES FIELD" PFMenu +fields = 1 +Field.Row.1 = 1 +Field.title.1 = "Quick Message" +Field.len.1 = length(Field.title.1) + 1 +Field.col.1 = (vcols-field.len.1)%2 +Field.opts.1 = "HI PROT" + +parse var message nextword message +fields = fields + 1 +field.title.fields = '' + +do while nextword ^= '' +if length(nextword) > vcols then +do +say "Too long word:" nextword +say "No message sent." +return +end +if length(nextword) + length(field.title.fields) < vcols then +do +field.title.fields = field.title.fields nextword +parse var message nextword message +end +else +do +fields = fields+1 +field.title.fields = '' +end +end +do i = 2 to fields +Field.Row.i = i +Field.len.i = length(Field.title.i) + 1 +Field.col.i = 1 +Field.opts.i = "HI PROT" +end + +do i = 1 to fields +"VSCREEN WRITE QUICKIE" Field.row.i Field.col.i Field.len.i, +"(" Field.opts.i "FIELD" Field.title.i +if length(field.title.i) >= field.len.i then +say "Trouble: field" i +end +"VSCREEN WAITREAD QUICKIE" /* wait for user input */ + +"VSCREEN CLEAR QUICKIE" +"WINDOW DELETE QUICKIE" +"VSCREEN DELETE QUICKIE" + +return diff --git a/vmworkshop-vmarcs/1995/laflam95/phadd.xedit b/vmworkshop-vmarcs/1995/laflam95/phadd.xedit new file mode 100644 index 0000000..718f224 --- /dev/null +++ b/vmworkshop-vmarcs/1995/laflam95/phadd.xedit @@ -0,0 +1,144 @@ +/* Solicit names, build a MAIL INCLUDE command */ +/* Nick Laflamme - U. of Notre Dame */ +/* Dominique.P.Laflamme.1@nd.edu */ +/* UDM/Nick */ +/* */ +/* February, 1993 */ + +signal prologue /* skip to start of code */ + +/* SYNTAX: and NOVALUE: come first so REXX can always find them */ + +syntax: /* in case of syntax error */ +erc = rc /* preserve error code */ +$error='REXX error' erc 'in line' sigl':' errortext(erc) +say $error /* get excited */ +say "Line" sigl':' sourceline(sigl) /* show offending line */ +trace '?r'; nop /* start trace mode for debug */ +rc = Socket('Terminate') +exit erc + +novalue: +$error='Novalue error in line' sigl +say $error /* get excited */ +say sourceline(sigl) /* show offending line */ +trace '?r'; nop /* start trace mode for debug */ +rc = Socket('Terminate') +exit 100 + +prologue: /* start of real code */ +signal on novalue /* complain about missing vairables */ +signal on syntax /* semi-graceful exit for syntax errors */ +parse source . invocation progfn progft progfm calledas addressee + +parse arg wanthelp . /* check first argument */ +select +when wanthelp='?' then + signal somehelp /* break to explanation */ +when wanthelp='??' then + signal morehelp /* break to long explanation */ +otherwise + nop /* on with life */ +end /* of select on wanthelp */ + +/* trace i */ + +/************* START OF CODE *************************/ + +Address "COMMAND" + +progid = "PH to Mail include .91" /* .9 - getting close now. */ + +Signal on SYNTAX + +'STATE PIPE MODULE *' +If rc ^= 0 Then Do +Say "You must have CMS Pipelines to run" progid +Exit rc +End /* If .. Do */ + +host = '' +mailopts = '' /* by default */ +towhom = '' +phdata.0 = 0 +parse arg whomlist '(' optstring ')' . +optstring = translate(optstring,' ','=') /* allow "=" as whitespace */ +do while optstring /= '' +parse var optstring thisopt optstring +select +when translate(thisopt) = 'HOST' then +parse var optstring host optstring +otherwise +mailopts = mailopts thisopt +end /* select */ +end /* do while optstring isn't null */ + +do while whomlist /= '' +parse var whomlist cc whom ',' whomlist +if (translate(cc) = 'CC:') | (translate(cc) = 'BCC:') then + towhom = towhom cc +else + whom = cc whom +if host = '' then +"EXEC PH" whom "( STACK" +else +'EXEC PH' whom "( STACK HOST" host +QRC = rc +select /* on outcome of QueryCSO */ +when QRC = 5 then /* -1: Read or Write failed */ +do +address xedit "MSG Read or write failure on CSO Query." +whomlist = '' +end +when QRC = 0 then /* 0: no problem */ +"PIPE STACK | stem PHDATA." /* read from stack */ +when QRC = 4 then /* 4: no end of data? */ +do +address xedit "MSG Data end never received." +whomlist = '' +end +when QRC = 3 then /* 3: bad parameters */ +do +address xedit "MSG Bad parameters passed." +whomlist = '' +end +when QRC = 1 then /* 1: no matches */ +do +address xedit "MSG No matches; assuming" whom, +"is an e-mail address already." +towhom = towhom whom +end +when QRC = 7 then /* 7: User wants out */ +do +whomlist = '' +phdata.0 = 0 +end +otherwise /* 2: too many matches */ +address xedit "MSG No luck on" whom". RC=" QRC +phdata.0 = 0 +end /* select on QRC */ + +if (phdata.0 /= 0) then /* no answer */ +do +"PIPE (end \) STEM PHDATA.", +"| strip leading", +"| find email:", +"| specs w2 1", +"| var userid" +towhom = towhom userid +end +end /* of whomlist loop */ + +push 'INCLUDE' towhom '(' mailopts +Exit + +somehelp: +say 'Build MAIL command from PH.' +exit 100 /* non-zero RC for explanation mode */ + +morehelp: +say 'Build MAIL command from PH.' +say 'Syntax:' progfn "whom {, {cc:|bcc:} whom2 {,...}} {( options }" +say 'Options: HOST host.some.where | mail_options' +exit 100 + diff --git a/vmworkshop-vmarcs/1995/laflam95/phforwrd.xedit b/vmworkshop-vmarcs/1995/laflam95/phforwrd.xedit new file mode 100644 index 0000000..d72acc6 --- /dev/null +++ b/vmworkshop-vmarcs/1995/laflam95/phforwrd.xedit @@ -0,0 +1,144 @@ +/* Solicit names, build a MAIL INCLUDE command */ +/* Nick Laflamme - U. of Notre Dame */ +/* Dominique.P.Laflamme.1@nd.edu */ +/* UDM/Nick */ +/* */ +/* February, 1993 */ + +signal prologue /* skip to start of code */ + +/* SYNTAX: and NOVALUE: come first so REXX can always find them */ + +syntax: /* in case of syntax error */ +erc = rc /* preserve error code */ +$error='REXX error' erc 'in line' sigl':' errortext(erc) +say $error /* get excited */ +say "Line" sigl':' sourceline(sigl) /* show offending line */ +trace '?r'; nop /* start trace mode for debug */ +rc = Socket('Terminate') +exit erc + +novalue: +$error='Novalue error in line' sigl +say $error /* get excited */ +say sourceline(sigl) /* show offending line */ +trace '?r'; nop /* start trace mode for debug */ +rc = Socket('Terminate') +exit 100 + +prologue: /* start of real code */ +signal on novalue /* complain about missing vairables */ +signal on syntax /* semi-graceful exit for syntax errors */ +parse source . invocation progfn progft progfm calledas addressee + +parse arg wanthelp . /* check first argument */ +select +when wanthelp='?' then + signal somehelp /* break to explanation */ +when wanthelp='??' then + signal morehelp /* break to long explanation */ +otherwise + nop /* on with life */ +end /* of select on wanthelp */ + +/* trace i */ + +/************* START OF CODE *************************/ + +Address "COMMAND" + +progid = "PH to Mail include .91" /* .9 - getting close now. */ + +Signal on SYNTAX + +'STATE PIPE MODULE *' +If rc ^= 0 Then Do +Say "You must have CMS Pipelines to run" progid +Exit rc +End /* If .. Do */ + +host = '' +mailopts = '' /* by default */ +towhom = '' +phdata.0 = 0 +parse arg whomlist '(' optstring ')' . +optstring = translate(optstring,' ','=') /* allow "=" as whitespace */ +do while optstring /= '' +parse var optstring thisopt optstring +select +when translate(thisopt) = 'HOST' then +parse var optstring host optstring +otherwise +mailopts = mailopts thisopt +end /* select */ +end /* do while optstring isn't null */ + +do while whomlist /= '' +parse var whomlist cc whom ',' whomlist +if (translate(cc) = 'CC:') | (translate(cc) = 'BCC:') then + towhom = towhom cc +else + whom = cc whom +if host = '' then +"EXEC PH" whom "( STACK" +else +'EXEC PH' whom "( STACK HOST" host +QRC = rc +select /* on outcome of QueryCSO */ +when QRC = 5 then /* -1: Read or Write failed */ +do +address xedit "MSG Read or write failure on CSO Query." +whomlist = '' +end +when QRC = 0 then /* 0: no problem */ +"PIPE STACK | stem PHDATA." /* read from stack */ +when QRC = 4 then /* 4: no end of data? */ +do +address xedit "MSG Data end never received." +whomlist = '' +end +when QRC = 3 then /* 3: bad parameters */ +do +address xedit "MSG Bad parameters passed." +whomlist = '' +end +when QRC = 1 then /* 1: no matches */ +do +address xedit "MSG No matches; assuming" whom, +"is an e-mail address already." +towhom = towhom whom +end +when QRC = 7 then /* 7: User wants out */ +do +whomlist = '' +phdata.0 = 0 +end +otherwise /* 2: too many matches */ +address xedit "MSG No luck on" whom". RC=" QRC +phdata.0 = 0 +end /* select on QRC */ + +if (phdata.0 /= 0) then /* no answer */ +do +"PIPE (end \) STEM PHDATA.", +"| strip leading", +"| find email:", +"| specs w2 1", +"| var userid" +towhom = towhom userid +end +end /* of whomlist loop */ + +push 'FORWARD' towhom '(' mailopts +Exit + +somehelp: +say 'Build MAIL FORWARD command from PH.' +exit 100 /* non-zero RC for explanation mode */ + +morehelp: +say 'Build MAIL FORWARD command from PH.' +say 'Syntax:' progfn "whom {, {cc:|bcc:} whom2 {,...}} {( options }" +say 'Options: HOST host.some.where | mail_options' +exit 100 + diff --git a/vmworkshop-vmarcs/1995/laflam95/phmail.exec b/vmworkshop-vmarcs/1995/laflam95/phmail.exec new file mode 100644 index 0000000..0221bf4 --- /dev/null +++ b/vmworkshop-vmarcs/1995/laflam95/phmail.exec @@ -0,0 +1,147 @@ +/* Solicit names, build a MAIL command */ +/* Nick Laflamme - U. of Notre Dame */ +/* Dominique.P.Laflamme.1@nd.edu */ +/* UDM/Nick */ +/* */ +/* July, 1992 */ + +signal prologue /* skip to start of code */ + +/* SYNTAX: and NOVALUE: come first so REXX can always find them */ + +syntax: /* in case of syntax error */ +erc = rc /* preserve error code */ +$error='REXX error' erc 'in line' sigl':' errortext(erc) +say $error /* get excited */ +say "Line" sigl':' sourceline(sigl) /* show offending line */ +trace '?r'; nop /* start trace mode for debug */ +rc = Socket('Terminate') +exit erc + +novalue: +$error='Novalue error in line' sigl +say $error /* get excited */ +say sourceline(sigl) /* show offending line */ +trace '?r'; nop /* start trace mode for debug */ +rc = Socket('Terminate') +exit 100 + +prologue: /* start of real code */ +signal on novalue /* complain about missing vairables */ +signal on syntax /* semi-graceful exit for syntax errors */ +parse source . invocation progfn progft progfm calledas addressee + +parse arg wanthelp . /* check first argument */ +select +when wanthelp='?' then + signal somehelp /* break to explanation */ +when wanthelp='??' then + signal morehelp /* break to long explanation */ +otherwise + nop /* on with life */ +end /* of select on wanthelp */ + +/* trace i */ + +/************* START OF CODE *************************/ + +Address "COMMAND" + +progid = "PH to Mail .91" /* .9 - getting close now. */ + +Signal on SYNTAX + +'STATE PIPE MODULE *' +If rc ^= 0 Then Do +Say "You must have CMS Pipelines to run" progid +Exit rc +End /* If .. Do */ + +host = '' +mailopts = '' /* by default */ +towhom = '' +phdata.0 = 0 +parse arg whomlist '(' optstring ')' . +optstring = translate(optstring,' ','=') /* allow "=" as whitespace */ +do while optstring /= '' +parse var optstring thisopt optstring +select +when translate(thisopt) = 'HOST' then +parse var optstring host optstring +otherwise +mailopts = mailopts thisopt +end /* select */ +end /* do while optstring isn't null */ + +do while whomlist /= '' +parse var whomlist cc whom ',' whomlist +if (translate(cc) = 'CC:') | (translate(cc) = 'BCC:') then + towhom = towhom cc +else + whom = cc whom +if host = '' then +"EXEC PH" whom "( STACK" /* new - call ph API */ +else +'EXEC PH' whom "( STACK HOST" host +QRC = rc +select /* on outcome of QueryCSO */ +when QRC = 5 then /* -1: Read or Write failed */ +do +SAY "Read or write failure on CSO Query." +whomlist = '' +end +when QRC = 0 then /* 0: no problem */ +"PIPE STACK | stem PHDATA." /* read from stack */ +when QRC = 4 then /* 4: no end of data? */ +do +say "Data end never received." +whomlist = '' +end +when QRC = 3 then /* 3: bad parameters */ +do +say "Bad parameters passed." +whomlist = '' +end +when QRC = 1 then /* 1: no matches */ +do +say "No matches; assuming" whom "is an e-mail address already." +towhom = towhom whom +end +when QRC = 7 then /* 7: User wants out */ +do +whomlist = '' +phdata.0 = 0 +end +otherwise /* 2: too many matches */ +say "No luck on" whom". RC=" QRC +phdata.0 = 0 +end /* select on QRC */ + +if (phdata.0 /= 0) then /* no answer */ +do +"PIPE (end \) STEM PHDATA.", +"| strip leading", +"| find email:", +"| specs w2 1", +"| var userid" +towhom = towhom userid +end +end /* of whomlist loop */ + +push 'MAIL' towhom '(' mailopts +if mailopts = '' then +say 'MAIL' towhom +else +say 'MAIL' towhom '(' mailopts +Exit + +somehelp: +say 'Build MAIL command from PH.' +exit 100 /* non-zero RC for explanation mode */ + +morehelp: +say 'Build MAIL command from PH.' +say 'Syntax:' progfn "whom {, {cc:|bcc:} whom2 {,...}} {( options }" +say 'Options: HOST host.some.where | mail_options' +exit 100 + diff --git a/vmworkshop-vmarcs/1995/laflam95/phsrc.helpcms b/vmworkshop-vmarcs/1995/laflam95/phsrc.helpcms new file mode 100644 index 0000000..600b5a9 --- /dev/null +++ b/vmworkshop-vmarcs/1995/laflam95/phsrc.helpcms @@ -0,0 +1,183 @@ +.CM Created June, 1995, by Nick Laflamme +.cm with contributions from John Hammond of UConn +.FO OFF +PH EXEC +version 2.57 +June 13, 1995 +.FO ON +.CS BRIEF ON +.IN 1 +.SP 1 +PH EXEC does phone book lookups against phone book servers, also known +as qi server, on the Internet. You can view the results either +entry by entry or all at once. +.fo off +.SP 1 + FORMAT: PH ( +.SP 1 + EXAMPLES: +.bx 2 70 + PH + PH (HOST host.domain + PH first_name middle_initial last_name + PH email=userid@host.domain ( HOST host2.domain PORT 106 + PH first_name last_name email=userid@host.domain (HOST host3.domain + PH last_name email=userid@host.domain (PORT 205 STACK + PH part_of_last_name* +.bx off +.fo on +.SP 1 +.CS BRIEF OFF +.CS DESCRIPT ON +¢|Description¢% +.sp 1 +¢|PH¢% (CMS command) +.sp 1 +.in 2 +Use the PH command to issue a query to a phonebook (CSO/qi/ph) server. +you may supply only a name and get local directory information. You may also +supply a host name and port number with the command for a phonebook server at +another site. The default host and port are the phonebook server host name +and port number configured by your site. +.sp 1 +You will be presented with an input screen. Fill in the name of the person +you know for the entry that you wish to view, and then press Enter. If an +entry or entries are found which match your query, they will be displayed in +response. By default, the Name field is searched. +.sp 1 +If you wish to search a different field, chose the keyword associated with the +field name and enter keyword=value and press Enter. Multiple fields may be +entered for the same search. Use "*" as the wildcard character. +.sp 1 +This command is also issued from within Gopher and WWW when you open a menu +entry of type¢|.¢% Gopher and WWW will automatically supply the +correct host name and port number. +.sp 1 +.CS DESCRIPT OFF +.CS FORMAT ON +¢|Format¢% +.sp 1 +.fo off +.in 3 +.bx 2 10 77 +PH ( +.bx off +.fo on +.SP 1 +.CS FORMAT OFF +.CS PARMS ON +.in 1 +¢|Operands¢% +.in 10 +.sp 1 +.il -6 +¢|whom¢% is the personal name of the person for whom you are searching. +It may also be a keyword=value (e.g. email=userid@host.domain) +for other fields that are searchable or a combination of both. +This argument is optional. +.sp 1 +.in 1 +.CS PARMS OFF +.CS OPTIONS ON +¢|Options¢% +.in 10 +.sp 1 +.il -6 +¢|host¢% represents the name or IP address of the desired host. +If omitted, the GLOBALV group PHCMS will be queried for the name +HOST and this used instead. If the name HOST is undefined, then +the default phonebook server configured by your site will be used. +.sp 1 +.il -6 +¢|port¢% represents the port number to use on the remote host. +If omitted, the GLOBALV group PHCMS will be queried for the name +PORT and this used instead. If the name PORT is undefined, then +port 105, the standard port for a CSO/qi/PH server, will be used. +This argument is optional. +.sp 1 +.il -6 +¢|STACK¢% entries which are accepted (PF5) by the user will be placed in the +program stack for retrieval by another program. +This parameter is optional. +.sp 1 +.il -6 +¢|STACKALL¢% +entries which are matches will be placed in program stack for +retrieval by another program. +This parameter is optional. +.sp 1 +.il -6 +¢|UNIQUE¢% will either return one entry to the stack or a return code +8 indicating that the query did not specify only one entry. +This parameter is optional. +.sp 1 +.in 1 +.CS OPTIONS OFF +.CS NOTES ON +¢|Usage Notes¢% +.in 7 +.sp 1 +.il -5 +1) When searching for entries that match your query, case is not significant: +upper and lower case letters are treated as equivalent. +.SP 1 +.CS NOTES OFF +.CS ERRORS ON +.il -6 +¢|Return Codes¢% +.sp 1 +.il -5 +¢|0¢% The query or command was successful. +.sp 1 +.il -5 +¢|1¢% The server couldn't find any matches for your query. +.sp 1 +.il -5 +¢|2¢% The server found more entries that matched your query than it's +allowed to return. This often reflects privacy issues and regulations. +.sp 1 +.il -5 +¢|3¢% The server rejected your query as being invalid. +One common cause of this is asking for a non-existent field. +Remember: there are almost no standards for what fields are valid.¢% +.sp 1 +.il -5 +¢|4¢% The response from the server was incomplete and aborted. +This is beyond your control and probably is temporary. +.sp 1 +.il -5 +¢|5¢% Part of the conversation with the server failed. +This is beyond your control and probably is temporary. +.sp 1 +.il -5 +¢|6¢% Something in the PH program went very wrong. Tell your systems people +how you got this error and ask them to contact the author. If you +are your systems people, well.... +.sp 1 +.il -5 +¢|7¢% The user used PF12 to indicate that she or he wishes to break out of +any loop one might be in. +.sp 1 +.il -5 +¢|8¢% You used the UNIQUE option but got more than one entry from the +server. +.sp 1 +.il -5 +¢|9¢% The host and port combination you were querying don't seem to be a +qi server. This may have been specified for you by a Gopher or Web +client and may be the result bad data on the Internet. +.sp 1 +.il -5 +¢|10¢% That PH command, while legal, is not implemented in this client. a +.sp 1 +.il -5 +¢|100¢%You called PH using old parameters or an old syntax. +.SP 1 +.CS ERRORS OFF +.CS RELATED ON +.il -6 +¢|Related Help¢% +.sp 1 +Be sure to try the PHMAIL and PH2NAMES commands. +.SP 1 +.CS RELATED OFF diff --git a/vmworkshop-vmarcs/1995/laflam95/tododone.exec b/vmworkshop-vmarcs/1995/laflam95/tododone.exec new file mode 100644 index 0000000..9faf0b6 --- /dev/null +++ b/vmworkshop-vmarcs/1995/laflam95/tododone.exec @@ -0,0 +1,98 @@ +/* Mark an undone item as done. */ +/* Written by: Nick Laflamme */ +/* University of Notre Dame */ +/* Dominique.P.Laflamme.1@nd.edu */ +/* Last changed: July 13, 1993 DPL */ +signal prologue /* skip to start of code */ + +/* SYNTAX: and NOVALUE: come first so REXX can always find them */ + +syntax: /* in case of syntax error */ +erc = rc /* preserve error code */ +$error='REXX error' erc 'in line' sigl':' errortext(erc) +say $error /* get excited */ +say "Line" sigl':' sourceline(sigl) /* show offending line */ +exit erc + +novalue: +$error='Novalue error in line' sigl +say $error /* get excited */ +say sourceline(sigl) /* show offending line */ +exit 100 + +prologue: /* start of real code */ +signal on novalue /* complain about missing vairables */ +signal on syntax /* semi-graceful exit for syntax errors */ +parse source . invocation progfn progft progfm calledas addressee + +parse arg wanthelp . /* check first argument */ +select + when wanthelp='?' then + signal somehelp /* break to explanation */ + when wanthelp='??' then + signal morehelp /* break to long explanation */ + otherwise + nop /* on with life */ + end /* of select on wanthelp */ + +parse arg donenum donedate stuff +if stuff /= '' then +say "Extra options ignored:" stuff + +if donenum = '' then +do +say "What task number are you marking complete?" +parse pull donenum stuff +if stuff /= '' then +say "Extra input ignored:" stuff +end + +if donenum = '' then +do +say 'None, apparently.' +exit +end +if donedate = '' then +donedate = '19'||translate(date('O'),'-','/') + +/* now firststage will load the pipe properly */ + +/* "PIPE Q VERSION | specs w5 1 | var pipever" +if pipever /= "1.0107" then /* PRPQ version 1.0.7 from Piper */ +do +say "Wrong version of Pipelines active." +exit 100 +end */ +"PIPE SQL NOIND SELECT TASK,PRIO,LENGTH,ASSIGNED,DUE,FORWHOM,TASKNUM", +"FROM VMTODO WHERE TASKNUM =" donenum, +"| spec 1.32 c2v 1 33.4 c2d 32.3 r 37.4 c2d 36.3 r 41.10 nw 51.10 nw ", +" 63.8 nw 71.4 c2d nw.3 r", /* translate to human readable form */ +"| cons" +if rc /= 0 then +do +say "Problem with verifying task to mark done." +exit rc +end + +say 'This one? (Yn)' +parse upper pull answer 2 . /* take one character */ +if (answer /= '') & (answer /= 'Y') then +exit + +/* go ahead and update the record */ +"PIPE", +"sql EXECUTE UPDATE VMTODO SET DONE = '"||donedate||"'", +"WHERE tasknum =" donenum, +"| cons" + +exit rc /* get out of here; all done */ +somehelp: + +say 'This marks items done in an SQL table called VMTODO.' +exit 100 /* non-zero RC for explanation mode */ + +morehelp: +say 'This marks items done in an SQL table called VMTODO.' +say 'You can specify the task number and the date completed.' +say 'Syntax:' progfn '{nnn {yyyy-mm-dd} | ? | ?? }' +exit 100 diff --git a/vmworkshop-vmarcs/1995/laflam95/whattodo.exec b/vmworkshop-vmarcs/1995/laflam95/whattodo.exec new file mode 100644 index 0000000..977741c --- /dev/null +++ b/vmworkshop-vmarcs/1995/laflam95/whattodo.exec @@ -0,0 +1,123 @@ +/*******************************************************************/ +/* OUC, University of Notre Dame, IRISHVMA */ +/* EXEC Name: WHATTODO EXEC */ +/* Function: Read the to-do list in SQL and summarize */ +/* Author Name: Nick Laflamme */ +/* Dominique.P.Laflamme.1@nd.edu */ +/* VMSHARE: UDM */ +/* Date: December, 1991 */ +/* Updates: yes :-) */ +/*******************************************************************/ + +Signal Prologue + +/* Error Trap for syntax errors */ +Syntax: +rcs = rc +$error="REXX error" rcs "in line" Sigl":" Errortext(rcs) +Say $error +Say "Line" Sigl":" Sourceline(Sigl) +Nop +exit rcs + +/* Error Trap for undefined variables */ +Novalue: +$error = "Novalue error in line" Sigl +say $error +say Sourceline(Sigl) +Trace "?r"; Nop +exit 100 + +Prologue: + +signal on Novalue +signal on Syntax +Parse source . intype progfn progfm progft calledas addressee + +parse arg wanthelp . /* check first argument */ +select +when wanthelp='?' then +signal somehelp /* break to explanation */ +when wanthelp='??' then +signal morehelp /* break to long explanation */ +otherwise +nop /* on with life */ + end /* of select on wanthelp */ + +/* Get local RSCS machine name */ +"IDENTIFY (STACK" +parse pull me . here . rscsid . + +address command + +parse arg final +if final = '' then +do +final = '| console', +"\ source:", +"| target:" /* make sure everything is counted at least once */ +say final +end +if left(strip(final),1) /= '|' then +final = '|' final + /* query SQL database and find out what we know */ + +select1 = "TASK,PRIO,LENGTH,ASSIGNED,DUE,FORWHOM,TASKNUM", +"FROM NLAFLAMM.VMTODO WHERE DONE is NULL" +b= "| drop 1", +"| specs 1.30 1 42.1 32 54.1 34 56.10 36 67.10 47", +"78.8 58 95.3 67", +"| source: fanout", +"| a: locate 32.1 /1/", /* take 1's */ +"| duplicate", /* emphasize prio 1s */ +"| target: faninany", +"| sort count 67.3", /* sort on task number */ +"| specs 1.10 1.2 right 11-* nextword", +"| sort 1.2 d 35.3" /* sort on reasons to do task, prio, len */ +c= "\ a:", +"| locate 32.1 /2/", /* 2's count, too */ +"| target:", +"\ source:", +"| sort 36.10", /* assigned */ +"| sort 32.3", /* priority secondary */ +"| sort 34.1", /* length primary */ +"| take 5", +"| target:", +"\ source:", +"| sort 36.10", /* assigned */ +"| take 5", +"| target:", +"\ source:", +"| nlocate 58 /?/", /* for someone */ +"| target:", +"\ source:", +"| nlocate 47 /?/", /* has a due date */ +"| target:" + + +"PIPE (end \) SQLSELECT" select1, +b, +final, +c + +exit + +somehelp: +say 'This program reads the VMTODO table in SQL/DS and sorts the ' +say 'output in an attempt to produce a prioritized list of things ' +say 'to do.' +say '' +say 'You can specify a Pipeline to route the output through.' +exit 100 /* non-zero RC for explanation mode */ + +morehelp: +say 'This program reads the VMTODO table in SQL/DS and sorts the ' +say 'output in an attempt to produce a prioritized list of things ' +say 'to do.' +say '' +say 'You can specify a Pipeline to route the output through.' +say 'The default output_filter is: | console \ source: | target:' +say 'To count each item one time less, specify: | console' +say '' +say 'Syntax:' progfn '{ output_filter | ? | ?? }' +exit 100 diff --git a/vmworkshop-vmarcs/1995/marist95/addrmod.info b/vmworkshop-vmarcs/1995/marist95/addrmod.info new file mode 100644 index 0000000..d655883 --- /dev/null +++ b/vmworkshop-vmarcs/1995/marist95/addrmod.info @@ -0,0 +1,238 @@ +This mod will add a new command to VM/ESA called ADDR. This command will +display information about a "terminal", including its address, devicetype +and other info depending on what kind of device it is. It can be used on all +types of workstations, including SNA devices and logical devices. In the +case of an SNA device, the LU name will be displayed. If it is run on a +logical device, the owner of the device will be displayed. + +The mod consists of a new module, HCPADR and minor changes to HCPCOM, HCPMDLAT +COPY and HCPLDL. The change to HCPCOM to define the new command, ADDR. The +changes to HCPMDLAT COPY and HCPLDL are to add the new module to the system. + +This mod was developed on a VM/XA system, and later ported to VM/ESA. The +current version should run on all levels of VM/ESA ESA feature from 1.1.0 +through 1.2.1. However, future levels shouldn't be a problem either. + +Questions or problems with this mod should be directed to Martha McConaghy, +Marist College, URMM@VM.MARIST.EDU (914) 575-3252. + +FILE: HCPCOM ADDRCMD E1 + +./ I 02530001 $ 2530100 100 10/31/89 18:31:26 +************************************************************** ADDRCMD 1 +* * ADDRCMD 0 +* ADDR COMMAND * ADDRCMD 9 +* * ADDRCMD 8 +************************************************************** ADDRCMD 7 + SPACE , ADDRCMD 6 +ADDR DS 0F ADDRCMD 5 + COMMD COMMAND=(ADDR,4),FL=CMDALOG+CMDONLY, * 0 + CLASS=*,EP=HCPADRES ADDRCMD 3 + SPACE , ADDRCMD 2 + + +FILE: HCPMDLAT ADDRCMD E1 + +./ I 50930001 $ 50930100 100 10/30/89 10:51:36 + AIF ('&NAME'(1,6) NE 'HCPADR' AND (NOT &HCPLLST) )* 0 + .EHCPADR ADDRCMD 0 + HCPATTRB HCPADR,MODATTR=(PAG,MP,DYN), * 0 + EP=((HCPADRES,DYN)) ADDRCMD 0 + AIF ('&HCPATTRC' EQ '0').MDLATEX IF FOUND, EXIT ADDRCMD 0 +.EHCPADR ANOP , ADDRCMD 0 +.**************************************************************ADDRCMD 0 + + + +FILE: HCPLDL ADDRCMD E1 + +./ * CO-REQ: HCPADR +./ * IF-REQ: NONE +./ * FORCE REASSEMBLY FOR HCPADR MOD FOR HCPMDLAT MACRO + + + +FILE: HCPADR ASSEMBLE E1 + +ADR TITLE 'HCPADR (CP) VM/ESA R 1.0' 00000100 + ISEQ 73,80 VALIDATE SEQUENCING OF INPUT 00000200 + COPY HCPOPTNS 00000300 +HCPADR HCPPROLG ATTR=(PAGEABLE,REENTERABLE),BASE=(R12) 00000400 +* 00000500 +* MODULE NAME - HCPADR 00000600 +* 00000700 +* DESCRIPTIVE NAME - ADDR COMMAND 00000800 +* 00000900 +* STATUS - VM/ESA 1.0 ESA 00001000 +* 00001100 +* FUNCTION - To process the ADDR command. 00001200 +* 00001300 +* NOTES - 00001400 +* 00001500 +* DEPENDENCIES - THIS MODULE REQUIRES THE USE OF THE IBM SYS 00001600 +* 370 - XA SERIES OF PROCESSORS RUNNING IN 370 00001700 +* MODE. 00001800 +* 00001900 +* REGISTER CONVENTIONS - SYMBOLIC REFERENCES TO REGISTERS AR 00002000 +* THE FORM "RX" WHERE X IS A NUMBER R 00002100 +* FROM 0 TO 15. 00002200 +* 00002300 +* MODULE TYPE - PROCEDURE 00002400 +* 00002500 +* PROCESSOR - ASSEMBLER H, VERSION 2 R1 00002600 +* 00002700 +* ATTRIBUTES - REENTRANT, PAGEABLE 00002800 +* 00002900 +* ENTRY POINT - 00003000 +* 00003100 +* HCPADRES - PROCESS THE ADDR COMMAND 00003200 +* 00003300 +* EXTERNAL REFERENCES - 00003400 +* 00003500 +* ROUTINES - 00003600 +* 00003700 +* HCPCVTBH - To convert binary to hex 00003800 +* HCPLDAFE - Fetch the LDD for a logical device LDEV 00003830 +* HCPLDARE - Return LDD to system LDEV 00003860 +* HCPLSOTR - Translate the device number into hex 00003900 +* 00004100 +* DATA AREAS - 00004200 +* ADRMSG - Message response DSECT 00004300 +* 00004400 +* CONTROL BLOCKS - 00004500 +* HCPCSLPL - REQUIRED FOR HCPCONSL MACRO 00004550 +* HCPEQUAT - SYSTEM EQUATES 00004600 +* HCPPFXPG - PREFIX AREA PAGE 00004700 +* HCPRDCBK - REAL DEVICE CHARACTERISTIC BLOCK 00004800 +* HCPRDEV - REAL DEVICE BLOCK 00004900 +* HCPSAVBK - SAVE AREA 00005000 +* HCPSYSCM - SYSTEM COMMON AREA 00005100 +* HCPVMDBK - INVOKER'S VMDBK 00005200 +* 00005300 +* MACROS - 00005400 +* HCPCALL - STANDARD SYSTEM CALLING LINKAGE 00005500 +* HCPCONSL - Write results to the user's console ADCONSL 00005550 +* HCPDROP - RELEASE ADDRESSABILITY 00005600 +* HCPENTER - DEFINITION OF EXECUTABLE ENTRY POINT 00005700 +* HCPEPILG - GENERATE MODULE EPILOG 00005800 +* HCPEXIT - RETURN TO CALLER 00005900 +* HCPGETST - GET FREE STORAGE 00006000 +* HCPRELST - RELEASE FREE STORAGE 00006100 +* HCPUSING - ESTABLISH ADDRESSABILITY 00006200 +* 00006300 +* ABEND CODES - NONE 00006400 +* 00006500 +* RESPONSE - 00006600 +* DEVICE XXXXX ON SYSTEM VVVVVVVV TYPE TTTTTTTT 00006700 +* or LDEV 00006860 +* Device XXXXX on System VVVVVVVV Type TTTTTTTT Owner OOOOOLDEV 00006920 +* for logical devices LDEV 00006980 +* 00007100 +* 00007200 + SPACE 3 00007300 + EXTRN HCPLDAFE Fetch LDD for logical devs LDEV 00007450 + EXTRN HCPLDARE Return LDD for logical devs LDEV 00007500 + EXTRN HCPLSOTR Translate raddr for printing LDEV 00007550 + EXTRN HCPCVTBH Convert binary to ebcdic LDEV 00007600 +* 00007700 + COPY HCPCSLPL Console parameter list LDEV 00007820 + COPY HCPPFXPG Prefix page LDEV 00007890 + COPY HCPSYSCM System common block LDEV 00007960 + COPY HCPSAVBK Save area LDEV 00008030 + COPY HCPEQUAT Common equates LDEV 00008100 + COPY HCPVMDBK VMDBK LDEV 00008170 + COPY HCPRDEV Real Device block LDEV 00008240 + COPY HCPSNABK SNA device block LDEV 00008310 + COPY HCPRDCBK Real dev characteristics block LDEV 00008380 + EJECT 00008600 + HCPUSING PFXPG,0 00008700 + HCPUSING VMDBK,R11 00008800 + HCPUSING SAVBK,R13 00008900 +* 00009000 +HCPADRES HCPENTER CALL,SAVE=DYNAMIC 00009100 +* 00009200 +* Get storage for response buffer and set up text. LDEV 00009250 + LA R0,ADRMSGDL GET SIZE OF RESPONSE 00009300 + HCPGETST LEN=(R0) GET STORAGE BLOCK 00009400 + LR R3,R1 Save address of block LDEV 00009540 + HCPUSING ADRMSG,R3 00009600 + MVI ADRMSG,C' ' CLEAR OUT RESPONSE BUFF 00009700 + MVC ADRMSG1(ADRMSGDL*8-1),ADRMSG 00009800 + MVC TXT1,=C'Device ' Insert text into message LDEV 00009940 + MVC TXT2,=C' on system ' 00010000 + MVC TXT3,=C' type ' 00010100 +* 00010200 +* Now, find the RDEV block and determine if it is a SNA device.LDEV 00010250 + L R8,VMDRTERM GET ADDRESS OF RDEVBLOK 00010300 + HCPUSING RDEV,R8 00010400 + ICM R1,B'1111',RDEVSNA IS THERE A SNABK BLOCK? 00010500 + BNZ SNADEV Yes then get SNA info 00010600 +* LDEV 00010710 +* For non-SNA devices, get raddr and device type. LDEV 00010720 + LA R1,RADDR Set location of buffer LDEV 00010730 + HCPCALL HCPLSOTR GET ADDRESS OF TERMINAL 00010800 + L R7,RDEVRDCA GET DEVICE CHAR BLOCK 00010900 + HCPUSING RDCBK,R7 00011000 + SR R1,R1 CLEAR OUT REG 00011100 + MVC DEVTYP(2),RDCDVID Get device type LDEV 00011240 + LH R1,DEVTYP 00011300 + HCPCALL HCPCVTBH Convert it to EBCDIC LDEV 00011410 + STM R0,R1,DEVTYP Put back in buffer LDEV 00011420 +* LDEV 00011430 +* Determine if we are on a logical device. If so, then LDEV 00011440 +* get the owner of the device too. LDEV 00011450 + L R1,RDEVLSOP Get pointer to LSOBJ LDEV 00011460 + LTR R1,R1 Are we on a LDEV? LDEV 00011470 + BZ SYSTEMID NO, then finish up LDEV 00011480 + LH R1,RDEVDEV Get LDEV number LDEV 00011490 +* The call to HCPLDAFE locks the LDDBK for the logical device.LDEV 00011500 +* It must be released before leaving the module. LDEV 00011510 + HCPCALL HCPLDAFE Fetch LDDBK for device LDEV 00011520 + LTR R15,R15 Did we find one? LDEV 00011530 + BNZ SYSTEMID NO, something's wrong LDEV 00011540 + LR R4,R2 Save VMDBK addr for owner LDEV 00011550 + HCPCALL HCPLDARE Release lock on LDDBK LDEV 00011560 + MVC LOWNER,VMDUSER-VMDBK(R4) Get owner's ID LDEV 00011570 + MVC TXT4,=C' Owner ' LDEV 00011580 + B SYSTEMID 00011600 +* 00011700 +* If user is on a SNA device, set the device type to SNA LDEV 00011730 +* and set address to LU name. LDEV 00011760 +SNADEV L R1,RDEVSNA Get address of SNABK 00011800 + HCPUSING SNABK,R1 00011900 + MVC RADDR,SNALUN Move in the LU name 00012000 + MVC DEVTYP,=C' SNA ' 00012100 + HCPDROP R1 00012200 +* 00012300 +* Finish up by setting the system ID field. LDEV 00012350 +SYSTEMID L R1,PFXSYS 00012400 + HCPUSING SYSCM,R1 00012500 + MVC SYSID,SYSTMID Get system id from SYSCM LDEV 00012640 + HCPDROP R1 00012700 +* 00012800 +* Write the message to the user's console and release the LDEV 00012860 +* storage. LDEV 00012920 +PRTMSG DS 0H ADCONSL 00012990 + HCPCONSL WRITE,DATA=((R3),ADRMSGL) ADCONSL 00013080 + HCPRELST BLOCK=(R3) ADCONSL 00013170 + HCPEXIT EP=(HCPADRES),SETCC=NO 00013400 + EJECT 00013500 +* LDEV 00013530 +* Define block for resulting message. LDEV 00013560 +ADRMSG DSECT 00013600 +TXT1 DS CL8 "DEVICE " LDEV 00013740 +RADDR DS CL8 00013800 +TXT2 DS CL12 " ON SYSTEM " 00013900 +SYSID DS CL8 00014000 +TXT3 DS CL8 " TYPE " 00014100 +DEVTYP DS CL8 00014300 +TXT4 DS CL8 " OWNER " LDEV 00014330 +LOWNER DS CL8 LDEV 00014360 +ADRMSGL EQU (*-ADRMSG) LENGTH OF RESPONSE 00014400 +ADRMSGDL EQU (*-ADRMSG+7)/8 LENGTH OF RES IN DW 00014500 +ADRMSG1 EQU ADRMSG+1 00014600 + EJECT 00014700 +HCPADR CSECT 00014800 + LTORG 00014900 + HCPDROP R3,R7,R8,R11,R13 00015000 + HCPEPILG 00015100 \ No newline at end of file diff --git a/vmworkshop-vmarcs/1995/marist95/adsmtool.pack b/vmworkshop-vmarcs/1995/marist95/adsmtool.pack new file mode 100644 index 0000000..7700de8 --- /dev/null +++ b/vmworkshop-vmarcs/1995/marist95/adsmtool.pack @@ -0,0 +1,796 @@ +FILESPACE EXEC + +/* This exec will gather information on the filespaces in the ADSM + database and analyze which may be old and which nodes have not + been backed up in a long time. +MMM 3/22/95 + +*/ +address command + +Adsm_admin = 'MONITOR' +Adsm_pass = 'xxxxxxxx' +'EXEC GETADSM' +if(RC^=0) then exit RC + +/* Run the ADSM commands necessary to collect the information. */ +'DSMADMC -ID='||Adsm_admin '-PASS='||Adsm_pass 'MACRO QFILESP.ADSM' +if(RC^=0) then do + say 'Error running ADSM. See DSMERROR LOG' + 'EXEC SENDF DSMERROR LOG A TO URMM' + exit RC +end; + +/* Reformat the QUERY FILESPACE information into a usable form. */ +'PIPE (end ?) < QFILESP OUTPUT A|' , + 'a:lookup 1-33 detail |' , /* Select out info we want */ + 'change (33-35) /: /: 0/|' , /* if no backup info, change to 0 */ + 'change (29-36) /Time: 0 /Time: 0 0/|' , + 'spec 35-* 1 |' , /* Get rid of headers */ + 'join 4 / / |' , + 'stem Filespace.' , + '? literal Node Name: |' , /* Headers for info we want */ + 'literal Filespace Name: |' , + 'literal Days Since Last Backup Started: |' , + 'literal Last Backup Completion Date/Time: |' , + 'literal Days Since Last Backup Completed: |' , + 'pad left 34 |' , + 'a:' + +/* Reformat output from QUERY NODE and select out information we want.*/ +'PIPE (end ?) < QNODE OUTPUT A |' , + 'a:lookup 1-31 detail |' , + 'spec 33-* |' , + 'join / / |' , + 'stem Nodes.' , + '? literal Node Name: |' , + 'literal Contact: |' , + 'pad left 32 |' , + 'a:' + +/* The following pipe will take the data gathered by the QUERY FILESPACE + and the data from the QUERY NODES and combine them. Then the OLDBACKS + filter will select out those that have not had a successful backup + within the given number of days and will return those records on + the primary output stream. Records that are under the limit will + be returned on the secondary output stream (1) and any records with + a value of 0 for the backup will be returned on the tertiary + stream (2). The final stream (4) will contain the data from the + primary stream, formatted for sending e-mail. Only those records + containing an e-mail address in the bio data will be included. +*/ +'PIPE (end ?) stem Filespace. |' , + 'a:lookup 1-30 |' , /* combine data and names */ + 'join / / |' , + 'b:oldbacks 30 |' , /* select out problem nodes */ + 'report |' , + 'literal Report on Nodes over 30 Day Limit |' , + '> filespac bad a' , /* nodes over the limit */ + '? stem Nodes. |' , /* get bio data & combine with data */ + 'a:' , + '? b: |' , /* stream 1, nodes under limit */ + 'report |' , + 'literal Report on Nodes under 30 Day Limit |' , + '> filespac good a' , + '? b: |' , /* stream 2, nodes w/0 for backup */ + 'report |' , + 'literal Report on Nodes with Backup Value 0 |' , + '> filespac zero a' , + '? b: |' , /* stream 3, stream 0 data formatted*/ + 'stem E_mail.' /* for sending e-mail */ + +'EXEC SENDFILE FILESPAC BAD A TO URMM' +'EXEC SENDFILE FILESPAC GOOD A TO URMM' +'EXEC SENDFILE FILESPAC ZERO A TO URMM' + +/* The following loop will generate e-mail and send it to each + address in E_mail. This is a reminder to do their backups + on their PC's. */ +do I = 1 to E_mail.0 + parse var E_mail.i E_addr Node Last_date Last_time , + Filespace '@%' Name_text + Note.1 = 'Date:' substr(date(Week),1,3)||',' date() time() + Note.2 = 'To:' Name_text '<'||E_addr||'>' + Note.3 = 'From: ADSM Backup Monitor <'||userid()||'@VM.MARIST.EDU'||'>' + Note.4 = 'Subject: PC Backup Reminder' + Note.5 = ' ' + Note.6 = 'This note is a reminder that your PC workstation is' , + 'overdue for a backup.' + Note.7 = ' ' + Note.8 = substr('The last successful backup of disk volume' Filespace,1,80) + Note.9 = substr('for machine:' node,1,80) + Note.10 = 'was completed on' Last_date Last_time '.' + Note.11 = ' ' + Note.12 = 'Please backup this volume as soon as possible to' + Note.13 = 'ensure that altered data will be preserved.' + Note.0 = 13 + 'PIPE stem Note. |' , + '> ADSM MAIL A' + 'EXEC SENDFILE ADSM MAIL A TO MAILER' +end; +'ERASE QNODE OUTPUT A' +'ERASE QFILESP OUTPUT A' + +******************************************************** +RESETPSW EXEC + +/* This exec will determine if the passwords for the LAN servers are + about to expire and will reset them. This is to ensure that the + automated backups do not fail as the passwords are hardcoded. +MMM 3/31/95 + +*/ +address command + +Adsm_admin = 'MONITOR' +Adsm_pass = 'xxxxxxxx' +Server_pass = 'xxxxxxxxx' +'EXEC GETADSM' +if(RC^=0) then exit RC + +/* Run the ADSM commands necessary to collect the information. */ +'DSMADMC -ID='||Adsm_admin '-PASS='||Adsm_pass 'MACRO QPASSW.ADSM' +if(RC^=0) then do + say 'Error running ADSM. See DSMERROR LOG' + 'EXEC SENDF DSMERROR LOG A TO URMM' + exit RC +end; + +/* The following pipe will pick out the information we need from the + QUERY NODE output. We will filter out all locked users, and then + get only those nodes that contain _SERVER or _FULL in their name. + These are the LAN servers. Then filter out those that don't need + to be reset. Finally dynamically create an ADSM macro that will + do the actual reset. */ +'PIPE (end ?) < QNODE OUTPUT A |' , + 'drop 4 |' , /* drop the headers */ + 'spec word6 1 word1 nextw word5 nextw |' , + 'find No |' , /* don't care about locked nodes */ + 'spec word 2-* 1 |' , /* keep only node and days since psw set*/ + 'a: locate /_SERVER/ |' , /* pick only server nodes */ + 'b: faninany |' , /* rejoin with _SERVER and _FULL nodes */ + 'pickpass 100|' , /* filter any that don't need resetting*/ + 'stem Server_list. |' , + 'spec /UPDATE NODE/ 1 word1 nextw /'||Server_pass||'/ nextw |' , + 'literal /* Temporary ADSM macro to update LAN server passwords */|' , + '> RESETPSW ADSM A' , /* create ADSM macro to reset psws */ + '? a: |' , /* 2nd stream to get _FULL nodes */ + 'locate /_FULL/ |' , + 'b:' + +/* Now, if we have any, do the reset */ +if(Server_list.0>0) then do + 'PIPE stem Server_list. |' , + 'literal Resetpsw run for' date() time() '|' , + '>> RESETPSW RESULTS A' + /* Run the ADSM commands to reset the passwords. */ + 'DSMADMC -ID='||Adsm_admin '-PASS='||Adsm_pass 'MACRO RESETPSW.ADSM' + if(RC^=0) then do + say 'Error running ADSM. See DSMERROR LOG' + 'EXEC SENDF DSMERROR LOG A TO URMM' + exit RC + end; +end; + +'ERASE QNODE OUTPUT A' +'ERASE RESETPSW ADSM A' + +**************************************************************** +STORRPT EXEC + +/* This exec will gather information storage usage on the ADSM server + and e-mail a report to the administrator. +MMM 3/31/95 + +*/ +address command + +Adsm_admin = 'MONITOR' +Adsm_pass = 'xxxxxxxx' +E_mail.0 = 1 +E_mail.1 = 'Martha McConaghy ' +'EXEC GETADSM' +if(RC^=0) then exit RC + +/* Run the ADSM commands necessary to collect the information. */ +'DSMADMC -ID='||Adsm_admin '-PASS='||Adsm_pass 'MACRO QSTOR.ADSM' +if(RC^=0) then do + say 'Error running ADSM. See DSMERROR LOG' + 'EXEC SENDF DSMERROR LOG A TO URMM' + exit RC +end; + +/* The following loop will generate e-mail and send it to each + address in E_mail. This is a reminder to do their backups + on their PC's. */ +do I = 1 to E_mail.0 + Note.1 = 'Date:' substr(date(Week),1,3)||',' date() time() + Note.2 = 'To:' E_mail.i + Note.3 = 'From: ADSM Backup Monitor <'||userid()||'@VM.MARIST.EDU'||'>' + Note.4 = 'Subject: ADSM Server Storage Report' + Note.5 = ' ' + Note.0 = 5 + 'PIPE (end ?) stem Note. |' , + 'a: fanin |' , + '> ADSM MAIL A' , + '? < QSTG OUTPUT A |' , + 'literal * |' , + 'a:' , + '? < QDB OUTPUT A |' , + 'literal * |' , + 'a:' , + '? < QDBV OUTPUT A |' , + 'literal * |' , + 'a:' + + 'EXEC SENDFILE ADSM MAIL A TO MAILER' +end; + +'ERASE QSTG OUTPUT A' +'ERASE QDB OUTPUT A' +'ERASE QDBV OUTPUT A' + +****************************************************************** +OLDBACKS REXX - pipeline filter + +/* */ +trace o +arg Threshold . + +do forever + 'readto record' + if RC<>0 then leave + parse var Record . 189 Last_back . + + select + when (Last_back='<1') then Stream = 1 + when (Last_back=0) then Stream = 2 + when (Last_back0) then do + Rec2 = E_addr.1 Node Last_date Last_time Filespace , + '@%' Name_text + 'select output 3' + if(RC^=0) then exit 99 + 'output' Rec2 + end; + end; +end; + +****************************************************************** +PICKPASS REXX - pipeline filter + +/* */ +trace o +arg Threshold . + +do forever + 'readto record' + if RC<>0 then leave + parse var Record Node Last_reset + if(Last_reset>Threshold) then 'output' Node + else iterate +end; + +****************************************************************** +REPORT REXX - pipeline filter + +/* This filter will format the FILESPAC data into a report format. + + MMM 3/30/95 +*/ + +Head.0 = 3 +Head.1 = substr('Contact Name',1,26)||substr('Node Name',1,21)|| , + substr('Filespace',1,21)||substr('Last Backup Completion',1,24)|| , + substr('Days Since Last',1,16) +Head.2 = substr(' ',1,70)||substr('Date and Time',1,24)|| , + substr('Good Backup',1,16) +Head.3 = ' ' +do I = 1 to Head.0 + 'output' head.i +end; + +do forever + 'readto record' + if(RC^=0) then leave + parse var Record Node 48 Filespace 95 Start_days Last_date , + Last_time Last_days . Name_text + Name_text = strip(Name_text,'L') + Node = strip(Node) + Filespac = strip(Filespace) + Outrec = substr(Name_text,1,25) substr(Node,1,20) , + substr(Filespace,1,20) substr(Last_date,1,11) , + substr(Last_time,1,12) substr(Last_days,1,16) + 'output' Outrec +end; + +****************************************************************** +QFILESP ADSM - ADSM macro + +/* Query the filespaces and gather the information. */ +QUERY FILESPACE FORMAT=DETAILED > QFILESP.OUTPUT.A +QUERY NODE FORMAT=DETAILED > QNODE.OUTPUT.A + +****************************************************************** +QPASSW ADSM - ADSM macro + +/* Query the nodes to get password info. */ +QUERY NODE * > QNODE.OUTPUT.A + +****************************************************************** +QSTOR ADSM - ADSM macro + +/* Query for info on storage and database */ +QUERY STG * > QSTG.OUTPUT.A +QUERY DB > QDB.OUTPUT.A +QUERY DBV > QDBV.OUTPUT.A + +****************************************************************** +FORCEMIG EXEC - PROP action routine + +/* This exec will reset the highmigration and lowmigration values on + the ADSM server, to either force a migration, or reset after one + has completed. It also will check to see if migration is feasible. + If the %Migr value is below 50%, then no migration is necessary. + Change Log: + + Written by Martha McConaghy 6/17/94 +*/ +address command +trace o +arg vmach vmacnod loid lonode msgtype propid propnode netid rtble +pull message +pull Command . +select + /* This will issue query command to server to check on %Migr value. */ + when Command='CHECK' then do + 'CP SEND DSMSERV QUERY STG' + 'GLOBALV SETS DSM_CHECK' vmach + end; + /* This will display check data back to issuer. Only supports BACKUPPOOL + currently. */ + when Command='VERIFY' then do + 'GLOBALV GET DSM_CHECK' + parse var Message . . . . Per_mig . + if(Per_mig>50) then do + 'EXEC TELL' dsm_check 'Ready to migrate ADSM data, ' , + 'Percent mig=' Per_mig + 'GLOBALV SETS DSM_CHECK GOFORIT' + end; + else 'EXEC TELL' dsm_check 'NOT ready to migrate ADSM data,' , + 'Percent mig=' Per_mig + end; + /* This will actually force migration by resetting the lowmig value + to 20 and the highmig value to 50. When %migr value rises above + the highmig threshold, migration occurs. Since we are using 50 + as our highwatermark, migration will not occur if the %migr is + below 50%. */ + when Command='MIGRATE' then do + 'GLOBALV GET DSM_CHECK' + if(Dsm_check^='GOFORIT') then do + 'EXEC TELL' vmach 'Cannot do ADSM migration at this time' + exit + end; + 'CP SEND DSMSERV UPDATE STGPOOL BACKUPPOOL LOWMIG=30' + 'CP SLEEP 1 SEC' + 'CP SEND DSMSERV UPDATE STGPOOL BACKUPPOOL HIGHMIG=50' + 'EXEC TELL' vmach 'ADSM migration initiated.' + 'GLOBALV SETS DSM_CHECK DONE' + end; + /* This is automatically called when migration completes successfully. + It resets the migration thresholds back to normal. */ + when Command='RESET' then do + 'CP SEND DSMSERV UPDATE STGPOOL BACKUPPOOL HIGHMIG=80' + 'CP SLEEP 1 SEC' + 'CP SEND DSMSERV UPDATE STGPOOL BACKUPPOOL LOWMIG=40' + 'EXEC TELL' lglopr '********************************************' + 'EXEC TELL' lglopr Message + 'EXEC TELL' lglopr '********************************************' + 'EXEC TELL' lglopr '********************************************' + 'EXEC TELL' lglopr 'Initiating DUMP DB processing ' + 'EXEC TELL' lglopr '********************************************' + 'CP SEND DSMSERV DUMP DB DEV=CARTRIDGE C=YES' + end; + otherwise nop +end; + +****************************************************************** +DUMPDB EXEC - PROP action routine + +/* This exec will collect the records associated with the DUMP + DB command for ADSM and write them to a file. The SEND parameter + indicates that this is the last message in the series and that the + file should be sent to the automated notification list. + Change Log: + + Written by Martha McConaghy 1/20/95 +*/ +address command +trace o +arg vmach vmacnod loid lonode msgtype propid propnode netid rtble +pull message +pull Command . + +select + when(Command='RUN') then do + 'CP SEND DSMSERV DUMP DB DEV=CARTRIDGE C=YES' + 'EXEC TELL' loid '********************************************' + 'EXEC TELL' loid '** ADSM Database Dump Begun **' + 'EXEC TELL' loid '********************************************' + 'EXEC TELL' vmach '********************************************' + 'EXEC TELL' vmach '** ADSM Database Dump Begun **' + 'EXEC TELL' vmach '********************************************' + end; + when(Command='SEND') then do + 'PIPE var Message|>> DUMPDB MAIL A' + 'EXEC WARNMAIL VMLIST 199 DUMPDB Results of ADSM DUMP DB' , + 'command.' + 'ERASE DUMPDB MAIL A' + 'EXEC TELL' loid '********************************************' + 'EXEC TELL' loid '** ADSM Database Dump Complete **' + 'EXEC TELL' loid '********************************************' + end; + otherwise 'PIPE var Message|>> DUMPDB MAIL A' +end; + +****************************************************************** +ADSMINST.CMD - OS/2 REXX exec + +/* This exec will make changes to the CONFIG.SYS necessary to run ADSM from the LAN server. It is meant only to install ADSM for an OS/2 system. It will also set up the directory and options file necessary to run ADSM. + +Written by Martha McConaghy 2/1/95 +*/ +trace o + +call RxFuncAdd 'SysLoadFuncs','RexxUtil','SysLoadFuncs' +call SysLoadFuncs + +Message = 'If you have ADSM installed locally, remove all references to it' , + 'from CONFIG.SYS. Do you want to continue?' +Action = RxMessageBox(Message,'ADSMINST Message','YESNO','QUESTION') +if(Action=7) then call error 0 'ADSMINST ended by user' + +say ' ' +say '*********************************************' +say 'Enter your ADSM node name:' +say '*********************************************' +say ' ' +pull Node . +if(2>length(Node)) then call error 10 'You must enter the ADSM node' , + 'name. If you don not have one,' , + 'request one through the Help Desk.' +say ' ' +/* Get information on LAN drives */ +call Get_LAN + +Message = 'Do you wish to update your CONFIG.SYS?' +Action = RxMessageBox(Message,'ADSMINST Message','YESNO','QUESTION') +if(Action=7) then signal Setup_options + +/* Make necessary changes to config.sys */ +call Find_config +do MM = 1 to Configs.0 + if(' '=Configs.MM) then iterate + Con_file = Configs.MM + Out_file = substr(Con_file,1,2)||'\CONFIG.NEW' + Back_file = substr(Con_file,1,2)||'\CONFIG.OLD' + Verify. = '' + Verify.0 = Configs.0 + + /* Check to make sure there aren't some ADSM stuff in there */ + Rc = SysFileSearch('ADSM',Con_file,Sch_res,'N') + if(0Status.0) then do + Rc = SysFileDelete(Out_file) + if(Rc<>0) then do + call sys_fail MM 15 'Unable to erase' Out_file + iterate + end; + end; + say ' ' + say 'Creating backup of' Con_file 'in' Back_file + 'COPY' Con_file Back_file + + /* Now make the changes */ + say ' ' + say 'Modifying' Con_file 'to add ADSM definitions' + do while (00) then do + call sys_fail MM 30 'Error writing to' Out_file 'RC:' Rc + iterate + end; + + /* Remember to close the con_file */ + Rc = lineout(Con_file) + Rc = SysFileDelete(Con_file) + if(Rc=0) then do + 'RENAME' Out_file substr(Con_file,4) + call SysFileTree Con_file,'Status' + if(0=Status.0) then do + say '***************************************************' + say 'Error creating CONFIG.SYS. Restoring from backup.' + say '***************************************************' + 'RENAME' Back_file Con_file + call sys_fail MM 70 + iterate + end; + else do + say Con_file 'updated successfully' + Verify.MM = 1 + end; + end; + else do + say '**************************************************' + say 'Error deleting' Con_file 'RC:' rc + say 'Original has not been modified.' + say '**************************************************' + call sys_fail MM 75 + iterate + end; /* else */ + say ' ' +end; /* original do */ +Failures = 0 +do I = 1 to Verify.0 + if(0=word(Verify.I,1)) then Failures = 1 +end; +if(Failures) then call error 88 'One or more CONFIG.SYS updates failed. Cannot continue.' +else do + Message = 'All CONFIG.SYS updates were successful.' + Action = RxMessageBox(Message,'ADSMINST Message',,'EXCLAMATION') + end; + +Setup_options: + +Message = 'Do you wish to create your local ADSM options file?' +Action = RxMessageBox(Message,'ADSMINST Message','YESNO','QUESTION') +if(Action=7) then call error 0 'ADSMINST ended by user' + +/* Now, if they don't have an ADSM directory, or options file, then + create both for them. */ +Local_opts = Local_dir||'\DSM.OPT' +Main_opts = 'O:\ADSM\DSM.SMP' +call SysFileTree Local_dir, 'Dirs', 'D' +if(0=Dirs.0) then do + say 'Creating' Local_dir + Rc = SysMkDir(Local_dir) + if(Rc<>0) then do + say 'Unable to create' Local_dir 'RC:' rc + exit 99 + end; + end; +else say Local_dir 'already exists. Creating options file.' + +call SysFileTree Local_opts, 'Opts' +if(0word(Rest,1)) + then Out_data = Opt_data + else Out_data = Keyword Rest + end; + when(Keyword='TCPSERVERADDRESS') + then Out_data = Keyword '148.100.1.2' + when(Keyword='TCPPORT') + then Out_data = Keyword Rest + when(Keyword='NODENAME') then do + if('YOUR_NODE_NAME'<>word(Rest,1)) + then Out_data = Opt_data + else Out_data = Keyword Node + end; + when(Keyword='EXCLUDE') + then Out_data = Keyword Rest + otherwise Out_data = Opt_data + end; /* select */ + Rc = lineout(Local_opts,Out_data) +end; + +call lineout(Local_opts) +if(Rc=0) then do + say 'Local options file:' Local_opts 'created successfully.' + 'ATTRIB' Local_opts '+R' + /* Create the ADSM icon in their desktop */ + Message = 'Local options have been set. We are about to create' , + 'the ADSM icon on the desktop.' + Action = RxMessageBox(Message,'ADSMINST Message',,'INFORMATION') + Title = "ADSM"||"0a"x||"Backup-Archive" + call SysCreateObject "WPProgram",Title,"", , + "EXENAME=O:\ADSM\DSM.EXE;STARTUPDIR=O:\ADSM;","REPLACE" + say "ADSM icon created on desktop" + end; +else say 'Error creating' Local_opts 'RC:' rc + +Message = 'ADSMINST has completed. Reboot and logon to server to try ADSM.' +Action = RxMessageBox(Message,'ADSMINST Message',,'INFORMATION') + +exit +/* end of exec */ + +Error: +parse arg Code Message +/* +say 'ADSMINST Error:' Code Message +*/ +Action = RxMessageBox(Message,'ADSMINST Error',,'ERROR') +exit Code + +Sys_fail: +/* This routine will record that we failed to update one CONFIG.SYS + and the reason why. */ +parse arg Counter Code Message +Verify.Counter = 0 Code Message +say ' ' +say 'ADSMINST Error updating:' Configs.Counter +say Code Message +if(1length(Drive_map)) then call error 8 'No remote drives found.' , + 'You must be logged onto the LAN server.' +if(1=words(Drive_map)) then LAN_drive = Drive_map +else do + say '**********************************************' + say ' Several LAN drives have been found:' + say ' ' + say ' ' Drive_map + say ' ' + say 'Select which drive to house your local options file, ie. F:' + pull LAN_drive . + say ' ' + if(2<>length(LAN_drive)) then call error 85 'Invalid LAN drive specified' + say 'Local ADSM directory will be created on' LAN_drive + end; + +Dir_name = '\ADSM' +Local_dir = LAN_drive||Dir_name +return +.fo diff --git a/vmworkshop-vmarcs/1995/marist95/backserv.pack b/vmworkshop-vmarcs/1995/marist95/backserv.pack new file mode 100644 index 0000000..52ac730 --- /dev/null +++ b/vmworkshop-vmarcs/1995/marist95/backserv.pack @@ -0,0 +1,430 @@ +******************************************************************* +BACKSERV.CMD + +/* +This exec will setup a TCP/IP socket to listen for incoming commands from an operator. It is designed to +be used on the Marist LAN Servers to allow operators to initiate ADSM backups from a remote host. +Written by Martha McConaghy 4/6/94 + +Change log: + 4/6/94 - add logging feature for connections, good or bad. MMM + 6/24/94 - add improved security and remove need for priv client list. MMM + 9/05/94 - add support for new command, CHKDSK. MMM + 11/11/94 - add support for restores. MMM +*/ +address CMD +trace o + +/* Initialize required constants. */ +port = 2500 +call RxFuncAdd 'SysFileTree','Rexxutil','SysFileTree' +Prog_dir = directory() + +/* Initialize the RXSocket function package and create the initial socket for listening. */ + rc = RxFuncAdd("SockLoadFuncs","RxSock","SockLoadFuncs") + rc = SockLoadFuncs() +Listen_sock = SockSocket("AF_INET","SOCK_STREAM",0) +if (Listen_sock = -1) then do + call log_it "Error on SockSocket:" errno + exit + end + +/* The following will cause control to transfer to the HALT subroutine when the program + is interrupted, like a ctl-C. */ +signal on halt + +/* Now bind to the socket */ +server.!family = "AF_INET" +server.!port = port +server.!addr = "INADDR_ANY" +rc = SockBind(Listen_sock,"server.!") +if (rc = -1) then do + call log_it "Error on SockBind:" errno + exit + end +/* +Level = "SOL_SOCKET" +rc = SockGetSockOpt(Listen_sock,level,"SO_RCVTIMEO","Rec_time") +say "****** GetOpt RC:" RC "Receive Timeout:" Rec_time +rc = SockGetSockOpt(Listen_sock,level,"SO_SNDTIMEO","Snd_time") +say "****** GetOpt RC:" RC "Send Timeout:" Snd_time +*/ + + +/* Now that we are bound to the socket, set up the listener and await incoming commands. */ +rc = SockListen(Listen_sock,10) +if (rc = -1) then do + call log_it "Error on SockListen:" errno + exit + end + +/* The following loop processes the incoming connection when the "listen socket" detects one. +*/ +do forever + say "Waiting for client" + + /* When a connection comes in, accept it and then validate that its someone we know. */ + Accept_sock = SockAccept(Listen_sock,"client.!") + if (Accept_sock = -1) then do + call log_it "Error on SockAccept:" errno + exit + end + +/* Now check to see if the incoming client is a valid one. If so, go on. If not, then reject connection.*/ + call Security_chk + Response = 'Security check:' Sec_num + rc = SockSend(Accept_sock,Response) + if(rc = -1) then do + call log_it "Error on SockSend:" errno + exit + end; + else rc = SockRecv(Accept_sock,"Sec_resp",30) + parse var Sec_resp . ':' Sec_code . + if(Sec_code<>Sec_result) then do + Response = 'Invalid client. Unable to accept connection.' + rc = SockSend(Accept_sock,Response) + call Log_it "Rejecting connection from" Client.!addr "Not priviledged client" + call Kill_it 0 + iterate + end; + else do + say 'Connecting client is valid' + Response = 'Connection accepted' + rc = SockSend(Accept_sock,Response) + call Log_it "Accepting connection from" Client.!addr + end; + + /* Now, receive data from contacting client. If syntax is valid, then perform requested action. */ + rc = SockRecv(Accept_sock,"Info",30) + if (rc = -1) then do + call log_it "Error on SockRecv:" errno + exit + end + say 'Received command from:' Client.!addr 'on socket:' Accept_sock + say 'Command is:' Info + call Log_it "Processing command:" Info "from" Client.!addr + select + when (Info='Backup Incremental') then call iback + when (Info='Backup Full') then call fback + when (Info='Restore') then call Restore_it + otherwise do + Response='Invalid command specified' + rc=SockSend(Accept_sock,Response) + call Log_it "Invalid command specified by" Client.!addr + end; + end; + + /* We are done for now, so kill the current socket and continue to listen. */ + call Kill_it 1 +end /* do forever */ +/* end of exec */ + +Halt: + /* They want to close down the program now, so clean up the sockets. */ + say + say "Quitting ..." + call Log_it "Shutting down server and closing sockets" + rc = SockSoClose(Listen_sock) + if datatype(Accept_sock,"W") then + rc = SockSoClose(Accept_sock) +exit + +Kill_it: + /* This subroutine closes out a current connected socket, but keeps the listen socket open.*/ + arg Good_close . + rc = SockSoClose(Accept_sock) + Accept_sock = "" + if (rc = -1) then do + call log_it "Error on SockSoClose:" errno + exit + end + if(Good_close) then say "Closing connection" + else say "Rejecting connection" + say +return + +Iback: + /* This routine will initiate the incremental backup on the server machine. */ + Response='Incremental backup being initiated' + rc=SockSend(Accept_sock,Response) + say 'Incremental Backup being initiated' + call Log_it "Initiating Incremental backup for:" Client.!addr + 'call BACKIN' + if (RC=0) then call Log_it "Incremental backup completed" + else call Log_it "Incremental backup with RC:" rc +return + +Fback: + /* This routine will initiate the full backup on the server machine. */ + Response='Full backup being initiated' + rc=SockSend(Accept_sock,Response) + call Log_it "Full backup being initiated for:" Client.!addr + say 'Full backup being initiated' + 'call BACKSEL' + if (RC=0) then call Log_it "Full backup completed" + else call Log_it "Full backup failed with RC:" rc +return + +Restore_it: + /* This routine will initiate the restore of a file on the server machine. */ + Response='File restore being initiated' + rc=SockSend(Accept_sock,Response) + say Response + /* Obtain the specs on the file(s) to be restored */ + rc = SockRecv(Accept_sock,"File_spec",50) + if (rc = -1) then do + call log_it "Error on SockRecv:" errno + exit + end + call Log_it "Initiating file restore for:" Client.!addr + 'call RESTIT' File_spec + if (RC=0) then call Log_it "Restore completed" + else call Log_it "Restore with RC:" rc +return + +Log_it: + /* This routine will log info passed to it in a file for tracking purposes. */ + procedure + parse arg Log_data + Log_data = 'Backserv:' date() time() Log_data + call lineout 'BACKSERV.LOG',Log_data + call lineout 'BACKSERV.LOG' + say Log_data + return + +Security_chk: + /* This routine will set up the security formula which will verify that + the incoming communication is from a trusted client. + */ + procedure expose Sec_num Sec_result + Sec_num = random() + Data = (3 * Sec_num) + 10 + Sec_result = (Data ** 2) % 6 +return +******************************************************************* +BACKIN.CMD + +/* Rexx exec to begin the ADSM incremental backup of a client machine. + + Written by Martha McConaghy 3/9/94 + + The exec takes as optional parameters the drives to be backed up, the nodeid of the ADSM + machine and its password. The drives can be specified in any order and should include the colon. + If the node and password are specified, enclose them in parens to seperate from drives. An + example would be: backin c: d: e: (CEILI.IS marthapw) If you don't specify any parameters, + the values will default to settings created at the beginning section of this exec. + + Change log: + + 7/11/94 - added date and time to report header and reduced the number of asterisks so + it would fit in under 80 chars. MMM +*/ +address CMD +trace o + +/* Customize the following three variables for the specific ADSM node. */ +call GETCUST +if(0=queued()) then do + call Log_it 'Unable to read customization data, exiting backup.' + exit 10 +end; +do while 00) then do /* If it exist + if(Stat_History.0=0) then 'COPY' Backup_log History_log + else do + 'ERASE' History_log + 'COPY' Backup_log History_log + end; + 'ERASE' Backup_log +end; + +/* Create new log file with identifier so we can tell them apart on the mainframe. */ +Hdr_text = '********** Incremental backup for node:' ADSM_node date() time() '**********' +call lineout Backup_log,Hdr_text,1 +call lineout Backup_log + +/* Save the current variables, so we can change them. */ +Res = setlocal() +if(Res\=1) then do + call Log_it 'Unable to save current configuration' + exit 15 +end; + +/* Now, the moment of truth, run the backup */ +'SET DSM_CONFIG=INCR.OPT' +'DSMC I ' Incr_drives ' -password=' || ADSM_pass '>> backup.log' +if(RC=0) then call Log_it 'Backup ended successfully' + else call Log_it 'Backup has ended with bad return code. Check' Backup_log +Res = endlocal() + +/* Now, send log up to VM for archiving. */ +'lpr -b -pARCHIVE -sVM.MARIST.EDU backup.log' +if(RC=0) then call Log_it 'Backup log successfully sent to VM' + else call Log_it 'Error sending log to VM, RC:' rc +call directory(Prog_dir) +exit RC + +/* end of exec */ + +Log_it: +/* This subroutine will log info passed to it in a file for tracking. */ + procedure + parse arg Log_data + Log_data = 'Backin:' date() time() Log_data + call lineout 'BACKSERV.LOG',Log_data + call lineout 'BACKSERV.LOG' + say Log_data + return +******************************************************************* +BACKSEL.CMD + +/* Rexx exec to begin the ADSM selective backup of a client machine. + + Written by Martha McConaghy 3/15/94 + + The exec takes as optional parameters the drives to be backed up, the nodeid of the ADSM + machine and its password. The drives can be specified in any order and should include the colon. + If the node and password are specified, enclose them in parens to seperate from drives. An + example would be: backin c: d: e: (CEILI.IS marthapw) If you don't specify any parameters, + the values will default to settings created at the beginning section of this exec. + + Change log: + + 7/11/94 - Added date and time to report header and reduced the number of stars so it + would fit in under 80 chars. MMM + 10/6/94 - Ensure that the node name reported in the log matches the node name in + the FULLDUMP.OPT file. All should include "_FULL" at the end. MMM +*/ +address CMD +trace o +arg Sub_dirs '(' ADSM_node Password ')' . + +/* Set defaults for variables and environment. */ +call GETCUST +if (0=queued()) then do + call Log_it 'Unable to locate customization data' + exit 10 +end; +do while 00) then do /* If it exist + if(Stat_History.0=0) then 'COPY' Backup_log History_log + else do + 'ERASE' History_log + 'COPY' Backup_log History_log + end; + 'ERASE' Backup_log +end; + +/* Create new log file with identifier so we can tell them apart on the mainframe. */ +parse var ADSM_node Hold_it '_' . +ADSM_node = Hold_it || '_FULL' +Hdr_text = '********** Full backup for node:' ADSM_node date() time()'**********' +call lineout Backup_log,Hdr_text,1 +call lineout Backup_log + +/* Save the current variables, so we can change them. */ +Res = setlocal() +if(Res\=1) then do + say 'Unable to save current configuration' + exit 99 +end; + +/* Now, the moment of truth, run the backup */ +'SET DSM_CONFIG=FULLDUMP.OPT' +'DSMC S -password=' || ADSM_pass '-subdir=yes -tapeprompt=no' Full_dirs '>> backup.log' +if(RC=0) then say 'Backup ended successfully' + else say 'Backup has ended with bad return code. Check' Backup_log +Res = endlocal() + +/* Now, send log up to VM for archiving. */ +'lpr -b -pARCHIVE -sVM.MARIST.EDU backup.log' +if(RC=0) then say 'Backup log successfully sent to VM' + else say 'Error sending log to VM, RC:' rc +call directory(Prog_dir) +exit RC + +/* End of exec */ + +Log_it: +/* This function will log information for tracking. */ + procedure + parse arg Log_data + Log_data = 'Backsel:' date() time() Log_data + call lineout 'BACKSERV.LOG',Log_data + call lineout 'BACKSERV.LOG' + say Log_data + return +******************************************************************* +GETCUST.CMD + +/* This routine will read a file of customization data and return the REXX code necessary to set + these values within the call exec. The code is returned as a string of characters which are then + executed by the calling exec to set the values. The strings are passed back through the current + defined queue. The order of the strings passed back will depend on the order of the records in + the customization file. + + Written by Martha McConaghy 4/7/94 + Change log: + 7/13/94 - Change comment character to # due to conflict with directory definitions. MMM +*/ +address Command +trace o +'@echo off' + +Cust_file = 'BACKCUST.DAT' +if(0=lines(Cust_file)) then do + say 'Unable to locate customize file:' Cust_file + exit 99 +end; +do while 0 command name, no DIAL INFO +./ I 07971200 $ 07971210 + DC AL1(3),X'80',CL8'INFO' INFO +./ I 07972300 $ 07972310 +SYSCMD EQU X'80' command, not system to dial to INFO + PAGE 00001 + +./ * HCPDIA INFO +./ * new command to dial to specific MUSICA ports for CWIS +./ * Anne-Marie Marcoux, McGill University marie@vm1.mcgill.ca +./ I 03730000 $ 03730100 + MVI WHICHCMD,OTHERCMD indicate normal DIAL INFO +./ I 03814990 $ 03815000 +GETVMDBK DS 0H join here for INFO command INFO +./ I 04130000 $ 04130100 + CLI WHICHCMD,INFOCMD are we doing the INFO thing? INFO + BE DIAL02 yes, all set INFO +./ I 06602240 $ 06602250 + ICM R0,B'1000',WHICHCMD pass flag for type of dial INFO +./ I 13940000 $ 13940100 10 +*START OF SPECIFICATIONS*******************************************INFO +* INFO +* Entry point name - HCPDIAIN INFO +* INFO +* Descriptive name - Dial processing for INFO command INFO +* INFO +* Function - The INFO command is really DIAL MUSICA vaddr INFO +* where: vaddr >= 100 INFO +* Warning: no upper bound is checked, assuming the portsINFO +* are at the very end of the dial range INFO +* INFO +* SAVEWRK7 holds the flag, set a few things and join HCPDIAL code INFO +* INFO +*END OF SPECIFICATIONS************************************************* +HCPDIAIN HCPENTER CALL,SAVE=DYNAMIC INFO + MVI WHICHCMD,INFOCMD indicate INFO command INFO + MVC SAVEWRK8(8),=CL8'MUSICA' userid to DIAL to INFO + LA R0,8 setup length for SCVMD call INFO + LA R1,SAVEWRK8 setup address for SCVMD callINFO + B GETVMDBK join common code INFO + EJECT INFO +./ I 15530000 $ 15530100 100 + ORG SAVEWRK7 INFO +WHICHCMD DS XL1 is it INFO or normal DIAL ? INFO +OTHERCMD EQU X'00' INFO +INFOCMD EQU X'01' INFO \ No newline at end of file diff --git a/vmworkshop-vmarcs/1995/marist95/pfkdial.info21 b/vmworkshop-vmarcs/1995/marist95/pfkdial.info21 new file mode 100644 index 0000000..ed442a1 --- /dev/null +++ b/vmworkshop-vmarcs/1995/marist95/pfkdial.info21 @@ -0,0 +1,205 @@ +The PFKDIAL modification allows you to define PF keys to be used in +the pre-logon state. These PF keys can be assigned CP commands that +are also valid in the pre-logon state to make them easier to use. + +The original PFKDIAL mod came from Anne-Marie Marcoux of McGill +University (MARIE@VM1.McGill.CA). The mod in this file is essentially +the same as the original. A few serial numbers have been updated +to conform with my level of VM/ESA (1.0 SLC 9202) and support for +other CP commands, besides DIAL, has been added. These changes are +slight, however, and the mod remains essentially the McGill version. + +The bulk of the work is done by HCPBVM, which processes the PF key +and contains a table of the key definitions. The original mod +only allowed DIAL commands to be defined to each key, ie. it hardcoded +DIAL into the processing of the key. I have extended the mod to allow +any valid pre-logon CP command to be placed in the table. + +HCPLOG and HCPLON are modified to allow PF keys to be used. HCPMES +and HCPMXRBK are modified to change the messages on the pre-logon +screen. + +My thanks to Anne-Marie for sharing her mod with me and her +permission to post in on the LISTSERV. + +As usual, you are free to do with this what you will. Questions, +comments and feedback (but no complaints) can be sent to Martha +McConaghy, Marist College (URMM@VM.MARIST.EDU) (914) 575-3252. +06/05/94 +********************************************************************** + +HCPBVM PFKDIAL + +./ * HCPBVM PFKDIAL +./ * let users dial by hitting PF keys +./ * vmdpfunc points to a 24 fullword list which in turn points +./ * to gsdbloks for those pfkeys having settings +./ * see module HCPPFK for pfk processing +./ I 00935001 $ 937001 2000 05/03/94 17:53:42 +* HCPGSDBK - General System Data Block PFKDIAL +./ I 00980001 $ 985001 5000 05/03/94 17:53:42 +* HCPPFUNC - PF Keys Function block PFKDIAL +./ I 01960001 $ 1962001 2000 05/03/94 17:53:42 + COPY HCPGSDBK - General system data block PFKDIAL +./ I 02000001 $ 2005001 5000 05/03/94 17:53:42 + COPY HCPPFUNC - PF Keys Function Table PFKDIAL +./ I 10070001 $ 10070101 100 05/03/94 17:53:42 +************************************************************** PFKDIAL +* * PFKDIAL +* Now create PFK entries for menu to be shown at logon * PFKDIAL +* Make sure R8 and R10 are unchanged * PFKDIAL +* * PFKDIAL +************************************************************** PFKDIAL + HCPUSING RDEV,R8 PFKDIAL +PFKDIAL CLI RDEVCLAS,CLASGRAF is this a local 3270? PFKDIAL + BNE PFKDONE no, then no PFKs PFKDIAL +PFKDEFS LA R2,PFDEFS R2 -> list of definitions PFKDIAL + HCPUSING SYSDEF,R2 PFKDIAL + LA R4,NPFDEFS R4 = number of these definitions PFKDIAL +* just covering here, an already defined function table PFKDIAL +* means it wasn't released properly last time around! PFKDIAL +* and that's a BUG !!! PFKDIAL + ICM R1,B'1111',VMDPFUNC get the function table PFKDIAL + BNZ FILLKEYS this is not the first time PFKDIAL +* In VM/ESA 2.1, the PFUNC block was added to map the list PFKDIAL +* of pointers to the PF key definitions. We must use that PFKDIAL +* block layout now. PFKDIAL + LA R0,PFUNSZD(R1) Let's get one then. PFKDIAL + HCPGETST LEN=(R0),TYPE=GUESTPERM get free storage PFKDIAL + ST R1,VMDPFUNC save that precious address PFKDIAL + LR R6,R1 PFKDIAL + HCPUSING PFUNC,R6 PFKDIAL + XC 0(PFUNSZD*8,R1),0(R1) Zero out the whole thing PFKDIAL + LA R6,PFUNGSDS Get location of PF pointers PFKDIAL + HCPDROP R6 PFKDIAL +* Now load the PFUNC table and create GSD's for each PFKDIAL +* PF key to be defined. PFKDIAL +FILLKEYS SLR R3,R3 clear to PFKDIAL + IC R3,SYSKEY ... load PF key number PFKDIAL + LA R0,PFDENTRY size of block PFKDIAL + HCPGETST ID=GSDBK,LEN=(R0),TYPE=GUESTPERM get it! PFKDIAL + SLL R3,2 Calculate the index into the PFKDIAL + S R3,PFX4 ...function table for this PF PFKDIAL + AR R3,R6 Add offset to table pointer PFKDIAL + ST R1,0(,R3) store gsdbk into addr table slot PFKDIAL + SPACE 1 PFKDIAL + HCPUSING GSDBK,R1 addressability to PF GSDBK PFKDIAL + STH R0,GSDFRESZ save the double word size PFKDIAL + LA R5,L'SYSNAME length of data to be moved PFKDIAL + STH R5,GSDDCNT save the pfdata data count PFKDIAL + MVC GSDDATA(L'SYSNAME),SYSNAME move part 2 PFKDIAL + MVC GSDFLAG,=AL1(GSDPFIMM) immediate PF key PFKDIAL + CLI RDEVTYPE,TYP3278 got 24-PFkey terminal ? PFKDIAL + BNE NEXTSYS nope, all done for this one then PFKDIAL + SPACE 1 PFKDIAL + HCPGETST ID=GSDBK,LEN=(R0),TYPE=GUESTPERM get one morPFKDIAL + LA R3,4*12(,R3) repeat at PF(n+12) PFKDIAL + ST R1,0(,R3) store gsdbk into addr table slot PFKDIAL + HCPUSING GSDBK,R1 addressability to PF GSDBK PFKDIAL + STH R0,GSDFRESZ save the double word size PFKDIAL + STH R5,GSDDCNT save the pfdata data count PFKDIAL +* MVC GSDDATA(L'DIAL),DIAL move pfdata part 1 PFKDIAL + MVC GSDDATA(L'SYSNAME),SYSNAME move part 2 PFKDIAL + MVC GSDFLAG,=AL1(GSDPFIMM) immediate PF key PFKDIAL + SPACE 1 PFKDIAL +NEXTSYS LA R2,SYSLEN(,R2) PFKDIAL + BCT R4,FILLKEYS move on to next definition PFKDIAL + HCPDROP R1,R2,R8 PFKDIAL + SPACE 1 PFKDIAL +PFKDONE DS 0H PFKDIAL +./ I 12710001 $ 12710401 400 05/03/94 17:53:42 + EJECT PFKDIAL +* PFdefs : PFKDIAL +* Byte 1 = PFK number PFKDIAL +* Byte 2 = cpu number X'01' --> VM1 PFKDIAL +* X'02' --> VM2 PFKDIAL +* X'00' --> system runs on both PFKDIAL +* BYTE 3-15 = command to issue PFKDIAL +* PFKDIAL +PFDEFS DC AL1(1),X'01',CL13'DIAL MUSICA' PFKDIAL + DC AL1(2),X'01',CL13'DIAL MUSICB' PFKDIAL + DC AL1(11),X'01',CL13'ADDR' PFKDIAL + DC AL1(12),X'01',CL13'LOGOFF' PFKDIAL + SPACE 1 PFKDIAL +NPFDEFS EQU (*-PFDEFS)/15 PFKDIAL +PFDENTRY EQU (L'SYSNAME+7)/8+GSDHSIZE double words PFKDIAL +* Size of each PFkey entry PFKDIAL + SPACE 1 PFKDIAL +SYSDEF DSECT initial PFK definition PFKDIAL +SYSKEY DS X PFK number PFKDIAL +SYSFLAG DS X cpu flag PFKDIAL +SYSNAME DS CL13 name of system to dial PFKDIAL +SYSLEN EQU *-SYSDEF length of this dsect PFKDIAL + SPACE 3 PFKDIAL +********************************************************************* + +HCPLOG PFKDIAL + +./ * HCPLOG PFKDIAL +./ * let users dial by hitting PFkeys +./ I 00970001 $ 00970100 +* HCPPFKPG - Deallocate PF key storage PFKDIAL +./ I 02820001 $ 02820100 + EXTRN HCPPFKPG PFKDIAL +./ * this part entered if new user is logging on +./ * skeleton vmblok must reset pfkeys first +./ I 11090001 $ 11090100 100 + HCPCALL HCPPFKPG deallocate PF key storage PFKDIAL + SPACE 1 PFKDIAL +********************************************************************* + +HCPLON PFKDIAL + +./ * HCPLON PFKDIAL +./ * let users dial by hitting PF keys +./ R 10030001 $ 10034991 4990 05/02/94 15:53:00 + HCPDROP R3 PFKDIAL +./ R 10060001 $ 10060991 990 05/02/94 15:53:00 + LA R14,5 Hardcode version 5 PFKDIAL + CLI RDEVTYPE,TYP3278 Do we have 24 PF keys? PFKDIAL + BE PTFOK Yes, then we are cool. PFKDIAL + HCPDROP R8 PFKDIAL + LA R14,6 No, then use version 6 PFKDIAL +PTFOK BCTR R14,0 Decrement for offset PFKDIAL +********************************************************************* + +HCPMES PFKDIAL + +./ * HCPMES PFKDIAL +./ * let users dial by hitting PF keys +./ R 60389202 60569202 $ 60569300 50 07/10/92 10:40:48 +* PFKDIAL +* Translation information for message 7060-05 PFKDIAL +* No fields need to be translated PFKDIAL +70600501R PFKDIAL +70600502 Use a PFkey to access the desired system: PFKDIAL +70600503 PFKDIAL +70600504 PF1 or PF13: Dial MUSICA PFKDIAL +70600505 PF2 or PF14: Dial MUSICB PFKDIAL +70600506 PF11 or PF23: ADDR PFKDIAL +70600507 PF12 or PF24: LOGOFF PFKDIAL +* PFKDIAL +* Translation information for message 7060-06 PFKDIAL +* No fields need to be translated PFKDIAL +70600601R PFKDIAL +70600602 Use a PFkey to access the desired system: PFKDIAL +70600603 PFKDIAL +70600604 PF1: Dial MUSICA PFKDIAL +70600605 PF2: Dial MUSICB PFKDIAL +70600606 PF11: ADDR PFKDIAL +70600607 PF12: LOGOFF PFKDIAL +* PFKDIAL +* Translation information for message 7060-07 PFKDIAL +* No fields need to be translated PFKDIAL +70600701R PFKDIAL +70600702 Use a PFkey to access the desired system: PFKDIAL +70600703 PFKDIAL +70600704 PF1 or PF13: musicf PFKDIAL +* PFKDIAL +* Translation information for message 7060-08 PFKDIAL +* No fields need to be translated PFKDIAL +70600801R PFKDIAL +70600802 Use a PFkey to access the desired system: PFKDIAL +70600803 PFKDIAL +70600804 PF1: musicf PFKDIAL +* PFKDIAL diff --git a/vmworkshop-vmarcs/1995/marist95/pfkdial2.info b/vmworkshop-vmarcs/1995/marist95/pfkdial2.info new file mode 100644 index 0000000..a8cf20b --- /dev/null +++ b/vmworkshop-vmarcs/1995/marist95/pfkdial2.info @@ -0,0 +1,177 @@ +This is the original PFKDIAL mod written at McGill University by Anne-Marie +Marcoux. It allows the use of PF keys from the pre-logon state to dial +into a guest system. It was running on a VM/ESA ESA 1.0 system. + + PAGE 00001 +./ * HCPLOG PFKDIAL +./ * let users dial by hitting PFkeys +./ * Anne-Marie Marcoux, McGill University marie@vm1.mcgill.ca +./ I 00810000 $ 00810100 +* HCPPFKPG - Deallocate PF key storage PFKDIAL +./ I 02040000 $ 02040100 + EXTRN HCPPFKPG PFKDIAL +./ * this part entered if new user is logging on +./ * skeleton vmblok must reset pfkeys first +./ I 07323270 $ 07323300 100 + HCPCALL HCPPFKPG deallocate PF key storage PFKDIAL + SPACE 1 PFKDIAL + PAGE 00001 + +./ * HCPBVM PFKDIAL +./ * let users dial by hitting PF keys +./ * Anne-Marie Marcoux, McGill University marie@vm1.mcgill.ca +./ I 01515000 $ 01515100 + COPY HCPGSDBK - General system data block PFKDIAL +./ * vmdpfunc points to a 24 fullword list which in turn points +./ * to gsdbloks for those pfkeys having settings +./ * see module HCPPFK for pfk processing +./ I 07380000 $ 07380100 10 +************************************************************** PFKDIAL +* * PFKDIAL +* Now create PFK entries for menu to be shown at logon * PFKDIAL +* Make sure R8 and R10 are unchanged * PFKDIAL +* * PFKDIAL +************************************************************** PFKDIAL + HCPUSING RDEV,R8 PFKDIAL +PFKDIAL CLI RDEVCLAS,CLASGRAF is this a local 3270? PFKDIAL + BNE PFKDONE no, then no PFKs PFKDIAL +PFKDEFS LA R2,PFDEFS R2 -> list of definitions PFKDIAL + HCPUSING SYSDEF,R2 PFKDIAL + LA R4,NPFDEFS R4 = number of these definitions PFKDIAL +* just covering here, an already defined function table PFKDIAL +* means it wasn't released properly last time around! PFKDIAL +* and that's a BUG !!! PFKDIAL + ICM R1,B'1111',VMDPFUNC get the function table PFKDIAL + BNZ FILLKEYS this is not the first time PFKDIAL + SPACE 1 PFKDIAL + LA R0,PFTABSIZ let's get one then! PFKDIAL + HCPGETST LEN=(R0),TYPE=GUESTPERM get free storage PFKDIAL + ST R1,VMDPFUNC save that precious address PFKDIAL +* will not worry about other VMDBKs here since dummy PFKDIAL +* vmdblok will never be for MP user PFKDIAL + XC 0(PFTABSIZ*8,R1),0(R1) zero out the whole thing PFKDIAL +FILLKEYS SLR R3,R3 clear to PFKDIAL + IC R3,SYSKEY ... load PF key number PFKDIAL + LA R0,PFDENTRY size of block PFKDIAL + HCPGETST ID=GSDBK,LEN=(R0),TYPE=GUESTPERM get it! PFKDIAL + SLL R3,2 Calculate the index into the PFKDIAL + S R3,PFX4 ...function table for this PF PFKDIAL + A R3,VMDPFUNC point to right spot PFKDIAL + ST R1,0(,R3) store gsdbk into addr table slot PFKDIAL + SPACE 1 PFKDIAL + HCPUSING GSDBK,R1 addressability to PF GSDBK PFKDIAL + STH R0,GSDFRESZ save the double word size PFKDIAL + LA R5,L'DIAL+L'SYSNAME length of data to be moved PFKDIAL + STH R5,GSDDCNT save the pfdata data count PFKDIAL + MVC GSDDATA(L'DIAL),DIAL move pfdata part 1 PFKDIAL + MVC GSDDATA+L'DIAL(L'SYSNAME),SYSNAME move part 2 PFKDIAL + MVC GSDFLAG,=AL1(GSDPFIMM) immediate PF key PFKDIAL + CLI RDEVTYPE,TYP3278 got 24-PFkey terminal ? PFKDIAL + BNE NEXTSYS nope, all done for this one then PFKDIAL + SPACE 1 + HCPGETST ID=GSDBK,LEN=(R0),TYPE=GUESTPERM get one morePFKDIAL + LA R3,4*12(,R3) repeat at PF(n+12) PFKDIAL + ST R1,0(,R3) store gsdbk into addr table slot PFKDIAL + HCPUSING GSDBK,R1 addressability to PF GSDBK PFKDIAL + STH R0,GSDFRESZ save the double word size PFKDIAL + STH R5,GSDDCNT save the pfdata data count PFKDIAL + MVC GSDDATA(L'DIAL),DIAL move pfdata part 1 PFKDIAL + MVC GSDDATA+L'DIAL(L'SYSNAME),SYSNAME move part 2 PFKDIAL + MVC GSDFLAG,=AL1(GSDPFIMM) immediate PF key PFKDIAL + SPACE 1 PFKDIAL +NEXTSYS LA R2,SYSLEN(,R2) PFKDIAL + BCT R4,FILLKEYS move on to next definition PFKDIAL + DROP R1,R2,R8 PFKDIAL + SPACE 1 PFKDIAL +PFKDONE DS 0H +./ I 07970000 $ 07970100 100 + EJECT PFKDIAL +DIAL DC C'DIAL ' PFKDIAL + SPACE 1 PFKDIAL +* PFdefs : PFKDIAL +* Byte 1 = PFK number PFKDIAL +* Byte 2 = cpu number X'01' --> VM1 PFKDIAL +* X'02' --> VM2 PFKDIAL +* X'00' --> system runs on both PFKDIAL +* BYTE 3-10 = system id PFKDIAL +* PFKDIAL +PFDEFS DC AL1(1),X'01',CL8'MUSICA' PFKDIAL + DC AL1(2),X'01',CL8'MUSICB' PFKDIAL + DC AL1(4),X'01',CL8'MULTI' PFKDIAL + SPACE 1 PFKDIAL +NPFDEFS EQU (*-PFDEFS)/10 PFKDIAL +PFTABSIZ EQU 13 Size of PF table in double words PFKDIAL +* copied from HCPPFK PFKDIAL +PFDENTRY EQU (L'DIAL+L'SYSNAME+7)/8+GSDHSIZE double words PFKDIAL +* Size of each PFkey entry PFKDIAL + SPACE 1 PFKDIAL +SYSDEF DSECT initial PFK definition PFKDIAL +SYSKEY DS X PFK number PFKDIAL +SYSFLAG DS X cpu flag PFKDIAL +SYSNAME DS CL8 name of system to dial PFKDIAL +SYSLEN EQU *-SYSDEF length of this dsect PFKDIAL + SPACE 3 PFKDIAL + PAGE 00001 + +./ * HCPMXRBK PFKDIAL +./ * let users dial by hitting PF keys +./ * Anne-Marie Marcoux, McGill University marie@vm1.mcgill.ca +./ R 12547100 12549200 $ 12548000 100 +MS706005 EQU X'00706005' PFKDIAL +MS706006 EQU X'00706006' PFKDIAL +MS706007 EQU X'00706007' PFKDIAL +MS706008 EQU X'00706008' PFKDIAL + PAGE 00001 + +./ * HCPMES PFKDIAL +./ * let users dial by hitting PF keys +./ * Anne-Marie Marcoux, McGill University marie@vm1.mcgill.ca +./ R 74808400 74808870 $ 74808500 10 +* PFKDIAL +* Translation information for message 7060-05 PFKDIAL +* No fields need to be translated PFKDIAL +70600501R PFKDIAL +70600502 Use a PFkey to access the desired system: PFKDIAL +70600503 PFKDIAL +70600504 PF1 or PF13: musica PFKDIAL +70600505 PF2 or PF14: musicb PFKDIAL +70600506 PF3 or PF15 (or type INFO): infoMcGill PFKDIAL +70600507 PF4 or PF16: tso, muse PFKDIAL +* PFKDIAL +* Translation information for message 7060-06 PFKDIAL +* No fields need to be translated PFKDIAL +70600601R PFKDIAL +70600602 Use a PFkey to access the desired system: PFKDIAL +70600603 PFKDIAL +70600604 PF1: musica PFKDIAL +70600605 PF2: musicb PFKDIAL +70600606 PF3 (or type INFO): infoMcGill PFKDIAL +70600607 PF4: tso,muse PFKDIAL +* PFKDIAL +* Translation information for message 7060-07 PFKDIAL +* No fields need to be translated PFKDIAL +70600701R PFKDIAL +70600702 Use a PFkey to access the desired system: PFKDIAL +70600703 PFKDIAL +70600704 PF1 or PF13: musicf PFKDIAL +* PFKDIAL +* Translation information for message 7060-08 PFKDIAL +* No fields need to be translated PFKDIAL +70600801R PFKDIAL +70600802 Use a PFkey to access the desired system: PFKDIAL +70600803 PFKDIAL +70600804 PF1: musicf PFKDIAL + PAGE 00001 + +./ * HCPLON PFKDIAL +./ * let users dial by hitting PF keys +./ * Anne-Marie Marcoux, McGill University marie@vm1.mcgill.ca +./ D 09873850 09874821 +./ D 09874849 09876350 +./ R 09876500 09876700 $ 09876600 10 + ICM R0,ALL,=AL4(MS706005) load message nbr PFKDIAL + CLI RDEVTYPE,TYP3278 got 24-PFkey terminal ? PFKDIAL + BE PTOK yup, R0 is OK PFKDIAL + ICM R0,ALL,=AL4(MS706006) load 12 PFkey msg nbr PFKDIAL +PTOK HCPCALL HCPERMSG,PARM=R2 Issue the prompt PFKDIAL +./ D 09877300 09877600 \ No newline at end of file diff --git a/vmworkshop-vmarcs/1995/marist95/qnames.info21 b/vmworkshop-vmarcs/1995/marist95/qnames.info21 new file mode 100644 index 0000000..412c7c3 --- /dev/null +++ b/vmworkshop-vmarcs/1995/marist95/qnames.info21 @@ -0,0 +1,183 @@ +The purpose of this mod is to reformat the output of the QUERY NAMES command. +The results of this command on a vanilla system includes the address of +where the virtual machine is running or 'DSC' for disconnected machines. +On a large system, such as a 3090-200E, this can generate several screens +worth of data and is confusing to unsophisticated users. This mod removes +the address from the display, and shows 8 virtual machine names on each line. +This greatly decreases the size of the display. + +In addition, this mod adds several new options to the command. The 'ALL' +option shows all virtual machines running on the system, whether they +are connected or not. This is the default. The 'DISCONNECT' option shows +only those machines that are running disconnected, while 'CONNECT' shows +only connected machines. Finally, 'SNA' shows only those machines that +are logged onto the system via a *VSM connection (ie. VTAM or TCPIP). + +The following is an example of how the QUERY NAMES command looks after +this mod: + +query names all + +STSS KMMQ STMQ URCG URBP UICOMM SYS$MMM SYS$DKB +URDB UIHD JZEM MUSICB URLS URMJ KK3R HDPOPR1 +XAMWRITE MUSICC MUSICA SERVDIR HDPCNTRL VMNET MARISTA MARISTC +MARISTB SPSSBAT PRT3820 PDMREM1 PDMGRP3 SFCM RSCS MAILER +LISTSERV SIM3278 SQL2DBA NETSERV RSCSX GCS AUTOLINK OPERSYMP +URMM2 + +query names disconnect + +STSS KMMQ STMQ JZEM MUSICB XAMWRITE MUSICC MUSICA +HDPCNTRL VMNET MARISTA MARISTC MARISTB SPSSBAT PRT3820 PDMREM1 +PDMGRP3 SFCM RSCS MAILER LISTSERV SIM3278 SQL2DBA NETSERV +RSCSX GCS AUTOLINK OPERSYMP + +query names connect + +URCG URBP UICOMM SYS$MMM SYS$DKB URDB UIHD URLS +URMJ KK3R HDPOPR1 SERVDIR URMM2 + +query names sna + +VSM - VTAM +URCG -LM020B2A +VSM - TCPIPA +VSM - TCPIPB +VSM - TCPIP +VSM - TCPIPC + +The mod contained in this file is running on VM/ESA ESA 2.1 and it only +effects module HCPCQU. + +Problems, questions or comments should be sent to the mod developer, +Martha McConaghy URMM@MARIST (BITNET) or URMM@VM.MARIST.EDU (Internet) +Senior VM Systems Programmer +Marist College +Poughkeepsie, NY 12601 +(914) 575-3252 +6/05/94 + +HCPCQU QNAMES +./ R 02360001 02400001 $ 2366991 6990 05/12/94 18:50:59 +* +----------+--------------------+ * QNAMES +* | QUERY | NAMES | * QNAMES +* | QUERY | | * QNAMES +* | QUERY | | * QNAMES +* | QUERY | | * QNAMES +* +----------+--------------------+ * QNAMES +./ R 02440001 02510001 $ 2449991 9990 05/12/94 18:50:59 +* ALL - PRINTS ALL CONNECTED AND DISCONNECTED USERS * QNAMES +* DISCONN- PRINTS ONLY DISCONNECTED USERS * QNAMES +* CONNECT- PRINTS ONLY CONNECTED USERS * QNAMES +* SNA - PRINTS ALL SNA USERS W/LUNAMES * QNAMES +* * QNAMES +./ R 02540001 $ 2544991 4990 05/12/94 18:50:59 +* 2. PLACE FIELD IN BUFFER EIGHT TO A LINE. * QNAMES +./ R 02640001 02660001 $ 2646991 6990 05/12/94 18:50:59 +* USERID USERID USERID USERID USERID USERID USERID USERID * QNAMES +* ... * QNAMES +* - * QNAMES +./ I 02930001 $ 2932001 2000 05/12/94 18:50:59 + LA R0,1(0) GET BLOCK FOR QNAMOP QNAMES + HCPGETST LEN=(R0) QNAMES + LR R9,R1 QNAMES + HCPUSING QNAMOP,R9 QNAMES +./ R 02960001 $ 2960391 390 05/12/94 18:50:59 + BNZ SETDEF NO OPERANDS? SET TO 'ALL' QNAMES + LR R6,R0 SAVE LENGTH QNAMES + BCTR R6,0 QNAMES +* CHECK OPERANDS QNAMES + EX R6,CLCALL QNAMES + BE SETDEF QNAMES + EX R6,CLCDISC QUERY DISCONNECTED USERS? QNAMES + BNE CONNECT NO, NEXT ONE QNAMES + MVI QNAMFLG,QDISC SET DISCONNECT FLAG QNAMES + B QRYSTRT GO DO IT QNAMES +CONNECT EX R6,CLCCONN QUERY CONNECTED USERS? QNAMES + BNE SNAUSRS NO, NEXT ONE QNAMES + MVI QNAMFLG,QCONN SET CONNECT FLAG QNAMES + B QRYSTRT GO DO IT QNAMES +SNAUSRS EX R6,CLCSNA QUERY SNA USERS? QNAMES + BNE SETDEF NO, THEN DO ALL ANYWAY QNAMES + MVI QNAMFLG,QSNA SET SNA FLAG QNAMES + B QRYSTRT GO DO IT QNAMES +SETDEF MVI QNAMFLG,QALL SET ALL FLAG QNAMES +QRYSTRT DS 0H QNAMES +./ I 04180001 $ 4183001 3000 05/12/94 18:50:59 + TM QNAMFLG,QSNA DISPLAY SNA USERS QNAMES + BO QRYSNA QNAMES +./ R 04310001 04320001 $ 4314991 4990 05/12/94 18:50:59 + BZ CHKDISC NO, SO THIS IS A NON-SNA USER QNAMES + TM VMDOSTAT,VMDDISC QNAMES + BO CHKDISC QNAMES +./ R 04350001 $ 4354991 4990 05/12/94 18:50:59 + BZ CHKCONN NO, SO THIS IS A NON-SNA USER QNAMES +./ R 04370001 04380001 $ 4375991 5990 05/12/94 18:50:59 + BNE CHKCONN NOPE - REGULAR Q NAMES QNAMES +DONXT C R10,VMDORIG-VMDBK(,R11) END IF UNDER SYS VMDBK QNAMES +./ R 04430001 04480001 $ 4437991 7990 05/12/94 18:50:59 +*QRYNISF1 DS 0H QNAMES +* CL R10,VMDORIG-VMDBK(,R11) BACK TO START? QNAMES +* BE QRYMSGL YES - GO STACK GSDBK AND GET SNA QNAMES +* PART OF THE RESPONSE QNAMES +* L R10,VMDCYCLE LOAD NEXT VMDBK ADDRESS QNAMES +* B QRYCONT CHECK IF THIS IS A NON-SNA USER QNAMES +./ I 04500001 $ 4500901 900 05/12/94 18:50:59 +CHKDISC TM QNAMFLG,QALL CHECK FOR 'ALL' OR 'DISC' QNAMES + BO QRYGETID QNAMES + TM QNAMFLG,QDISC QNAMES + BO QRYGETID QNAMES + B DONXT QNAMES +CHKCONN TM QNAMFLG,QALL CHECK FOR 'ALL' OR 'CONN' QNAMES + BO QRYGETID QNAMES + TM QNAMFLG,QCONN QNAMES + BO QRYGETID QNAMES + B DONXT QNAMES +./ R 04620001 $ 4620991 990 05/12/94 18:50:59 + CLC VMDUSER(4),=C'LOGN' IS IT A PRE-LOGON? QNAMES + BE QRYGTID3 YES, THEN GET NEXT USERID QNAMES + CLC VMDUSER(4),=C'LOGL' IS IT A PRE-LOGON? QNAMES + BE QRYGTID3 QNAMES + CLC VMDUSER(4),=C'LOGV' IS IT A PRE-LOGON? QNAMES + BE QRYGTID3 QNAMES + MVC 0(L'VMDUSER,R6),VMDUSER GET USERID QNAMES +./ R 04810001 04830001 $ 4816991 6990 05/13/94 13:11:59 +* BZ QYGTID2A LOCAL OR LOGICAL IS OK. QNAMES +* CL R10,VMDORIG-VMDBK(,R11) BACK TO START? QNAMES +* BE QRYMSGL YES - GO STACK GSDBK AND GET SNA QNAMES +./ R 04990001 05000001 $ 4995991 5990 05/12/94 18:50:59 + MVI L'VMDUSER(R6),C' ' SPACE OVER QNAMES + LA R6,9(R6) BUMP TO NEXT SEGMENT QNAMES +./ R 05210001 $ 5212991 2990 05/12/94 18:50:59 + TM QNAMFLG,QSNA DISPLAY SNA USERS? QNAMES + BNO QRYEXIT GET SNA PART OF THE RESPONSE QNAMES +./ I 05250001 $ 5252001 2000 05/12/94 18:50:59 + TM QNAMFLG,QSNA DISPLAY SNA USERS? QNAMES + BO QRYSNA GET SNA PART OF RESPONSE QNAMES + HCPRELST BLOCK=(R9) QNAMES + B QRYEXIT QNAMES +./ I 05260001 $ 5265001 5000 05/12/94 18:50:59 + HCPDROP R9 QNAMES +./ I 05370001 $ 5375001 5000 05/12/94 18:50:59 + HCPRELST BLOCK=(R9) QNAMES +./ I 05930001 $ 5935001 5000 05/12/94 18:50:59 + HCPUSING NRESP,R6 QNAMES +./ I 06340001 $ 6342001 2000 05/12/94 18:50:59 +CLCALL CLC 0(*-*,R1),=C'ALL ' QNAMES +CLCDISC CLC 0(*-*,R1),=C'DISCONN ' QNAMES +CLCCONN CLC 0(*-*,R1),=C'CONNECT ' QNAMES +CLCSNA CLC 0(*-*,R1),=C'SNA ' QNAMES +./ R 15680001 $ 15684991 4990 05/12/94 18:50:59 +QRYNCNT EQU 8 8 QUERY NAMES PER LINE QNAMES +./ I 16290001 $ 16290801 800 05/12/94 18:50:59 +************************************************************ QNAMES +* DSECT FOR DETERMINING TYPE OF Q NAMES OPERANDS * QNAMES +************************************************************ QNAMES + SPACE 2 QNAMES +QNAMOP DSECT QNAMES +QNAMFLG DS X OPERAND FLAG QNAMES +QALL EQU X'0F' PRINT ALL OF THE USERS QNAMES +QDISC EQU X'08' PRINT ONLY DISCONNECT USERS QNAMES +QCONN EQU X'04' PRINT ONLY CONNECT USERS QNAMES +QSNA EQU X'82' PRINT ONLY SNA USERS QNAMES + EJECT QNAMES \ No newline at end of file diff --git a/vmworkshop-vmarcs/1995/marist95/secure.info21 b/vmworkshop-vmarcs/1995/marist95/secure.info21 new file mode 100644 index 0000000..9b75968 --- /dev/null +++ b/vmworkshop-vmarcs/1995/marist95/secure.info21 @@ -0,0 +1,117 @@ +This mod implements a more 'secure' version of the QUERY NAMES command. +It allows you to hide certain virtual machines from view in the results +of the QUERY NAMES. It does this by defining a new OPTION in the directory, +SECURE. When the QUERY NAMES command is processed, it will not display the +names of virtual machines with the SECURE option, unless the invoker +has class A, C or E. + +This mod has two benefits. First, the less curious students see, the better. +This is obviously not a foolproof security system and is not meant to prevent +hackers from breaking into a guest machine. However, it also does not present +them with temptation. The addition of the SECURE option also implies other +future possibilities. For example, the 'QUERY vmname' command could be +modified to respect the option. + +A second, unexpected benefit was to 'clean up' the QUERY NAMES display. +Normal, class G users, such as our students, use the QUERY NAMES to see if +they friends are online. This is made difficult when the results include +dozens of service machines, guest systems, etc. By using the SECURE option, +the general users see only a list of other users or service machines to +which they have access, ie. LISTSERV, etc. We have had very positive +feedback on this from our users. + +This mod consists of two parts. First, it adds the SECURE parameter to +the OPTION record in the directory. Along with this, it utilizes one of +the installation flags in the VMDBLK to indicate that the SECURE option +is on. The second part of the mod, modifies the QUERY NAMES command to +skip those machines who have SECURE on. This part of the mod is dependent +on another Marist mod, QNAMES, which reformats the results of the +QUERY NAMES command. However, the code could be rewritten to work on +a vanilla version of HCPCQU. + +The mod in this file is written for a VM/ESA 2.1 system. The original version +of this mod was developed on VM/ESA ESA 1.0 service level 9202. Questions +or problems with it should be directed to the author, + +Martha McConaghy URMM@MARIST or URMM@VM.MARIST.EDU +Senior VM Systems Programmer +Marist College +Poughkeepsie, NY 12601 +(914) 575-3252 +6/05/94 + +************************************************************************** +Moduled changed: HCPCQU + HCPDIR + HCPLGN + +Copy blocks changed: HCPVMDBK + HCPDVMD + +************************************************************************** + +HCPDIR SECQNAM + +./ R 48566302 $ 48566400 50 02/14/92 11:14:45 +OPTLEN3C DS 0H LENGTH IS AT LEAST 3 SECQNAM + SPACE 1 SECQNAM + COMP =C'SECURE ',SCOPTCMP IS IT 'SECURE'? SECQNAM + BNE OPTLEN3D NO, CHECK NEXT OPTION SECQNAM + SPACE 1 SECQNAM + OI DVMDMARS,DVMDSEC TURN ON SECURE FLAG BIT SECQNAM + B OPTGET Go scan for the next option SECQNAM + SPACE 1 SECQNAM +OPTLEN3D DS 0H SECQNAM +******************************************************************** + +HCPCQU SECQNAM + +./ R 03760001 $ 3760100 100 09/25/90 17:10:15 +* DETERMINE IF THIS IS A PRIVILEDGED USER - CLASS A, C SECQNAM +* OR E CAN SEE ALL USERS, REGARDLESS OF VMDSECUR FLAG SECQNAM + TM VMDPCLB0,CLASSA IS THIS A CLASS A USER? SECQNAM + BO SETSECR YES, SET SECURITY FLAG SECQNAM + TM VMDPCLB0,CLASSC IS THIS A CLASS C USER? SECQNAM + BO SETSECR YES, SET SECURITY FLAG SECQNAM + TM VMDPCLB1,CLASSO IS THIS A CLASS O USER? SECQNAM + BO SETSECR YES, SET SECURITY FLAG SECQNAM + TM VMDPCLB0,CLASSE IS THIS A CLASS E USER? SECQNAM + BNO DOQRY NO, THEN GO ON WITH IT SECQNAM +SETSECR OI QNAMFLG,QSECUR SET SECURITY FLAG ON SECQNAM +DOQRY L R10,VMDORIG-VMDBK(,R11) FIRST VMDBK SECQNAM +./ R 04300001 $ 4300100 100 09/25/90 17:10:15 + TM VMDMARFL,VMDSECUR IS THIS A SECURE ACCOUNT? SECQNAM + BNO DOITNOW NOPE, THEN DISPLAY IT SECQNAM + TM QNAMFLG,QSECUR ARE WE PRIVILEDGED? SECQNAM + BNO DONXT THEN SKIP IT. SECQNAM +DOITNOW ICM R8,B'1111',VMDRTERM IS THERE AN RDEV? SECQNAM +./ R 16298001 $ 16298100 100 09/25/90 17:10:15 +QSNA EQU X'12' PRINT ONLY SNA USERS SECQNAM +QSECUR EQU X'80' QUERY SECURE USERS SECQNAM +HCPLGN SECQNAM + +./ R 07730001 $ 7730100 100 02/14/92 11:16:31 + BNO LGNSETSC BRANCH IF NOT SECQNAM +./ I 07740001 $ 7740100 100 02/14/92 11:16:31 +LGNSETSC DS 0H SECQNAM + TM DVMDMARS,DVMDSEC IS SECURE OPTION SPECIFIED?SECQNAM + BNO LGNSETOR Branch if not SECQNAM + OI VMDMARFL,VMDSECUR SET SECURE BIT IN VMDBK SECQNAM +******************************************************************* + +HCPDVMD SECQNAM + +./ R 01730001 $ 1731991 1990 05/13/94 10:41:29 +* DS 3X RESERVED FOR FUTURE IBM USE SECQNAM +DVMDMARS DS 1X USE FOR MARIST FLAGS SECQNAM +DVMDSEC EQU X'01' MARIST SECURE OPTION IS ON SECQNAM + DS 2X RESERVED FOR FUTURE IBM USE SECQNAM +******************************************************************* + +HCPVMDBK SECQNAM + +./ R 22340001 $ 22341991 1990 05/13/94 10:37:17 +*MDUSER3 DS F RESERVED FOR INSTALLATION USE SECQNAM +VMDMARFL DS X MARIST FLAGS SECQNAM +VMDSECUR EQU X'01' INDICATE SECURE USER SECQNAM +VMDUSER3 DS 3X PLACE HOLDER FOR REST OF SPACE SECQNAM \ No newline at end of file diff --git a/vmworkshop-vmarcs/1995/stumai95/README.md b/vmworkshop-vmarcs/1995/stumai95/README.md new file mode 100644 index 0000000..ccfbd28 --- /dev/null +++ b/vmworkshop-vmarcs/1995/stumai95/README.md @@ -0,0 +1,120 @@ +## ORIGINAL README + +``` +The STUMAIL archive contains the following files (grouped by functionality): + ++------------------+ +| CALVIEW Services | ++------------------+ + +The CALVIEW utility allows non-OfficeVision customers to query the calendars +of registered OfficeVision users, and view the result in an XEdit-based +panel format. + +Filename Filetype Brief Description +-------- -------- ------------------------------------------------------------- +CALVIEW EXEC *Used to allow customers to call CalView as a command +CALVIEW XEDIT *Displays a panel requesting calendar query parameters +CALVIEW HELPCMS Help file for CalView query panel +CALVIEWV XEDIT Displays the calendar returned from the STUDENTS server +CALVIEWV HELPCMS Help file for CalView query results (calendar display) panel +STUDENTS EXEC STUDENTS service machine code, accepts queries from CALVIEW + client and returns results to client + +* Requires DOPANEL EXEC and $$TEMP$$ $$FILE$$, also in the STUMAIL ARCHIVE. + ++--------------------------------------------+ +| Automated Student Account Request Services | ++--------------------------------------------+ + +ISARC (Individual Student Account Request Component) and its associated servers +form the automated student account request services. In addition to the +client interface (ISARC), two service machines exist in our environment. +The first service machine, VMSERV01, runs the SAMSERVE EXEC code below. Its +main two functions is to receive and respond to client requests, and at +designated times form the account creation job and pass the job on to the +second service machine, VMSERV02. VMSERV02 takes the account request job +and essentially creates the accounts, updates online messages, and places +the new account ids into a database. The code for VMSERV02 is not included +with this archive as the entire account creation process is largely site- +dependent. The original documentation for ISARC has been included with the +archive. + +Filename Filetype Brief Description +-------- -------- ------------------------------------------------------------- +ISARC LISTING Documentation for student account request component +ISARC EXEC *Used to initiate the account request client interface +ISARCMNU XEDIT Code to display menu of choices for account request +ISARCREQ XEDIT Code to obtain information for requesting account +ISARCQRY XEDIT Code to obtain information to query status of account request +ISARCRST XEDIT Code that interfaces with VMSERV01. Registers request for + account. +ISARCQST XEDIT Code that interfaces with VMSERV01. Obtains status of + account request. +ISARCINF XEDIT Code to display information about student accounts +ISARCINS XEDIT Code to display instructions on requesting a student account +ISARCHLP XEDIT Code to display help screens +INSTRUCT ISARCTXT Actual text explaining how to request an account +INFORM ISARCTXT Actual text explaining student accounts before requesting +$MAINT $DISABLE#Used to disable entire account request interface +$ABOUT $DISABLE#Used to disable only the "About Accounts" menu item +$QUERY $DISABLE#Used to disable only the "Query status of request" menu item +$REQUEST $DISABLE#Used to disable only the "Request account" menu item +ISARCREQ ISARCHLP Help text for account request panel +ISARCINF ISARCHLP Help text for about accounts panel +ISARCMNU ISARCHLP Help text for main menu +ISARCQRY ISARCHLP Help text for query status panel +MAKISARC EXEC File used to "make" account request component +SAMSERVE EXEC VMSERV01 service machine code +PUTDATA REXX VMSERV01 service machine additional code + +* Requires $$TEMP$$ $$FILE$$, also in the STUMAIL ARCHIVE. +# See documentation, ISARC LISTING, for instructions on use. + ++------------------------------+ +| Panels to Front-End Commands | ++------------------------------+ + +The following code together form several different panels that gather input +from customers and forms the appropriate command for them. These panels +were used to provide an intermediary between the menus and the commands to +invoke several different utilities and applications (such as MailBook, CMS +TELL, WHOIS, etc.). + +Filename Filetype Brief Description +-------- -------- ------------------------------------------------------------- +MMAILUSR EXEC *Used to allow customers to call MMAILUSR as a command +MMAILUSR XEDIT *Code to display panel and accept input for MailBook +MMAILUSR HELPCMS Help file for the MMAILUSR panel +WHOISIT EXEC *Used to allow customers to call WHOSIT as a command +WHOSIT XEDIT *Code to display panel and accept input for WHOIS +WHOSIT HELPCMS Help file for the WHOSIT panel +WHOSIT LOCATION Contains the locations to query for KECNET (Kentucky + Educational Computing NETwork). Can be modified as desired. +TELLPRMT EXEC *Used to allow customers to call TELLPRMT as a command +TELLPRMT XEDIT *Code to display panel and accept input for CMS TELL +TELLPRMT HELPCMS Help file for the TELLPRMT panel + +* Requires DOPANEL EXEC and $$TEMP$$ $$FILE$$, also in the STUMAIL ARCHIVE. + ++-------------------+ +| OTHER INFORMATION | ++-------------------+ + +The programs, data, and documentation included with this archive may be +freely distributed and modified in whatever manner the user sees fit. +The files in this archive have been provided courtesy of the University +of Louisville (Louisville, KY) and the programmers responsible for the +files' development. As such, the programmers would appreciate notification +of any changes, enhancements, or just general comments and suggestions +concerning the code and/or data. Such comments and suggestions are +very much welcome and could help us improve the code for our customers! +On behalf of all those who wrote the code for the University of +Louisville, please send any correspondence to either + + Paul Lewis PDLEWI01@ULKYVM.LOUISVILLE.EDU + + -or- + + Barbara Jones BAJONE02@ULKYVM.LOUISVILLE.EDU +``` diff --git a/vmworkshop-vmarcs/1995/stumai95/calview.exec b/vmworkshop-vmarcs/1995/stumai95/calview.exec new file mode 100644 index 0000000..c1faec2 --- /dev/null +++ b/vmworkshop-vmarcs/1995/stumai95/calview.exec @@ -0,0 +1,6 @@ +/* CALVIEW EXEC - Front end for viewing calendars. +Author: Paul Lewis, IT-DCS, 2/07/95 +Requires: DOPANEL EXEC, TELLPRMT XEDIT (by PDL, IT-DCS) +History: 02/07/95 In Test +*/ +'DOPANEL CALVIEW' diff --git a/vmworkshop-vmarcs/1995/stumai95/calview.helpcms b/vmworkshop-vmarcs/1995/stumai95/calview.helpcms new file mode 100644 index 0000000..0b3b5c9 --- /dev/null +++ b/vmworkshop-vmarcs/1995/stumai95/calview.helpcms @@ -0,0 +1,99 @@ +.cm ******************************************************************** +.cm ** ** +.cm ** Help for CALVIEW ** +.cm ** ** +.cm ** 04171995 baj Original author ** +.cm ** 05261995 baj In full production. ** +.cm ** ** +.cm ******************************************************************** +.cs 0 on + +CALVIEW VIEW CALENDARS + + +The CALVIEW routine provides view-only access to OfficeVision calendars +for those customers who don't have full OfficeVision access themselves. + +For example, a student wants to schedule an appointment with an +instructor who keeps her schedule online in OfficeVision calendars. +The student can use CALVIEW to check the availability of the instructor +and then contact the instructor about a specific meeting time. + +To use CALVIEW, enter the command CALVIEW at the main menu command line. + +Fill in the screen with the appropriate userid, starting date and +number of days to view and then press Enter. + +For more details, press PF1. +.cs 0 off +.cs 2 on + +Field Descriptions +------------------ + +Userid Specify any valid OfficeVision userid. + +Date Specify any valid date in mm/dd/yy format if a starting + date other than the current date is desired. + +Number of Specify the number of days of the calendar to view if + Days more than one is desired. + + +Key Descriptions +---------------- + +PF1/PF9 (Help) Brings you to this help screen. + +PF3/PF12 (Quit) Exits from CALVIEW. + +.cs 2 off +.cs 5 on + +Usage Notes +----------- + +1. Once you press Enter, a message is displayed indicating that the + request is processing. This screen will clear and the requested + calendar will display within moments. If you have been restricted + from viewing the requested calendar, an appropriate message will + return instead of the calendar. + +2. OfficeVision calendar owners have the ability to set + authorizations for their own calendars. The default standard + authorization allows anyone else to see all times and descriptions + for non-personal and non-confidential entries. If a particular + userid has been restricted to view times only, for example, then + CALVIEW will return only that much of their calendar. + +3. Calendar access for non-OfficeVision customers via CALVIEW is + controlled by the one special userid 'STUDENTS'. If an + OfficeVision customer wants to allow all students to see times only + and not their full calendar descriptions, for example, the STUDENTS + userid should be authorized with the 'times-only' selection. + Following are the steps to restrict calendar authorizations for + STUDENTS. From the OfficeVision main menu + + a. Press PF1 Process Calendars. + b. Press PF10 View calendar main menu 2. + c. Press PF1 Change user access to the calendar. + d. On screen W11, type "STUDENTS" and press Enter. + e. Press the PF keys to select/de-select the appropriate authorization. + For example, press "PF1 User may view times of entries only" to authorize + the viewer to see only the times on your calendar but not descriptions. + If all selections are turned off for this userid, then access is + completely denied for all students (and all other non-OV accounts). + To change an authorization back to the standard authorization + leave just PF2 SELECTED. Once reset to the default of PF2 only, + the userid will no longer display in your calendar authorization list. + f. Press PF12 until you return to the main menu. + +4. Under times of heavy load for the OfficeVision calendar services, + CALVIEW may display a message that it is retrying the request. + This should be considered normal on occasion. If the calendar + service facility cannot respond after several retries, a message + to this affect will be displayed. If you try the CALVIEW command + again after a few minutes and encounter the same error, please + report the problem to the Information Technology HelpDesk as the + message indicates. +.cs 5 off \ No newline at end of file diff --git a/vmworkshop-vmarcs/1995/stumai95/calview.xedit b/vmworkshop-vmarcs/1995/stumai95/calview.xedit new file mode 100644 index 0000000..98118cb --- /dev/null +++ b/vmworkshop-vmarcs/1995/stumai95/calview.xedit @@ -0,0 +1,503 @@ +/* */ +/* CALVIEW XEDIT */ +/* */ +/* Usage: This file is to be used by either invoking the DOPANEL */ +/* command and supplying the command with the name of this */ +/* panel or invoking a XEDIT session on a file with this */ +/* file specified as the PROFILE to be used. */ +/* */ +/* CALVIEW is a XEDIT file containing various XEDIT and REXX */ +/* instructions combined to construct an input panel and the */ +/* instructions necessary to process the input gathered from the */ +/* customer. See the USAGE statement above for information on how */ +/* to invoke the CALVIEW panel. */ +/* */ +/* Exit Code Definitions: */ +/* Not applicable. */ +/* */ +/* Mod Date Init Description */ +/* -------- ---- ------------------------------------------------- */ +/* 06291994 PDL Initial development. */ +/* 02011995 PDL Added message handler (adopted from other panels).*/ +/* 02011995 PDL Added code to un-RESERVE XEDIT lines. */ +/* 02021995 PDL Added trunc() functions to numeric information */ +/* passed to the CALVIEWV program. This was done */ +/* to discard zeros prefixing the responses. */ +/* 02021995 PDL Corrected cursor positioning after posting error */ +/* messages. */ +/* 02031995 PDL Added code to transmit and receive responses */ +/* from the calendar server. */ +/* 02031995 PDL Modified record submitted to STUDENTS calendar */ +/* service machine. The OFFICE APPOINTM GETCAL */ +/* command can not take a 4 digit year (e.g. 1995). */ +/* Now only transmit last two digits (e.g. 95). */ +/* 02081995 PDL Yanked out code maintaining restriction that year */ +/* be greater than or equal to 1994. */ +/* 02091995 PDL Reduced all displays of full years (e.g., 1995) */ +/* to displays of the last two digits of the year */ +/* (e.g., 95). This affects messages, the customer */ +/* input display, and input checking code. */ +/* 02141995 BAJ Changed title from VIEW FACULTY CALENDARS and */ +/* modified the instructions on the screen. */ +/* 05/31/95 BAJ Replaced 'BETA' with 'LEVEL' in the screen title. */ +/* */ + +level="108" + +trace off + +/* Define the control characters for panel definition */ +address xedit +"SET CTLCHAR % ESCAPE" +"SET CTLCHAR @ PROTECT HIGH" +"SET CTLCHAR ! PROTECT NOHIGH" +"SET CTLCHAR $ NOPROTECT HIGH" + +/* Set up the XEDIT environment for panel definition */ +"SET CASE MIXED" +"SET LINEND OFF" +"SET TOFEOF OFF" +"SET PREFIX OFF" +"SET SCALE OFF" +"SET MSGLINE ON 21 2" +"SET CMDLINE OFF" +"SET MSGMODE ON" +"VERIFY OFF 1 80" + +/* Ensure the PF keys are defined as we need them so */ +/* that we can avoid the problem with a key defined */ +/* as TABKEY, COPYKEY, NULLKEY, or CP BRKKEY (which */ +/* will cause a XEDIT READ to -NOT- terminate). We */ +/* cannot have this. */ +do index=1 to 24 + "SET PF"index "BEFORE EMSG INTERNAL FAILURE: EXIT", + "IMMEDIATELY AND REPORT THIS TO THE HELPDESK (7997)" +end + +/* Make sure that we set the appropriate PF */ +/* keys with a QQUIT definition. This is to*/ +/* make sure the customer can get out even */ +/* though an internal failure has occurred. */ +"SET PF3 BEFORE QQUIT" +"SET PF12 BEFORE QQUIT" +"SET PF15 BEFORE QQUIT" +"SET PF24 BEFORE QQUIT" + +/* "un-RESERVE" all of the XEDIT lines */ +/* that were reserved, if any. */ +"EXTRACT /RESERVED */" +do index=1 to RESERVED.0 + parse var RESERVED.index linenum otherstuff + "SET RESERVED" linenum "OFF" +end + +address command + +/* Request that the panel be constructed, and place the cursor */ +/* at the first input field. */ +call BuildDisplay +address xedit "CURSOR SCREEN 8 40" + +/* Initialize all input variables */ +currdate=date("STANDARD") +month=substr(currdate,5,2) +day=right(currdate,2) +year=substr(currdate,3,2) +userid="" +consdays="01" + +/* Begin processing of the panel. The "status" variable indicates */ +/* what mode we are in. */ +/* Status=0 indicates that the customer has submitted the */ +/* panel for processing. Syntax/Field checking */ +/* is performed as required, and if no problem is */ +/* found then the external command is */ +/* constructed and executed. */ +/* Status=1 indicates that reading of the panel is to */ +/* continue until otherwise indicated. */ +/* Status=2 indicates that an exit from the panel has been */ +/* requested. */ +/* Status=3 indicates that help has been requested. */ +status=1 +do while (status = 1) + + /* Request that the panel be rebuilt to reflect customer entries */ + call BuildDisplay + /* Request that XEDIT read the panel and return the results */ + address xedit "READ NOCHANGE NUMBER TAG" + + /* Process the results of the XEDIT READ until no more are left */ + do queued() + parse pull tag line column data + + /* If the result was from an input field, then process it */ + if tag = "RES" then do + /* Remove all blanks and underscore characters */ + /* from the input */ + data=strip(data,trailing,"_") + data=strip(data) + upper data + select + /* Line 8 is the person we are checking on */ + when line = 8 + then userid=data + /* Line 10, Column 40 is the month field */ + when (line = 10) & (column = 40) + then month=right(data,2,"0") + /* Line 10, Column 45 is the day field */ + when (line = 10) & (column = 45) + then day=right(data,2,"0") + /* Line 10, Column 50 is the year field */ + when (line = 10) & (column = 50) + then year=right(data,2,"0") + /* Line 12 is the number of consecutive days field */ + when line = 12 + then consdays=right(data,2,"0") + otherwise nop + end + + end + + /* If the customer pressed a PF key, process it */ + if tag = "PFK" then do + + select + /* If the customer pressed PF1, PF13, PF9, or */ + /* PF21 then help is requested on the panel. */ + when (line = 1) | (line = 13) |, + (line = 9) | (line = 21) then status=3 + /* If the customer pressed PF3, PF15, PF12, or PF24 */ + /* then the customer wishes to exit. */ + when (line = 3) | (line = 15) |, + (line = 12) | (line = 24) then do + "DESBUF" + status=2 + leave + end + /* Otherwise, the PF key is not defined to us. */ + otherwise + message="PFKey is not defined." + call display_message + end + + end + + /* If the customer pressed the ENTER key, then set the */ + /* status flag to "check/process input panel". */ + if tag = "ETK" then status=0 + + end + + /* The customer requested assistance for the panel */ + /* or XEDIT options. */ + if status = 3 then do + address command "HELP CALVIEW" + /* Now, resume panel input/processing */ + status=1 + end + + /* Was panel checking/processing requested? */ + if status = 0 then do + + /* Check to see if we have any "error" conditions... */ + select + /* Scenario 1: The customer has not supplied a userid */ + when (userid = "") then do + status=1 + message="A userid must be supplied to view a calendar." + call display_message + address xedit "CURSOR SCREEN 8 40" + end + /* Scenario 2: The customer has supplied an invalid month */ + when (month ^= "") & (((month < 1) |, + (month > 12)) |, + (datatype(month,"NUMBER") ^= 1)) then do + status=1 + message="The month must be a value between", + "1 and 12 inclusive." + call display_message + address xedit "CURSOR SCREEN 10 40" + end + /* Scenario 3: The customer has supplied an invalid day */ + when (day ^= "") & (((day < 1) |, + (day > 31)) |, + (datatype(day,"NUMBER") ^= 1)) then do + status=1 + message="The day must be a value between", + "1 and 31 inclusive." + call display_message + address xedit "CURSOR SCREEN 10 45" + end + /* Scenario 4: The customer has supplied an invalid year */ + when ((year ^= "") &, + (datatype(year,"NUMBER") ^= 1)) then do + status=1 + message="The year must be a numeric value." + call display_message + address xedit "CURSOR SCREEN 10 50" + end + /* Scenario 5: The customer has supplied an invalid */ + /* number of consecutive days */ + when (consdays ^= "") & (((consdays < 1) |, + (consdays > 99)) |, + (datatype(consdays,"NUMBER") ^= 1)) then do + status=1 + message="The number of consecutive days", + "must be a value between 1 and 99 inclusive." + call display_message + address xedit "CURSOR SCREEN 12 40" + end + otherwise nop + end + + end + + /* If status is still zero then we have passed the panel checks. */ + /* Now let us construct and perform the command for the customer.*/ + if status = 0 then do + /* Remove the PF key display to indicate the PF key functions */ + /* are no longer available. */ + address xedit "CURSOR SCREEN 22 80" + address xedit "SET RESERVED -1 N" + address xedit "SET RESERVED 8 N" + address xedit "SET RESERVED 10 N" + address xedit "SET RESERVED 12 N" + address xedit "SET RESERVED 4 OFF" + address xedit "SET RESERVED 5 OFF" + address xedit "SET MSGLINE ON 4 4" + address xedit "REFRESH" + obt_cal_status=ObtainCalendar() + select + when (obt_cal_status = "NOPROBLEM") then do + queue userid + queue trunc(month) + queue trunc(day) + queue trunc(year) + queue trunc(consdays) + address cms "XEDIT $$CAL$$" userid "A (PROFILE CALVIEWV)" + status=2 + end + when (obt_cal_status = "SERVERNOTAVAILABLE") then do + message="The calendar server is currently not available.", + "Please report this message to the HelpDesk at", + "502/852-7997." + call display_message + address xedit "SET RESERVED -1 N %@PF3/PF12%! Quit" + do index=1 to 24 + address xedit "SET PF"index "BEFORE EMSG Press PF3/PF12 to", + "quit. The calendar server is not available.", + "For further assistance, please contact", + "the HelpDesk at 502/852-7997." + end + address xedit "SET PF3 BEFORE QQUIT" + address xedit "SET PF12 BEFORE QQUIT" + address xedit "SET PF15 BEFORE QQUIT" + address xedit "SET PF24 BEFORE QQUIT" + end + when (obt_cal_status = "PROBLEM") then do + message="Unable to read in the calendar on filemode A. Press", + "PF3/PF12 to quit." + call display_message + address xedit "SET RESERVED -1 N %@PF3/PF12%! Quit" + do index=1 to 24 + address xedit "SET PF"index "BEFORE EMSG Press PF3/PF12 to", + "quit. Correct the problem and try again.", + "For further assistance, please contact the", + "HelpDesk at 502/852-7997." + end + address xedit "SET PF3 BEFORE QQUIT" + address xedit "SET PF12 BEFORE QQUIT" + address xedit "SET PF15 BEFORE QQUIT" + address xedit "SET PF24 BEFORE QQUIT" + end + when (obt_cal_status = "NOTACCEPTING") then do + message="The calendar server is currently not accepting", + "requests. Please report this message to the", + "HelpDesk at 502/852-7997." + call display_message + address xedit "SET RESERVED -1 N %@PF3/PF12%! Quit" + do index=1 to 24 + address xedit "SET PF"index "BEFORE EMSG Press PF3/PF12 to", + "quit. The calendar server is not accepting", + "requests. For further assistance, please", + "contact the HelpDesk at 502/852-7997." + end + address xedit "SET PF3 BEFORE QQUIT" + address xedit "SET PF12 BEFORE QQUIT" + address xedit "SET PF15 BEFORE QQUIT" + address xedit "SET PF24 BEFORE QQUIT" + end + when (obt_cal_status = "NOTRESPONDED") then do + message="The calendar server has not responded after several", + "attempts. Please report this message to the", + "HelpDesk at 502/852-7997." + call display_message + address xedit "SET RESERVED -1 N %@PF3/PF12%! Quit" + do index=1 to 24 + address xedit "SET PF"index "BEFORE EMSG Press PF3/PF12 to", + "quit. The calendar server did not respond", + "within the allotted time. For", + "further assistance, please contact the", + "HelpDesk at 502/852-7997." + end + address xedit "SET PF3 BEFORE QQUIT" + address xedit "SET PF12 BEFORE QQUIT" + address xedit "SET PF15 BEFORE QQUIT" + address xedit "SET PF24 BEFORE QQUIT" + end + otherwise nop + end + end +end + +if (status = 2) then address xedit "QQUIT" +exit + +ObtainCalendar: + +ObtCalStatus="PROBLEM" + +address command + +bypass_transmission=0 + +address xedit "refresh" + +/* Check to make sure that the calendar service machine is up...*/ +"PIPE CP QUERY USER STUDENTS | HOLE" +if RC ^= 0 then do + bypass_transmission=1 + ObtCalStatus="SERVERNOTAVAILABLE" +end + +if bypass_transmission <> 1 then do + + record_to_submit=userid, + month||"/"||day||"/"||year, + consdays + + message="Sending request to calendar server... Please wait..." + call display_message + + number_of_attempts=1 + + "PIPE CP SPOOL RDR CLASS Z | HOLE" + + do loop=1 + + address xedit "REFRESH" + "PIPE CP SMSG STUDENTS" record_to_submit "| HOLE" + if RC ^= 0 then do + ObtCalStatus="NOTACCEPTING" + leave loop + end + "PIPE CP SET IMSG OFF | HOLE" + "WAKEUP +00:00:15 ( QUIET RDR" + + select + when RC=2 then do + "PIPE CP SET IMSG ON | HOLE" + number_of_attempts=number_of_attempts+1 + if number_of_attempts <> 7 then do + message="The server is responding slowly at this time. Your", + "request is being re-submitted (attempt", + number_of_attempts" of 6). Please wait..." + call display_message + end + else do + ObtCalStatus="NOTRESPONDED" + leave loop + end + end + when RC=4 then do + "PIPE CP SET IMSG ON | HOLE" + 'PIPE CP QUERY RDR * CLASS Z AVAIL |', + ' DROP FIRST |', + ' STEM classz_files. |', + ' HOLE' + if (classz_files.0 ^= 1) then try_again=1 + else do + parse upper var classz_files.1 origin_id cal_spool_id . + if (origin_id ^= "STUDENTS") then try_again=1 + else do + "PIPE CMS RECEIVE" cal_spool_id "= = A ( NOLOG REPLACE ) |", + " HOLE" + if (RC ^= 0) then do + "PIPE CP PURGE * RDR" cal_spool_id "| HOLE" + try_again=0 + end + else do + ObtCalStatus="NOPROBLEM" + try_again=0 + end + end + end + if try_again ^= 1 then leave loop + end + otherwise nop + end + end +end + +"PIPE CP SPOOL RDR CLASS * | HOLE" + +return ObtCalStatus + +/* Construct the input panel for the customer... */ +BuildDisplay: +address xedit +"SET RESERVED 1 N %!CALVIEW %@VIEW", + "CALENDARS%! LEVEL"level +"SET RESERVED 4 N %@To view someone's calendar, supply their userid. ", + "You may also change the date%!" +"SET RESERVED 5 N %@and the number of consecutive days to view.", + "Then press Enter.%!" +"SET RESERVED 8 N %! ", + "UserID %$"left(userid,8,"_")"%!" +"SET RESERVED 10 N %! ", + "Date ", + "%$"left(month,2,"_")"%!/%$"left(day,2,"_")"%!/%$"left(year,2,"_")"%!" +"SET RESERVED 12 N %! ", + "Number of Days", + "%$"left(consdays,2,"_")"%!" +"SET RESERVED -1 N %@PF1/PF9%! Help %@PF3/PF12%! Quit" +address command +return + +display_message: + +if message ^= "" then do + /* Now format the message for proper display */ + nextword="" + msglines.0=1 + msgindex=msglines.0 + do index=1 to 2 + msglines.index="" + end + do index=1 to words(message) + msgindex=msglines.0 + nextword=word(message,index) + /* If we can fit the next word into the line, then do so */ + if (length(msglines.msgindex)+length(nextword)) <= 78 then + if length(msglines.msgindex) = 0 then + msglines.msgindex=nextword + else + msglines.msgindex=msglines.msgindex||" "||nextword + /* Otherwise, pad the rest of the current line, */ + /* and start a new line. */ + else do + msglines.msgindex=left(msglines.msgindex,79) + msglines.0=msglines.0+1 + msgindex=msglines.0 + msglines.msgindex=nextword + end + end + msgtodisplay="" + do index=1 to msglines.0 + msgtodisplay=msgtodisplay||msglines.index + end + address xedit "EMSG" msgtodisplay + message="" +end + +return diff --git a/vmworkshop-vmarcs/1995/stumai95/calviewv.helpcms b/vmworkshop-vmarcs/1995/stumai95/calviewv.helpcms new file mode 100644 index 0000000..2e5ae61 --- /dev/null +++ b/vmworkshop-vmarcs/1995/stumai95/calviewv.helpcms @@ -0,0 +1,104 @@ +.cm ******************************************************************** +.cm ** ** +.CM ** HELP FOR CALVIEWV, THE RESPONSE SCREEN FOR CALVIEW. ** +.cm ** ** +.cm ** 04171995 BAJ Original Author ** +.cm ** 04241995 BAJ Included help when disk full situation happens. ** +.cm ** 05261995 BAJ Put into full production. ** +.cm ** ** +.cm ******************************************************************** +.cs 0 on + +CALVIEWV VIEW CALENDARS + +The CALVIEW routine provides view-only access to OfficeVision calendars for +those customers who don't have full OfficeVision access themselves. + +From this screen, you can view or print the requested calendar or the messages +that resulted if the calendar could not be retrieved. + + + +Press PF1 for more details. +.cs 0 off +.cs 2 on + +Key Descriptions +---------------- + +PF1/PF9 (Help) Brings you to this help screen. + +PF2 (Print Displays the CHOOSE A PRINTER selection + Calendar) screen where you can select the printer on + which to print the calendar (or message). + +PF3/PF12 (Quit) Exits from CALVIEW. + +PF7 (Scroll Scrolls backward (towards the top) of the file + Backward) being viewed. + +PF8 (Scroll Scrolls forward (towards the end) of the file + Forward) being viewed. +.cs 2 off +.cs 5 on + +Usage Notes +----------- + +1. Use PF7/PF8 to scroll through the calendar display or + PF2 to print the calendar file. + +2. If you get a message instead of a calendar, here are the most + likely messages and a little more about what they mean: + + message: USERID is not a known OfficeVision userid. + No calendar is available. + + means: The userid requested on the previous screen is not + defined as an OfficeVision customer. Only OfficeVision(OV) + accounts can have calendars. It may be a valid userid + on the university's IBM, but it is not an OV account. + + + message: USERID has not authorized you to view the calendar. + + means: The owner of the calendar you requested to view + has restricted your access through OfficeVision + calendar authorizations. + + + message: USERID has restricted your view of the calendar through + this service. + + means: This userid has set up their OfficeVision calendar so + the special userid "STUDENTS" does not have access. + + + message: Calendar cannot be retrieved at this time. + + means: More than likely, the calendar system is over burdened at + the time of the request. Try CALVIEW again in a few + minutes and if the problem persists, notify the HelpDesk. + + + message: DMSWRC671E Error receiving file ... + Unable to read in the calendar.... Press PF3/PF12 to quit. + + means: You did not have enough room on your A(191) disk for the + temporary file used by CALVIEW to display the retrieved + calendar. Erase some disk space or retrieve fewer days. + + + message: You may not view calendars prior to April 24, 1995, using CALVIEW. + + means: CALVIEW cannot be used to look at calendars that existed + before the CALVIEW routine became available. + +3. OfficeVision calendar owners have the ability to set authorizations + for their own calendars. The default standard authorization allows + anyone else to see all times and descriptions of non-personal and + non-confidential entries unless an authorization for a particular + userid overrides the default. If a particular userid has been + restricted to view times only, for example, then CALVIEW will + return only that much of their calendar. +.cs 5 off diff --git a/vmworkshop-vmarcs/1995/stumai95/calviewv.xedit b/vmworkshop-vmarcs/1995/stumai95/calviewv.xedit new file mode 100644 index 0000000..627ccf1 --- /dev/null +++ b/vmworkshop-vmarcs/1995/stumai95/calviewv.xedit @@ -0,0 +1,138 @@ +/* */ +/* CALVIEWV XEDIT */ +/* */ +/* Usage: This file is to be used only through a call provided by */ +/* the CALVIEW XEDIT input panel. This environment was */ +/* only intended to provide a viewing environment for the */ +/* results returned to CALVIEW from the calendar request */ +/* service machine. */ +/* */ +/* CALVIEWV is a XEDIT file containing various XEDIT and REXX */ +/* instructions combined to construct a viewing environment for the */ +/* results returned from the calendar request service machine. */ +/* Execution of this file was meant to occur only from the CALVIEW */ +/* routine. Other uses are not supported. */ +/* */ +/* Exit Code Definitions: */ +/* Not applicable. */ +/* */ +/* Mod Date Init Description */ +/* -------- ---- ------------------------------------------------- */ +/* 06291994 PDL Initial development. */ +/* 02021995 PDL Enabled Top-of-file/End-of-file screen display. */ +/* 02031995 PDL Changed name of referenced calendar to print as */ +/* "$$CAL$$ userid A". */ +/* 0531995 BAJ Replaced 'BETA' with 'LEVEL' in the screen title. */ +/* */ + +level="102" + +trace off + +/* Check to make sure we called by CALVIEW XEDIT, not DOPANEL EXEC */ +parse upper arg fn ft . + +if (strip(fn) = "$$TEMP$$") & (strip(ft) = "$$FILE$$") then do + say "This XEDIT macro (CALVIEWV XEDIT) must be called from" + say "CALVIEW XEDIT. Any other invocations would produce" + say "unwanted results. The proper method to invoke this" + say "series of XEDIT macros is to issue the command:" + say "" + say " DOPANEL CALVIEW" + address xedit "QQUIT" + exit +end + +/* Retrieve CALVIEW information from program stack */ +parse upper pull userid +parse upper pull month +parse upper pull day +parse upper pull year +parse upper pull consdays + +/* Define the control characters for panel definition */ +address xedit + +/* Define XEDIT escape/field set characters */ +"SET CTLCHAR % ESCAPE" +"SET CTLCHAR @ PROTECT HIGH" +"SET CTLCHAR ! PROTECT NOHIGH" +"SET CTLCHAR $ NOPROTECT HIGH" + +/* Set up the XEDIT environment for panel definition */ +"SET CASE MIXED" +"SET LINEND OFF" +"SET TOFEOF ON" /* ENABLED PER 02021995 MODIFICATION */ +"SET PREFIX OFF" +"SET SCALE OFF" +"SET MSGLINE ON -4 1" +"SET CMDLINE OFF" +"SET MSGMODE ON" +"SET CURLINE ON 5" +"VERIFY OFF 1 80" + +/* Release all reserved lines for the use of this routine */ +"EXTRACT /RESERVED */" +do index=1 to RESERVED.0 + parse var RESERVED.index linenum otherstuff + "SET RESERVED" linenum "OFF" +end + +/* Go ahead and do a blanket define for all of the PF keys. */ +/* If we have any exceptions (different definitions), then */ +/* we can override them later. */ + +do index=1 to 24 + "SET PF"index "BEFORE EMSG Undefined PF Key" +end + +/* Define the PF Keys as we need them */ +"SET LINEND OFF" +"SET PF1 BEFORE CMS HELP CALVIEWV" +"SET PF2 BEFORE CMS CMSPRINT $$CAL$$" userid "A" +"SET PF3 BEFORE CMS ERASE $$CAL$$" userid "A#QQUIT" +"SET PF7 BEFORE BACKWARD" +"SET PF8 BEFORE FORWARD" +"SET PF9 BEFORE CMS HELP CALVIEWV" +"SET PF12 BEFORE CMS ERASE $$CAL$$" userid "A#QQUIT" +"SET PF13 BEFORE HELP CALVIEWV" +"SET PF14 BEFORE CMS CMSPRINT $$CAL$$" userid "A" +"SET PF15 BEFORE CMS ERASE $$CAL$$" userid "A#QQUIT" +"SET PF19 BEFORE BACKWARD" +"SET PF20 BEFORE FORWARD" +"SET PF21 BEFORE CMS HELP CALVIEWV" +"SET PF24 BEFORE CMS ERASE $$CAL$$" userid "A#QQUIT" +"SET LINEND ON #" + +/* Set up CURLINE and FILEAREA area colors to default */ +"SET COLOR FILEAREA DEFAULT NONE NOHIGH" +"SET COLOR CURLINE DEFAULT NONE NOHIGH" + +/* Set up the viewing screen... */ +"SET RESERVED 1 N %! ", + " LEVEL"level +if (consdays = 1) then + "SET RESERVED 2 N %@Calendar for" userid",", + month"/"day"/"year "for" consdays, + "consecutive day%!" +else + "SET RESERVED 2 N %@Calendar for" userid",", + month"/"day"/"year "for" consdays, + "consecutive days%!" +"SET RESERVED 3 N %@------------------------------------- *", + "--------------------------------------- " +"SET RESERVED 4 N" +"SET RESERVED -4 N" +"SET RESERVED -3 N %@------------------------------------- *", + "--------------------------------------- " +"SET RESERVED -2 N %@PF1/PF9%! Help ", + " %@PF2%! Print Calendar ", + " %@PF3/PF12%! Quit" +"SET RESERVED -1 N %@PF7%! Scroll Backward", + " %@PF8%! Scroll Forward" + +"CURSOR SCREEN 1 80" + +address command + +exit diff --git a/vmworkshop-vmarcs/1995/stumai95/dopanel.exec b/vmworkshop-vmarcs/1995/stumai95/dopanel.exec new file mode 100644 index 0000000..223e909 --- /dev/null +++ b/vmworkshop-vmarcs/1995/stumai95/dopanel.exec @@ -0,0 +1,74 @@ +/* */ +/* DOPANEL EXEC */ +/* */ +/* Usage: DOPANEL panelname */ +/* */ +/* DOPANEL is the frontend for selected panels designed to execute */ +/* in the student account environment. Although this frontend was */ +/* intended only for student account usage, this frontend may be */ +/* used in other capacities if so desired. */ +/* */ +/* Exit Code Definitions: */ +/* Not applicable. */ +/* */ +/* Mod Date Init Description */ +/* -------- ---- ------------------------------------------------- */ +/* 06271994 PDL Initial development. */ +/* 07141994 PDL Changed named of temporary file for XEDIT entry */ +/* from $$DUMMY$$ $$FILE$$ to $$TEMP$$ $$FILE$$. */ +/* */ + +/* Get which panel to activate */ +parse upper arg panel . + +overallrc=0 + +/* If no panel name was supplied, say so and set overallrc to exit out */ +if panel = "" then do + say "A panel name must be supplied." + overallrc=1 +end + +/* If we haven't encountered an error yet, then let us check to make */ +/* sure that the XEDIT file for the panel exists. If the panel */ +/* processing file does not exist, then set the overallrc to exist out */ +if (overallrc = 0) then + "PIPE CMS STATE" panel "XEDIT * | HOLE" +if (RC = 28) & (overallrc = 0) then do + overallrc=1 + say "Unable to invoke requested input panel ("panel")." + say "" + say "Please contact the HelpDesk (7997) for further assistance." + say "You may be asked to explain to HelpDesk personnel what action" + say "you were trying to perform." + say "" + say "CAUSE OF FAILURE: The file named" panel "XEDIT could not be" + say " located on any accessed disks or direc-" + say " tories. This file contains the instructions" + say " to perform all input panel processing." +end + +/* If we haven't encountered an error yet, then let us check to see if */ +/* the HELPCMS help file exists for the desired panel. If it does */ +/* then continue, otherwise issue a warning to the customer and */ +/* continue processing. */ +if (overallrc = 0) then + "PIPE CMS STATE" panel "HELPCMS * | HOLE" +if (RC = 28) & (overallrc = 0) then do + say "Warning! Help for the input panel you are accessing will not" + say " be available. Please contact the HelpDesk (7997)" + say " and report this message and what action you are" + say " trying to perform to support personnel. Your help" + say " will assist support personnel in solving the problem" + say " and will benefit other customers. Thank you." + say "" + say "Please press ENTER to continue..." + pull nothing +end + +/* If the overallrc was not set to exit, then let us enter the XEDIT */ +/* environment and perform the input processing for the desired panel. */ +if (overallrc = 0) then + push "XEDIT $$TEMP$$ $$FILE$$ * (PROFILE" panel")" + +exit diff --git a/vmworkshop-vmarcs/1995/stumai95/inform.isarctxt b/vmworkshop-vmarcs/1995/stumai95/inform.isarctxt new file mode 100644 index 0000000..1602768 --- /dev/null +++ b/vmworkshop-vmarcs/1995/stumai95/inform.isarctxt @@ -0,0 +1,48 @@ + About Individual Student Accounts + ================================= + + Individual student accounts are available to all registered University + of Louisville students for the first time this Fall 1994. + + Your student account will be a menu driven CMS account on the IBM + computer system. It will utilize Mailbook for electronic (e-mail) + communications. + + Your computer account userid will consist of the first character of your + first name, your middle initial (0 will be used if there is no middle + initial), and the first four characters of your last name followed by a + "Z" and a digit. For example: JQPUBLZ1. + + The initial account password will be set to your TouchTone Registration + PIN. If you have not used the TouchTone Registration system before, + your initial PIN will be your six digit date of birth. The first time + you log onto your new account, you will be prompted to select and enter + a new eight character password. + + After you have changed your password, the Online Computer Account + Usage Agreement will be presented. The agreement specifies the + conditions of use for the University of Louisville's computing + resources. You will be prompted to indicate your agreement or + disagreement with the usage conditions. If you agree, you can + continue into your account. If you do not agree to use the + University's computing resources ethically and responsibly, you + will be logged off the system and your account will be closed. + + You can view the specific policy statements that govern your + student account and suggested guidelines for account use under + the "Individual Student Account Information" section within + the "Student Information" selection of ULinfo. The guidelines for + account use is also included in the Student Handbook. + + Once at the Main Menu, open your mail (PF2) to read the welcome note + waiting for you containing helpful tips regarding the use of your + student account. You will also want to take time to browse (PF1) + "General Info on Student Accounts" that will give you more detailed + information on managing and using your computer account. + + To request an account, select "Request an Individual Student Account" + on the Individual Student Account Main Menu. Enter the requested + information. If your registration is confirmed, your account will + be available and ready for use after 8 am the next calendar day. + + -------------------------END OF FILE------------------------------------ \ No newline at end of file diff --git a/vmworkshop-vmarcs/1995/stumai95/instruct.isarctxt b/vmworkshop-vmarcs/1995/stumai95/instruct.isarctxt new file mode 100644 index 0000000..1d150c2 --- /dev/null +++ b/vmworkshop-vmarcs/1995/stumai95/instruct.isarctxt @@ -0,0 +1,44 @@ + Preliminary Information for Requesting an Individual Student Account + ==================================================================== + + ********************************************************************* + **** You must be a registered UofL student to request an account **** + ********************************************************************* + + The request screen will ask you to enter three pieces of information: + + Name: + **** Enter your full name in upper and lower case. If you do not + have a middle initial, enter 0 (zero). Or if you leave the + middle initial field blank, 0 (zero) will be used. + + Social Security Number: + **** Enter your nine digit social security number. If you do not + have a social security number, enter the nine digit student + number that was assigned to you. + + Once you have requested your account, do not change your Touchtone + Registration PIN until after you have successfully logged onto + your account the first time. + + ********************************************************************* + + After you have submitted your request, the next screen will tell + you the userid of your account. It will be created from your + name, a "Z" and a digit. Please write it down. + + Your initial account password will be your TouchTone PIN number. + This is why we advise you not to change your PIN until after + you have logged onto your account the first time to avoid + confusion. The first time you log onto your account, you will + be prompted to select and enter a new eight character password. + + If registration is confirmed, your account will be created and + available for use by 8 am the following day. + + If you are unable to log onto your account the next day, you may + want to select "Check the Status of an Account Request" on the + Individual Student Account Main Menu. It will give you the most + current status message concerning the creation of your account. + + -------------------------END OF FILE----------------------------------- \ No newline at end of file diff --git a/vmworkshop-vmarcs/1995/stumai95/isarc.exec b/vmworkshop-vmarcs/1995/stumai95/isarc.exec new file mode 100644 index 0000000..9563b81 --- /dev/null +++ b/vmworkshop-vmarcs/1995/stumai95/isarc.exec @@ -0,0 +1,469 @@ +/*********************************************************************/ +/* */ +/* ISARC EXEC */ +/* */ +/* Usage: ISARC */ +/* */ +/* ISARC is the EXEC name issued when a customer wishes to start */ +/* up the individual account request mechanism. From this EXEC, the */ +/* various XEDIT input panels are called to gather the appropriate */ +/* information from the customer as needed. */ +/* */ +/* Exit Code Definitions: */ +/* No exit codes are used in this EXEC. */ +/* */ +/* Required Files: */ +/* ISARCREQ XEDIT (Profile containing the account request panel)*/ +/* ISARCQRY XEDIT (Profile containing the account query panel) */ +/* ISARCINF XEDIT (Profile containing the account info display) */ +/* ISARCMNU XEDIT (Profile containing the top level menu) */ +/* INFORM ISARCTXT (Plain text file containing the account info) */ +/* $$TEMP$$ $$FILE$$ (Temporary file used to gain entry to XEDIT) */ +/* ISARCRST XEDIT (Profile containing service wait screen) */ +/* ISARCQST XEDIT (Profile containing query results display) */ +/* */ +/* Mod Date Init Description */ +/* -------- ---- ------------------------------------------------- */ +/* 07181994 PDL Initial Development */ +/* 07261994 PDL Added code to preserve the cursor placement in the*/ +/* menu area by interacting with INDACCTM XEDIT via */ +/* the program stack. */ +/* 07281994 PDL Revised userid generation code to take care of */ +/* special cases (names with an apostrophe or hyphen)*/ +/* 07291994 PDL Program/modules names changed. */ +/* 08011994 PDL Various message text changes. */ +/* 08021994 PDL Added code to allow an ISARC maintenance mode. */ +/* 08031994 PDL Added code to recognize the MAINT exit code from */ +/* ISARCMNU when a maintenance request is issued. */ +/* 08121994 PDL Modified code to look for disabler files on 319-P */ +/* instead of VMSERV02 491. This will allow "Z" */ +/* accounts to also see the disabler files and */ +/* perform the appropriate actions as needed. */ +/* 09011994 PDL Changed initial "lastcol" value from 20 to 22 */ +/* to support changes made in ISARCMNU. */ +/* 09061994 PDL Modified code to look for disabler files and */ +/* auxiliary files in the */ +/* VMSYS:VMSERV01.ISARC.PUBLIC_ACCESS SFS directory. */ +/* "Z" accounts will still be able to see the */ +/* needed files. */ +/* */ +/*********************************************************************/ + +trace off + +/* Make sure that nothing unexpected is coming our way. */ +"DESBUF" + +/* 09061994 ADDITION: Added master_loc variable which points to*/ +/* the SFS directory containing ISARC code, */ +/* auxiliary files, and disabler files. */ +master_loc="VMSYS:VMSERV01.ISARC.PUBLIC_ACCESS" + +/* Check to see if $MAINT $DISABLE is present on VMSERV02 491. */ +/* If so, a maintenance mode has been declared. Shut the */ +/* front-end system down. */ +/* 08121994 MODIFICATION: Now looking on 319-P for file. */ +/* 09061994 MODIFICATION: Now looking in */ +/* VMSYS:VMSERV01.ISARC.PUBLIC_ACCESS */ +/* for $MAINT $DISABLE. */ +/* address command "GETFMADR" */ +/* parse upper pull . freemode . check */ +/* if check ^= "" then do */ +/* say "ERROR ISA005: Unable to allocate a free filemode." */ +/* say "" */ +/* say "Please notify the HelpDesk at 502/852-7997 and report the" */ +/* say "following message to them:" */ +/* say "" */ +/* say "> Report to support personnel that the ISARC module is unable <" */ +/* say "> to properly allocate free filemodes. Further processing <" */ +/* say "> cannot continue. <" */ +/* say "" */ +/* say "Press ENTER to continue..." */ +/* parse upper pull waiting */ +/* exit */ +/* end */ +freemode=DetermineCodeMode(master_loc) +if freemode = "UNKNOWN" then do + say "ERROR ISA005: Unable to determine location of ISARC files." + say "" + say "Please notify the HelpDesk at 502/852-7997 and report the" + say "following message to them:" + say "" + say "> Report to support personnel that the ISARC module is unable <" + say "> to properly determine the location of its files. Further <" + say "> processing can not continue. <" + say "" + say "Press ENTER to continue..." + parse upper pull waiting + exit +end +else do + address command "PIPE CMS ACCESS 319 P | HOLE" +/* 09061994 MODIFICATION: Replaced "P" with "freemode" for detection */ +/* of the $MAINT disabler file. */ +/*address command "PIPE CMS STATE $MAINT $DISABLE P | HOLE" */ + address command "PIPE CMS STATE $MAINT $DISABLE" freemode "| HOLE" + if RC = 0 then do +/* 09061994 MODIFICATION: Disabled RELEASE code. The location where */ +/* ISARC code and files are stored can not be */ +/* released. */ +/* address command "PIPE CMS RELEASE" freemode "| HOLE" */ + say "ERROR ISA004: Individual Student Account request/information" + say " services are not available at this time. These" + say " services are currently under maintenance." + say " Please try again at a later time." + say "" + say "Press ENTER to continue..." + parse upper pull waiting + exit + end +end + +/* 09061994 MODIFICATION: Disabled RELEASE code. The location where */ +/* ISARC code and files are stored can not be */ +/* released. */ +/* address command "PIPE CMS RELEASE" freemode "| HOLE" */ + +/* Does the temporary file (to gain XEDIT environment access) exist? */ +"PIPE CMS STATE $$TEMP$$ $$FILE$$ * | HOLE" +if RC ^= 0 then do + say "ERROR ISA001: Unable to locate necessary file for execution." + say "" + say "Please notify the HelpDesk at 502/852-7997 and report the" + say "following message to them:" + say "" + say "> Report to support personnel that the file named $$TEMP$$ <" + say "> $$FILE$$ could not be located. Requests and queries <" + say "> concerning individual student accounts can not be initiated <" + say "> without the presence of this file. <" + say "" + say "Press ENTER to continue..." + parse upper pull waiting + exit +end + +/* Does the profile containing the top level menu exist? */ +"PIPE CMS STATE ISARCMNU XEDIT * | HOLE" +if RC ^= 0 then do + say "ERROR ISA002: Unable to locate necessary file for execution." + say "" + say "Please notify the HelpDesk at 502/852-7997 and report the" + say "following message to them:" + say "" + say "> Report to support personnel that the file named ISARCMNU <" + say "> XEDIT could not be located. Requests and queries concerning <" + say "> individual student accounts can not be initiated without the <" + say "> presence of this file. <" + say "" + say "Press ENTER to continue..." + parse upper pull waiting + exit +end + +/* Indicate that input is requested from the menu */ +menu_status="INPUT" + +/* Initialize the cursor placement on the menus */ +lastline=9 +lastcol=22 + +/* The menu portion of the code can have 7 states */ +/* INPUT - input is needed */ +/* FINISHED - customer has requested exit from the menus */ +/* REQUEST - customer wants to request an account */ +/* QUERY - customer wants to query the status of an account */ +/* INFORMATION - customer wants to view general account info */ +/* UNAVAILABLE - no menu items are available (could not locate */ +/* the profiles for the menu items) */ +/* MAINT - ISARC has been issued a request by support */ +/* personnel to go into maintenance mode. */ +do until menu_status="FINISHED" + + /* Check to see if any of the necessary external disks have been */ + /* accessed. If so, then release them so that other routines */ + /* in the menu/request mechanism do not keep requesting filemodes*/ + /* until we run out of them... */ + "PIPE CMS QUERY ACCESSED | DROP FIRST | STACK FIFO" + do index=1 to queued() + parse upper pull fm . . vdev . + vdev=strip(vdev) + if (vdev = "491") then + address command "RELEASE" fm + end + + /* Check to see if $MAINT $DISABLE is present on VMSERV02 491. */ + /* If so, a maintenance mode has been declared. Shut the */ + /* front-end system down. */ + /* 08121994 MODIFICATION: Now looking on 319-P for file. */ + /* 09061994 MODIFICATION: Now looking in */ + /* VMSYS:VMSERV01.ISARC.PUBLIC_ACCESS */ + /* for $MAINT $DISABLE. */ +/*address command "GETFMADR" */ +/*parse upper pull . freemode . check */ +/*if check ^= "" then do */ +/* say "ERROR ISA005: Unable to allocate a free filemode." */ +/* say "" */ +/* say "Please notify the HelpDesk at 502/852-7997 and report the" */ +/* say "following message to them:" */ +/* say "" */ +/* say "> Report to support personnel that the ISARC module is unable <" */ +/* say "> to properly allocate free filemodes. Further processing <" */ +/* say "> cannot continue. <" */ +/* say "" */ +/* say "Press ENTER to continue..." */ +/* parse upper pull waiting */ +/* exit */ +/*end */ + freemode=DetermineCodeMode(master_loc) + if freemode = "UNKNOWN" then do + say "ERROR ISA005: Unable to determine location of ISARC files." + say "" + say "Please notify the HelpDesk at 502/852-7997 and report the" + say "following message to them:" + say "" + say "> Report to support personnel that the ISARC module is unable <" + say "> to properly determine the location of its files. Further <" + say "> processing can not continue. <" + say "" + say "Press ENTER to continue..." + parse upper pull waiting + exit + end + else do + address command "PIPE CMS ACCESS 319 P | HOLE" +/* 09061994 MODIFICATION: Replaced "P" with "freemode" for detection */ +/* of the $MAINT disabler file. */ +/* address command "PIPE CMS STATE $MAINT $DISABLE P | HOLE" */ + address command "PIPE CMS STATE $MAINT $DISABLE" freemode "| HOLE" + if (RC = 0) | (menu_status = "MAINT") then do +/* 09061994 MODIFICATION: Disabled RELEASE code. The location where */ +/* ISARC code and files are stored can not be */ +/* released. */ +/* address command "PIPE CMS RELEASE" freemode "| HOLE" */ + say "ERROR ISA004: Individual Student Account request/information" + say " services are not available at this time. These" + say " services are currently under maintenance." + say " Please try again at a later time." + say "" + say "Press ENTER to continue..." + parse upper pull waiting + exit + end + end + + /* Place the cursor placement information on the program stack */ + queue lastline + queue lastcol + + /* Display the menu panel */ + "XEDIT $$TEMP$$ $$FILE$$ * (PROFILE ISARCMNU NOLOCK)" + parse upper pull menu_status + if menu_status ^= "FINISHED" then do + parse pull lastline + parse pull lastcol + select + + when menu_status = "REQUEST" then do + /* Display the account request instructions */ + "XEDIT INSTRUCT ISARCTXT * (PROFILE ISARCINS NOLOCK)" + /* Display the account request panel */ + "XEDIT $$TEMP$$ $$FILE$$ * (PROFILE ISARCREQ NOLOCK)" + parse upper pull request_status + /* Perform the appropriate request action depending */ + /* on the result we retrieve from the stack. */ + select + when request_status="EXECUTE" then + call prepare_and_submit_request + when request_status="DO NOT EXECUTE" then nop + otherwise nop + end + end + + when menu_status = "QUERY" then do + /* Display the account request panel */ + "XEDIT $$TEMP$$ $$FILE$$ * (PROFILE ISARCQRY NOLOCK)" + parse upper pull request_status + /* Perform the appropriate query action depending */ + /* on the result returned from the panel code. */ + select + when request_status="EXECUTE" then + /* Instead of pulling the SSN off of the stack, */ + /* just leave it on for the perform query process. */ + "XEDIT $$TEMP$$ $$FILE$$ * (PROFILE ISARCQST NOLOCK)" + when request_status="DO NOT EXECUTE" then nop + otherwise nop + end + end + + when menu_status = "INFORMATION" then do + /* Display the about info */ + "XEDIT INFORM ISARCTXT * (PROFILE ISARCINF NOLOCK)" + end + + when menu_status = "UNAVAILABLE" then do + /* None of the menu items are available because */ + /* the profiles for them could not be found. */ + menu_status="FINISHED" + say "ERROR ISA003: Individual Student Account request/information" + say " services are not available at this time." + say "" + say "Please notify the HelpDesk at 502/852-7997 and report the" + say "following message to them:" + say "" + say "> Report to support personnel that the", + "menu system could not be <" + say "> brought up either because the menu", + "item profiles could not be <" + say "> located or because one or more of", + "the auxiliary files could <" + say "> not be located. ", + " <" + say "" + say "Press ENTER to continue..." + parse upper pull waiting + exit + end + + when menu_status = "MAINT" then nop + + otherwise nop + end + end + + /* Does the temporary file (to gain XEDIT environment access) exist? */ + "PIPE CMS STATE $$TEMP$$ $$FILE$$ * | HOLE" + if RC ^= 0 then do + say "ERROR ISA001: Unable to locate necessary file for execution." + say "" + say "Please notify the HelpDesk at 502/852-7997 and report the" + say "following message to them:" + say "" + say "> Report to support personnel that the file named $$TEMP$$ <" + say "> $$FILE$$ could not be located. Requests and queries <" + say "> concerning individual student accounts can not be initiated <" + say "> without the presence of this file. <" + say "" + say "Press ENTER to continue..." + parse upper pull waiting + exit + end + + /* Does the profile containing the top level menu exist? */ + "PIPE CMS STATE ISARCMNU XEDIT * | HOLE" + if RC ^= 0 then do + say "ERROR ISA002: Unable to locate necessary file for execution." + say "" + say "Please notify the HelpDesk at 502/852-7997 and report the" + say "following message to them:" + say "" + say "> Report to support personnel that the file named ISARCMNU <" + say "> XEDIT could not be located. Requests and queries concerning <" + say "> individual student accounts can not be initiated without the <" + say "> presence of this file. <" + say "" + say "Press ENTER to continue..." + parse upper pull waiting + exit + end + +end + +/* Before we exit, make sure that we have cleaned up after */ +/* ourselves. Check to see what filemode(s) have been accessed */ +/* for VMSERV02 491, and release these filemodes. */ +"PIPE CMS QUERY ACCESSED | DROP FIRST | STACK FIFO" +do index=1 to queued() + parse upper pull fm . . vdev . + vdev=strip(vdev) + if (vdev = "491") then + address command "RELEASE" fm +end + +"DESBUF" + +exit + +/********************************************************************/ +/* This routine prepares for the submission of the request by first */ +/* pulling the customer data items off of the stack, and then */ +/* by packing the data items (in padded format) into one record. */ +/* The record is then sent to VMSERV01. */ +/********************************************************************/ +prepare_and_submit_request: + +/* Let us form the record to transmit... */ +request_record_to_submit="" +parse pull first_name +parse pull middle_initial +parse pull last_name +parse pull SSN +parse pull TTPIN + +/* Now form the prospective userid */ +/* First of all, get the first alpha character of the name. */ +/* The apostrophe and hyphen characters must be excluded */ +/* from consideration as the first character of a userid. */ +do firstindex = 1 to length(first_name) + char_to_consider=substr(first_name,firstindex,1) + if (char_to_consider ^= "'") & (char_to_consider ^= "-") then + leave firstindex +end + +prosp_userid=char_to_consider||middle_initial + +lastpart="" +do lastindex = 1 to length(last_name) + char_to_consider=substr(last_name,lastindex,1) + if (char_to_consider ^= "'") & (char_to_consider ^= "-") then + lastpart=lastpart||char_to_consider +end + +if length(lastpart) < 4 then + prosp_userid=prosp_userid||lastpart||, + left("0000",(4-length(lastpart))) +else + prosp_userid=prosp_userid||left(lastpart,4) + +prosp_userid=prosp_userid||"Z1" + +upper prosp_userid + +request_record_to_submit=left(SSN,9)||" "||"R"||" "||left(TTPIN,6)||, + " "||left(prosp_userid,8)||, + " "||left(last_name,15)||, + left(first_name,15)||left(middle_initial,1) +queue request_record_to_submit +"XEDIT $$TEMP$$ $$FILE$$ * (PROFILE ISARCRST NOLOCK)" + +return + +/**********************************************************************/ +/**********************************************************************/ +/**********************************************************************/ +/* 09061994 ADDITION: Added function DetermineCodeMode to find the */ +/* filemode where */ +/* VMSYS:VMSERV01.ISARC.PUBLIC_ACCESS is accessed.*/ +/**********************************************************************/ + +DetermineCodeMode: procedure + + arg master_loc + + freemode="UNKNOWN" + + /* Get the mode definitions from CMS */ + address command "PIPE CMS QUERY ACCESSED", + "| DROP FIRST", + "| STEM MODES.", + "| HOLE" + + /* Now let us search through the mode definitions and find the mode */ + /* at which VMSYS:VMSERV01.ISARC.PUBLIC_ACCESS has been accessed. */ + do mode_index = 1 to modes.0 + parse upper var modes.mode_index cmode . . . cloc + cmode=left(strip(cmode),1) + cloc=strip(cloc) + if (cloc = master_loc) then freemode=cmode + end + +return freemode \ No newline at end of file diff --git a/vmworkshop-vmarcs/1995/stumai95/isarc.listing b/vmworkshop-vmarcs/1995/stumai95/isarc.listing new file mode 100644 index 0000000..c502a51 --- /dev/null +++ b/vmworkshop-vmarcs/1995/stumai95/isarc.listing @@ -0,0 +1,1028 @@ +1 +- INFORMATION TECHNOLOGY + INTERNAL MEMORANDUM + +- TO: Tech Support/SAM + + FROM: Paul Lewis + Tech Support Team + + DATE: August 8, 1994 + + SUBJECT: ISARC + +- ISARC (Individual Student Account Request Component) + + LAST UPDATE: June 12th, 1995 (12:31 p.m.) + +- This document will detail the parts making up ISARC, fea- + tures that enable technical and support personnel to control + the availability of ISARC, provide a data flow diagram be- + tween ISARC modules, and explain the indications behind a + critical error message. + +- CONTENTS ++ CONTENTS ++ CONTENTS ++ CONTENTS ++ ________ + +0 ISARC Modules + ISARC Support Files + Modifying ISARC + Controlling the Availability of ISARC + ISARC Critical Error Message Indications + Conditions Required for Auto-Disable of Menu Items + ISARC Data Flow/Call Paths + + Appendix A. Critical Error Message Code Descriptions + +- ISARC MODULES ++ ISARC MODULES ++ ISARC MODULES ++ ISARC MODULES ++ _____________ + +0 ISARC consists of several modules, all of which form the re- + quest component. Each module, for the most part, has a sep- + arate and distinct function. The modules and their + functions are detailed below. + +1 Page 2 + +0 Module Function ++ Module Function ++ Module Function ++ Module Function ++ ______ ________ + + ISARC Main Module. Controls the calling of and inter- ++ ISARC ++ ISARC ++ ISARC + action between all of the ISARC modules except for + the ISARCHLP module. ISARCHLP execution is called + separately by any other module which needs use of + the online help display. + + ISARCHLP The online help display module. This module for- ++ ISARCHLP ++ ISARCHLP ++ ISARCHLP + mats the screen in a way suitable for viewing on- + line help, but does not allow the customer to + "branch out" of the request component by executing + CMS commands. + + ISARCINF This module formats the screen in a manner suit- ++ ISARCINF ++ ISARCINF ++ ISARCINF + able for viewing the online information on indi- + vidual student accounts. + + ISARCINS This module serves as a step between the main menu ++ ISARCINS ++ ISARCINS ++ ISARCINS + and the actual account request screen. In- + structions for requesting an account are formatted + and presented in a manner suitable to a restricted + environment. + + ISARCMNU The main menu. This module presents the customer ++ ISARCMNU ++ ISARCMNU ++ ISARCMNU + with a menu environment and displays the three + possible menu items available. Much of the error + recovery and shutdown/maintenance code is con- + tained within this module. + + ISARCQRY This module is step one of two of the query status ++ ISARCQRY ++ ISARCQRY ++ ISARCQRY + process. The customer is presented with an input + screen requesting their Social Security Number, + and upon the valid input of the SSN, the result is + returned for processing. + + ISARCQST This module is the final step of the query status ++ ISARCQST ++ ISARCQST ++ ISARCQST + process. The returned SSN is matched against the + results file (MESSAGE MASTER), and results found + (if any) are displayed. + + ISARCREQ This module is step one of two of the account re- ++ ISARCREQ ++ ISARCREQ ++ ISARCREQ + quest process. The customer is presented with an + input screen requesting the full name, SSN, and + Touch-Tone Registration PIN belonging to the cus- + tomer. The results are then returned for further + processing. + + ISARCRST This module is the final step of the account re- ++ ISARCRST ++ ISARCRST ++ ISARCRST + quest process. The returned results are inserted + into a data packet (record) and transmitted to the + +1 Page 3 + +0 VMSERV01 service machine. The results of the re- + quest are displayed for the customer. + +- ISARC SUPPORT FILES ++ ISARC SUPPORT FILES ++ ISARC SUPPORT FILES ++ ISARC SUPPORT FILES ++ ___________________ + +0 ISARC also employs the use of several specialized and plain + text files. The uses of these files range from help display + contents to disabling or shutting down part or all of the + request component. The name of each file and its purpose is + detailed below. + +0 File Function ++ File Function ++ File Function ++ File Function ++ ____ ________ + + INFORM ISARCTXT A plain text file containing information ++ INFORM ISARCTXT ++ INFORM ISARCTXT ++ INFORM ISARCTXT + about the individual student accounts. + + INSTRUCT ISARCTXT A plain text file containing the inter- ++ INSTRUCT ISARCTXT ++ INSTRUCT ISARCTXT ++ INSTRUCT ISARCTXT + mediary instructions for requesting an + individual student account. + + ISARCINF ISARCHLP A plain text file intended only for on- ++ ISARCINF ISARCHLP ++ ISARCINF ISARCHLP ++ ISARCINF ISARCHLP + line help. Used to assist the customer + with the about information display + panel. + + ISARCMNU ISARCHLP A plain text file (intended for online ++ ISARCMNU ISARCHLP ++ ISARCMNU ISARCHLP ++ ISARCMNU ISARCHLP + help) which is used to assist the cus- + tomer with the main menu input panel. + + ISARCQRY ISARCHLP A plain text file used to assist the ++ ISARCQRY ISARCHLP ++ ISARCQRY ISARCHLP ++ ISARCQRY ISARCHLP + customer with the query status input + screen. This file is only intended for + online help. + + ISARCREQ ISARCHLP A plain text file intended only for on- ++ ISARCREQ ISARCHLP ++ ISARCREQ ISARCHLP ++ ISARCREQ ISARCHLP + line help. Used to assist the customer + with the account request input screen. + + MAKISARC EXEC A REXX exec used to "make" the public ++ MAKISARC EXEC ++ MAKISARC EXEC ++ MAKISARC EXEC + access version of ISARC. + + $ABOUT $DISABLE The file used to disable the "about" ++ $ABOUT $DISABLE ++ $ABOUT $DISABLE ++ $ABOUT $DISABLE + menu item on the main menu. + + $MAINT $DISABLE The file used to disable all of ISARC. ++ $MAINT $DISABLE ++ $MAINT $DISABLE ++ $MAINT $DISABLE + + $QUERY $DISABLE The file used to disable the "query sta- ++ $QUERY $DISABLE ++ $QUERY $DISABLE ++ $QUERY $DISABLE + tus" menu item on the main menu. + +1 Page 4 + +0 $REQUEST $DISABLE The file used to disable the "request ++ $REQUEST $DISABLE ++ $REQUEST $DISABLE ++ $REQUEST $DISABLE + account" menu item on the main menu. + + $$TEMP$$ $$FILE$$ The file used to gain access to the ++ $$TEMP$$ $$FILE$$ ++ $$TEMP$$ $$FILE$$ ++ $$TEMP$$ $$FILE$$ + XEDIT environment and its commands and + methods of interactive full-screen in- + put. + +- MODIFYING ISARC ++ MODIFYING ISARC ++ MODIFYING ISARC ++ MODIFYING ISARC ++ _______________ + +0 After modifying one or more of the components of ISARC (or + even some of the support/text files associated with ISARC), + it will be necessary to "re-make" ISARC for public access. + To do so, make sure the account being used for this purpose + has about 5M of virtual storage available (the REXX compiler + will need this). Then make sure that the SFS directory con- + taining the ISARC code and files is accessed. At that + point, execute the exec named "MAKISARC". The exec will + proceed to compile each of the ISARC modules into compiled + REXX. If return codes of 0 and/or 4 are returned from all + of the module compilations (where a return code of 4 indi- + cates that the REXX TRACE command is not supported for com- + pilation), then the make exec will continuing processing. + If at least one of the module compilations did not give the + proper return code, then all further make processing is + halted. + + Given that the module compilations returned the proper + codes, the make exec continues by first discarding the LIST- + ING files (resulting from the compilations). After that, + all old code and files are removed from the public access + directory (VMSYS:VMSERV01.ISARC.PUBLIC_ACCESS), and all new + code and files are moved to the public access directory. As + a final step, PUBLIC access read authority is granted for + each file in the public access directory. It is assumed + that the public access directory has already had the proper + authorizations applied to it (i.e., the READ and NEWREAD au- + thorities have been granted for PUBLIC). If not, this must + be done before public customers will have access to ISARC. + + If testing is to be done on the new code or files, please be + aware of the following restrictions/requirements: + + 1. The account must be able to transmit data to the + VMSERV01 service machine via the CP SMSG facility. + Without this ability, the account request service will + fail and the query status service will be somewhat lim- + ited (those messages needing userids will be replaced + +1 Page 5 + +0 with messages without userids, as userids are obtained + from the VMSERV01 service machine). + + 2. The account must at least have read access to the 491 + minidisk owned by VMSERV02. This access is needed to + obtain the results of account creation processing. + Without access to the VMSERV02 491 minidisk, the query + status and account request services will be made not + available. + + 3. In order to test menu item disables and/or maintenance + shutdown features, the account used for testing (or some + other account) must have read/write access to the SFS + directory VMSYS:VMSERV01.ISARC.PUBLIC_ACCESS (owned by + VMSERV01). This access is needed to write/copy the nec- + essary disabler files to + VMSYS:VMSERV01.ISARC.PUBLIC_ACCESS. + +- CONTROLLING THE AVAILABILITY OF ISARC ++ CONTROLLING THE AVAILABILITY OF ISARC ++ CONTROLLING THE AVAILABILITY OF ISARC ++ CONTROLLING THE AVAILABILITY OF ISARC ++ _____________________________________ + +0 If the need arises to disable some part or parts or all of + ISARC, then the capability does exist. Depending upon + whether you want to disable a certain part or parts of + ISARC, or whether you want to shutdown all of ISARC, you + must determine which files must be placed in the SFS direc- + tory VMSYS:VMSERV01.ISARC.PUBLIC_ACCESS. To determine which + file or files must be placed in + VMSYS:VMSERV01.ISARC.PUBLIC_ACCESS, see below. + +0 File Disables... ++ File Disables... ++ File Disables... ++ File Disables... ++ ____ ___________ + + $ABOUT $DISABLE the about menu item on the main menu. ++ $ABOUT $DISABLE ++ $ABOUT $DISABLE ++ $ABOUT $DISABLE + + $QUERY $DISABLE the query status menu item on the main ++ $QUERY $DISABLE ++ $QUERY $DISABLE ++ $QUERY $DISABLE + menu. + + $REQUEST $DISABLE the account request menu item on the ++ $REQUEST $DISABLE ++ $REQUEST $DISABLE ++ $REQUEST $DISABLE + main menu. + + $MAINT $DISABLE all of ISARC. A message is issued to ++ $MAINT $DISABLE ++ $MAINT $DISABLE ++ $MAINT $DISABLE + the customer that a maintenance mode has + been declared, and that all ISARC ser- + vices are unavailable. + + In addition, note that the contents of the file is not im- + portant, only that the file exists with the specified + filename and filetype on the required minidisk. The menu + item disabler files may be mixed together, i.e., you may + +1 Page 6 + +0 disable more than one of the menu items. However, disabling + all three of the menu items (with the existence of the three + menu item disabler files) will be considered by ISARC the + same as declaring a maintenance mode. Therefore, a mainte- + nance mode can be declared by creating all three of the menu + item disabler files or by creating only the $MAINT $DISABLE + file. However, the intended method for declaring a mainte- + nance mode was to create the $MAINT $DISABLE file. + + When a menu item is disabled via presence of a menu item + disabler file, the customer will see the words "NOT AVAIL- + ABLE" highlighted and beside the menu item. The customer + will not be able to select the menu item. However, please + note that there are some limitations as to when the menu + item is disabled or when ISARC is declared as under mainte- + nance within each account that is executing the ISARC code. + Menu item disables and/or the maintenance mode declaration + is only recognized when the main menu module has control. + If a customer is viewing about information, querying the + status of an account, or requesting an account, then the + customer will be able to complete (depending upon the cir- + cumstances) the action they are performing. Once the cus- + tomer returns to the main menu, the disables or maintenance + mode will take effect. + + However, if the customer is on the main menu and attempts to + select a menu item which has been disabled (but does not yet + show it on the screen), the customer will still not be able + to select the menu item. The main menu module performs + availability checks prior to display or re-display of the + menu screen. + +- ISARC CRITICAL ERROR MESSAGE INDICATIONS ++ ISARC CRITICAL ERROR MESSAGE INDICATIONS ++ ISARC CRITICAL ERROR MESSAGE INDICATIONS ++ ISARC CRITICAL ERROR MESSAGE INDICATIONS ++ ________________________________________ + +0 The following section details some paths to follow in trying + to determine what could be wrong when certain critical error + messages are generated. Note, however, that these are only + suggestions, and that every scenario may not have been cov- + ered. + +0 Message Indication(s) ++ Message Indication(s) ++ Message Indication(s) ++ Message Indication(s) ++ _______ _____________ + + INF001 Either the text file ISARCINF ISARCHLP does not ++ INF001 ++ INF001 ++ INF001 + exist, or the module ISARCHLP XEDIT does not ex- + ist. Make sure that ISARC has access to these + files and that they exist in the public access di- + rectory (if applicable). + +1 Page 7 + +0 ISA001 The file $$TEMP$$ $$FILE$$ does not exist. Make ++ ISA001 ++ ISA001 ++ ISA001 + sure that ISARC has access to this file and that + it exists in the public access directory (if ap- + plicable). + + ISA002 The module ISARCMNU XEDIT does not exist. Make ++ ISA002 ++ ISA002 ++ ISA002 + sure that ISARC has access to this file and that + it exists in the public access directory (if ap- + plicable). + + ISA003 None of the menu item modules (and possibly their ++ ISA003 ++ ISA003 ++ ISA003 + submodules and auxiliary files) could be found. + At least one menu item module and the files and + modules it needs must be locatable before ISARC + will display the main menu. Go through the list + of files and modules making up ISARC, and deter- + mine which ones are missing. + + ISA004 A maintenance mode has been declared for ISARC. A ++ ISA004 ++ ISA004 ++ ISA004 + maintenance mode may only be declared in one of + two ways: (1) the file $MAINT $DISABLE exists in + the SFS directory + VMSYS:VMSERV01.ISARC.PUBLIC_ACCESS, or (2) the + files $ABOUT $DISABLE, $QUERY $DISABLE, and $RE- + QUEST $DISABLE exist in the SFS directory + VMSYS:VMSERV01.ISARC.PUBLIC_ACCESS. + + ISA005 ISARC could not determine the location of ISARC ++ ISA005 ++ ISA005 ++ ISA005 + executable code or support files. The most likely + explanation for this message is that a code error + exists. + + MNU001 ISARC could not locate either ISARCHLP XEDIT or ++ MNU001 ++ MNU001 ++ MNU001 + ISARCMNU ISARCHLP. Both are required to display + online assistance for customers. Make sure that + both files exist and are accessible in the public + access directory (if applicable). + + MNU002 An unknown internal failure occurred. All PF keys ++ MNU002 ++ MNU002 ++ MNU002 + (except the ones defined to QQUIT from XEDIT) are + defined to display this message. The message + should normally never appear, as keypresses are + trapped and interpreted via control of ISARCMNU, + not XEDIT. When the message appears, ISARCMNU no + longer has control. Therefore something happened + (either internal to ISARCMNU or external) to cause + the ISARCMNU code to fail. + + MNU003 This message only appears when a menu item has ++ MNU003 ++ MNU003 ++ MNU003 + been auto-disabled (disabled by ISARC, not by sup- + port personnel). Support personnel may suppress + this message by telling ISARC to disable the menu + +1 Page 8 + +0 item via a menu item disabler file. A disabler + file will override this error condition so that + consulting personnel will not continue to get + calls on this particular message. To find out why + a menu item was disabled, support personnel must + go through the list of conditions which could + auto-disable a menu item, and eliminate each con- + dition as the source of the problem. + + QRY001 ISARC could not locate either ISARCHLP XEDIT or ++ QRY001 ++ QRY001 ++ QRY001 + ISARCQRY ISARCHLP. Both are required to display + online assistance for customers. Make sure that + both files exist and are accessible in the public + access directory (if applicable). + + QRY002 An unknown internal failure occurred. All PF keys ++ QRY002 ++ QRY002 ++ QRY002 + (except the ones defined to QQUIT from XEDIT) are + defined to display this message. The message + should normally never appear, as keypresses are + trapped and interpreted via control of ISARCQRY, + not XEDIT. When the message appears, ISARCQRY no + longer has control. Therefore something happened + (either internal to ISARCQRY or external) to cause + the ISARCQRY code to fail. + + QST001 A message to be displayed on the query status re- ++ QST001 ++ QST001 ++ QST001 + sults display screen is too long in terms of the + number of lines to display. Currently, up to and + including 14 lines may be displayed on the results + display screen. Any more lines than 14 defined to + display will trigger this message. Look for a + message defined internally in the ISARCQST code or + for a message defined in MESSAGE TABLE which vio- + lates this restriction. + + QST002 A message to be displayed on the query status re- ++ QST002 ++ QST002 ++ QST002 + sults display screen is too long in terms of line + width to display. Currently, up to 78 characters + may be displayed on each line of the results dis- + play screen. Any more characters than 78 defined + to display will trigger this message. Look for a + message defined internally in the ISARCQST code or + for a message defined in MESSAGE TABLE which vio- + lates this restriction. + + REQ001 ISARC could not locate either ISARCHLP XEDIT or ++ REQ001 ++ REQ001 ++ REQ001 + ISARCREQ ISARCHLP. Both are required to display + online assistance for customers. Make sure that + both files exist and are accessible in the public + access directory (if applicable). + +1 Page 9 + +0 REQ002 An unknown internal failure occurred. All PF keys ++ REQ002 ++ REQ002 ++ REQ002 + (except the ones defined to QQUIT from XEDIT) are + defined to display this message. The message + should normally never appear, as keypresses are + trapped and interpreted via control of ISARCREQ, + not XEDIT. When the message appears, ISARCREQ no + longer has control. Therefore something happened + (either internal to ISARCREQ or external) to cause + the ISARCREQ code to fail. + + RST001 ISARC detected that VMSERV01 was not logged on. ++ RST001 ++ RST001 ++ RST001 + Without the presence of VMSERV01 on the system, + the account request menu item will be auto- + disabled, and the query status menu item will + still be functional. However, the query status + menu item will switch over to messages that do not + display userids, as userids are not obtainable + without the VMSERV01 service machine. Consult the + necessary support personnel as to why VMSERV01 is + not logged onto the system. If there is no reason + for VMSERV01 to be logged off, restarting VMSERV01 + will re-enable the account request menu item, and + the query status function will return to normal. + + RST002 ISARC was not able to transmit a message to the ++ RST002 ++ RST002 ++ RST002 + VMSERV01 service machine. For reasons unknown, + the CP SMSG facility denied the transmission. Ac- + count requests services will be available, but + will fail when the actual account request is to be + sent to VMSERV01. Query status services will also + be affected; however, messages containing userids + will be replaced with messages without userids. + Consult the necessary support personnel as to why + VMSERV01 is not accepting CP SMSGs. + + RST003 VMSERV01 never responded to repeated data trans- ++ RST003 ++ RST003 ++ RST003 + missions. For each request made of VMSERV01 (ac- + count requests or userids), three retries are made + 20 seconds apart. If all three attempts fail, + this message is displayed. The problem could be + transitory (system load, VMSERV01 extremely busy, + etc.); however, it may be worth the while to en- + sure that VMSERV01 is up and running, that + VMSERV01 has not hung for some reason or another, + and the like. If the problem continues, customer + service will become seriously degraded. + + RST004 The VMSERV01 service machine responded in an unex- ++ RST004 ++ RST004 ++ RST004 + pected manner to an account request. All informa- + tion from consulting personnel and the customer + experiencing the problem should be obtained. In- + cluded in the information should be how the + +1 Page 10 + +0 VMSERV01 service machine responded. The response + of the service machine will be included in the er- + ror message displayed to the customer. As for a + solution, either the ISARCRST module did not take + the response into account (or some other bug ex- + ists), or the VMSERV01 is experiencing problems. + + RST005 A message to be displayed on the account request ++ RST005 ++ RST005 ++ RST005 + results display screen is too long in terms of the + number of lines to display. Currently, up to and + including 14 lines may be displayed on the account + request results display screen. Any more lines + than 14 defined to display will trigger this mes- + sage. Look for a message defined internally in + the ISARCRST code or for a message defined in MES- + SAGE TABLE which violates this restriction. + + RST006 A message to be displayed on the account request ++ RST006 ++ RST006 ++ RST006 + results display screen is too long in terms of + line width to display. Currently, up to 78 char- + acters may be displayed on each line of the ac- + count request results display screen. Any more + characters than 78 defined to display will trigger + this message. Look for a message defined inter- + nally in the ISARCQST code or for a message de- + fined in MESSAGE TABLE which violates this + restriction. + +- CONDITIONS REQUIRED FOR AUTO-DISABLE OF MENU ITEMS ++ CONDITIONS REQUIRED FOR AUTO-DISABLE OF MENU ITEMS ++ CONDITIONS REQUIRED FOR AUTO-DISABLE OF MENU ITEMS ++ CONDITIONS REQUIRED FOR AUTO-DISABLE OF MENU ITEMS ++ __________________________________________________ + +0 When one or more menu items have been auto-disabled (i.e., + support personnel did not knowingly perform this action), + one or more conditions has triggered the auto-disable. In + order to help determine why a menu item or items has been + disabled, the following list of conditions is given for each + menu item which would cause an auto-disable of each menu + item. + +0 Menu Item Conditions Causing Auto-Disable ++ Menu Item Conditions Causing Auto-Disable ++ Menu Item Conditions Causing Auto-Disable ++ Menu Item Conditions Causing Auto-Disable ++ _________ _______________________________ + + About Information ++ About Information ++ About Information ++ About Information + + ISARCINF XEDIT could not be located + + INFORM ISARCTXT could not be located + + Account Request ++ Account Request ++ Account Request ++ Account Request + +1 Page 11 + +0 No free filemode exists + + VMSERV02 491 is not accessible + + MESSAGE TABLE could not be located + + ISARCREQ XEDIT could not be located + + INSTRUCT ISARCTXT could not be lo- + cated + + ISARCINS XEDIT could not be located + + ISARCRST XEDIT could not be located + + VMSERV01 is not logged on + + Query Status ++ Query Status ++ Query Status ++ Query Status + + No free filemode exists + + VMSERV02 491 is not accessible + + MESSAGE TABLE could not be located + + MESSAGE MASTER could not be located + + ISARCQRY XEDIT could not be located + + ISARCQST XEDIT could not be located + +- ISARC DATA FLOW/CALL PATHS ++ ISARC DATA FLOW/CALL PATHS ++ ISARC DATA FLOW/CALL PATHS ++ ISARC DATA FLOW/CALL PATHS ++ __________________________ + +1 Page 12 + +0 +---------------------------------------------------------------+ + | | + | Main Menu Item Selection Processing | + | | + | Component_State | + | & Present_Cursor_Position | + | +---------------+ | + | | | | + | \|/ | | + | | + | ISARC ISARCMNU <------> ISARCHLP | + | | + | | /|\ | + | | | | + | +---------------+ | + | Last_Cursor_Position | + | | + +---------------------------------------------------------------+ + +0 +---------------------------------------------------------------+ + | | + | About Information Retrieval | + | | + | ISARC <------> ISARCINF | + | | + +---------------------------------------------------------------+ + +0 +---------------------------------------------------------------+ + | | + | Account Request Processing | + | | + | Execution_State | + | <& Request_Info> | + | +-------------------+ | + | | | | + | \|/ | | + | | + | +--> ISARC -------> ISARCREQ <------> ISARCHLP | + | | | + | | | | + | | | if EXECUTE then Data_Packet | + | | +---------------+ | + | | | | + | | \|/ | + | | | + | +------------------ ISARCRST | + | | + +---------------------------------------------------------------+ + +1 Page 13 + +0 +---------------------------------------------------------------+ + | | + | Query Account Status Processing | + | | + | Execution_State | + | <& Query_Info> | + | +-------------------+ | + | | | | + | \|/ | | + | | + | +--> ISARC -------> ISARCQRY <------> ISARCHLP | + | | | + | | | | + | | | if EXECUTE then SSN | + | | +---------------+ | + | | | | + | | \|/ | + | | | + | +------------------ ISARCQST | + | | + +---------------------------------------------------------------+ + +- APPENDIX A. CRITICAL ERROR MESSAGE CODE DESCRIPTIONS ++ APPENDIX A. CRITICAL ERROR MESSAGE CODE DESCRIPTIONS ++ APPENDIX A. CRITICAL ERROR MESSAGE CODE DESCRIPTIONS ++ APPENDIX A. CRITICAL ERROR MESSAGE CODE DESCRIPTIONS ++ ____________________________________________________ + +0 Note: The text below is the exact same text distributed to ++ Note: ++ Note: ++ Note: + consulting personnel. None of the wording has been changed; + therefore, the wording may not be entirely appropriate for + support personnel. + +0 (Sorted alphabetically by code) + +0 Below are the currently defined critical messages and codes + for the Individual Student Account Request (ISAR) component. + The best plan of action for any of these messages and codes + is to obtain as much information as possible from the cus- + tomer when any of these conditions are reported. Try to + find out what they were doing (requesting, querying status, + etc.), what they entered or did to cause the condition, and + any other information which the customer can offer which + might assist support personnel in determining and resolving + the problem. Also please be aware that some of the messages + may give "debugging" information, such as message code + RST004. Obtaining this information can be very important. + + There are currently 4 condition states: PLANNED, ERROR, + POSSIBLY SEVERE, and SEVERE (in order of severity, from + least to greatest). PLANNED conditions do not need to be + +1 Page 14 + +0 reported on unless they are suspect in some way. ERROR con- + ditions do not really require immediate contact of support + personnel, but the condition should be resolved as soon as + possible. POSSIBLY SEVERE conditions are termed "possibly" + because they may be severe, but the experienced problem may + also be a transitory effect (e.g., system load and response + time). For POSSIBLY SEVERE conditions, the problem may + clear up on its own, but if the problem does not alleviate + itself in a relatively short time frame, report the condi- + tion immediately to support personnel. Finally, the SEVERE + condition is the worst case, and must be reported to support + personnel immediately. SEVERE conditions most often indi- + cate that most or all of the ISAR component (or some other + process) is down. + +- +--------+--------+------------------------------------+--------+ + | CODE | STATE | DESCRIPTION | MODULE | + +--------+--------+------------------------------------+--------+ + | INF001 | ERROR | Help not available. Contact sup- |ISARCINF| + | | | port personnel. | | + +--------+--------+------------------------------------+--------+ + | | | The file $$TEMP$$ $$FILE$$ could | | + | | | not be located. This file must be | | + | ISA001 | SEVERE | present before any ISAR services | ISARC | + | | | will be made available. Contact | | + | | |support personnel immediately. All | | + | | | services down. | | + +--------+--------+------------------------------------+--------+ + | | | The file ISARCMNU XEDIT could not | | + | | | be located. This file must be | | + | ISA002 | SEVERE | present before any ISAR services | ISARC | + | | | will be made available. Contact | | + | | |support personnel immediately. All | | + | | | services down. | | + +--------+--------+------------------------------------+--------+ + | | | Menu item modules or auxiliary | | + | | | files could not be located. At | | + | | | least one of the menu item modules | | + | | |(and all of its necessary auxiliary | | + | ISA003 | SEVERE |files) must be locatable before the | ISARC | + | | | ISAR component will be made avail- | | + | | |able in some form. Contact support | | + | | | personnel immediately. All ser- | | + | | | vices are down. | | + +--------+--------+------------------------------------+--------+ + | | |The ISAR component or another proc- | | + | ISA004 |PLANNED | ess is down for maintenance. All | ISARC | + | | | services unavailable. | | + +--------+--------+------------------------------------+--------+ + +1 Page 15 + +0 +--------+--------+------------------------------------+--------+ + | CODE | STATE | DESCRIPTION | MODULE | + +--------+--------+------------------------------------+--------+ + | | | Unable to determine location of | | + | | | ISARC executable code or support | | + | ISA005 | SEVERE | files. Contact support personnel | ISARC | + | | |immediately. All services unavail- | | + | | | able. | | + +--------+--------+------------------------------------+--------+ + | MNU001 | ERROR | Help not available. Contact sup- |ISARCMNU| + | | | port personnel. | | + +--------+--------+------------------------------------+--------+ + | | | Unknown internal failure experi- | | + | | |enced. See if customer can explain | | + | MNU002 | SEVERE | the circumstances surrounding the |ISARCMNU| + | | |failure. Contact support personnel | | + | | | immediately. All services suspect | | + | | | until resolved. | | + +--------+--------+------------------------------------+--------+ + | | | One or more of the menu items are | | + | | | not available. This message is | | + | | | generated when support personnel | | + | | |are not aware of the problem (i.e., | | + | | | when a menu item was made not | | + | MNU003 | SEVERE | available, but not because support |ISARCMNU| + | | | personnel had instructed ISARC to | | + | | | perform this action). See if cus- | | + | | | tomer can detail which menu items | | + | | |are not available, and contact sup- | | + | | | port personnel immediately. | | + +--------+--------+------------------------------------+--------+ + | QRY001 | ERROR | Help not available. Contact sup- |ISARCQRY| + | | | port personnel. | | + +--------+--------+------------------------------------+--------+ + | | | Unknown internal failure experi- | | + | | |enced. See if customer can explain | | + | QRY002 | SEVERE | the circumstances surrounding the |ISARCQRY| + | | |failure. Contact support personnel | | + | | | immediately. Query services sus- | | + | | | pect until resolved. | | + +--------+--------+------------------------------------+--------+ + | | | A query status message group is | | + | QST001 | ERROR | larger than allowed for display. |ISARCQST| + | | | Contact support personnel. | | + +--------+--------+------------------------------------+--------+ + | | | A message line of a query status | | + | QST002 | ERROR | message group is too long for dis- |ISARCQST| + | | | play. Contact support personnel. | | + +--------+--------+------------------------------------+--------+ + | REQ001 | ERROR | Help not available. Contact sup- |ISARCREQ| + | | | port personnel. | | + +--------+--------+------------------------------------+--------+ + +1 Page 16 + +0 +--------+--------+------------------------------------+--------+ + | CODE | STATE | DESCRIPTION | MODULE | + +--------+--------+------------------------------------+--------+ + | | | Unknown internal failure experi- | | + | | |enced. See if customer can explain | | + | REQ002 | SEVERE | the circumstances surrounding the |ISARCREQ| + | | |failure. Contact support personnel | | + | | |immediately. Request services sus- | | + | | | pect until resolved. | | + +--------+--------+------------------------------------+--------+ + | | | Unable to detect presence of | | + | | | VMSERV01 service machine. Contact | | + | RST001 | SEVERE |support personnel immediately. Re- |ISARCRST| + | | | quest services unavailable, and | | + | | | query services limited in some re- | | + | | | spects. | | + +--------+--------+------------------------------------+--------+ + | | | Unable to transmit data to the | | + | | |VMSERV01 service machine. The SMSG | | + | | | facility denied the transmission, | | + | | | cause unknown. Contact support | | + | RST002 | SEVERE | personnel immediately. Request |ISARCRST| + | | | services available, but will fail | | + | | |at request submission stage. Query | | + | | | services are also likely to be af- | | + | | | fected in a limited manner. | | + +--------+--------+------------------------------------+--------+ + | | | The VMSERV01 service machine never | | + | | | responded to repeated data trans- | | + | | | missions. This could be a tran- | | + | | POSSI- | sient problem; however, if it | | + | RST003 |BLY SE- | persists contact support personnel |ISARCRST| + | | VERE | immediately. Request services | | + | | |available, but will fail at request | | + | | | submission stage. Query services | | + | | |are also likely to be affected in a | | + | | | limited manner. | | + +--------+--------+------------------------------------+--------+ + | | | The VMSERV01 service machine re- | | + | | | sponded to a data transmission in | | + | | |an unexpected manner. Contact sup- | | + | | | port personnel immediately. The | | + | | |return message to the customer will | | + | RST004 | SEVERE | have the response of the service |ISARCRST| + | | | machine in the message body. | | + | | |Please record the response and give | | + | | |this to support personnel. Request | | + | | | services and query services are | | + | | | suspect until resolved. | | + +--------+--------+------------------------------------+--------+ + +1 Page 17 + +0 +--------+--------+------------------------------------+--------+ + | CODE | STATE | DESCRIPTION | MODULE | + +--------+--------+------------------------------------+--------+ + | | | A request status message group is | | + | RST005 | ERROR | larger than allowed for display. |ISARCRST| + | | | Contact support personnel. | | + +--------+--------+------------------------------------+--------+ + | | | A message line of a request status | | + | RST006 | ERROR | message group is too long for dis- |ISARCRST| + | | | play. Contact support personnel. | | + +--------+--------+------------------------------------+--------+ + diff --git a/vmworkshop-vmarcs/1995/stumai95/isarchlp.xedit b/vmworkshop-vmarcs/1995/stumai95/isarchlp.xedit new file mode 100644 index 0000000..171d83f --- /dev/null +++ b/vmworkshop-vmarcs/1995/stumai95/isarchlp.xedit @@ -0,0 +1,100 @@ +/*********************************************************************/ +/* */ +/* ISARCHLP XEDIT */ +/* */ +/* Usage: ISARCHLP is an XEDIT-based interactive viewing screen */ +/* designed to be invoked for help display services. */ +/* */ +/* ISARCHLP is an interactive viewing screen which allows the */ +/* customer to view help information in a more restricted */ +/* environment than is provided by the CMS help facility. The help */ +/* text will usually be updated by those service committees related */ +/* to individual student accounts or by teams within Data Center */ +/* Services. */ +/* */ +/* Exit Code Definitions: */ +/* Exit Codes are not used. */ +/* */ +/* Required Files: */ +/* ******** ******** (Any Calling program) */ +/* */ +/* Mod Date Init Description */ +/* -------- ---- ------------------------------------------------- */ +/* 07261994 PDL Initial Development */ +/* 07291994 PDL Program/modules names changed. */ +/* 07291994 PDL Changed userid display to mod/level display. */ +/* */ +/*********************************************************************/ + +level="102" + +/* Discard any extraneous information on the stack. */ +"DESBUF" + +/* Set up the XEDIT environment in a way conducive to */ +/* viewing a file in a very restricted manner. */ +address xedit + +"SET CTLCHAR % ESCAPE" +"SET CTLCHAR @ PROTECT HIGH" +"SET CTLCHAR ! PROTECT NOHIGH" +"SET CTLCHAR $ NOPROTECT HIGH" + +"SET CASE MIXED" +"SET LINEND OFF" +"SET TOFEOF OFF" +"SET PREFIX OFF" +"SET SCALE OFF" +"SET MSGLINE ON -4 2" +"SET CMDLINE OFF" +"SET MSGMODE ON" +"SET CURLINE ON 5" +"VERIFY OFF 1 80" + +/* "un-RESERVE" all of the XEDIT lines */ +/* that were reserved, if any. */ +"EXTRACT /RESERVED */" +do index=1 to RESERVED.0 + parse var RESERVED.index linenum otherstuff + "SET RESERVED" linenum "OFF" +end + +/* Default all of the PF keys */ +do index=1 to 24 + "SET PF"index "BEFORE EMSG You have pressed an invalid PF key. ", + "Valid PF keys are shown below." +end + +"SET PF3 BEFORE QQUIT" +"SET PF7 BEFORE BACKWARD" +"SET PF8 BEFORE FORWARD" +"SET PF12 BEFORE QQUIT" +"SET PF15 BEFORE QQUIT" +"SET PF19 BEFORE BACKWARD" +"SET PF20 BEFORE FORWARD" +"SET PF24 BEFORE QQUIT" + +"SET COLOR FILEAREA DEFAULT NONE NOHIGH" +"SET COLOR CURLINE DEFAULT NONE NOHIGH" + +"SET RESERVED 1 NOH %!ISARCHLP ("level") ", + "%@University of Louisville%! ", + left(date(),11) +"SET RESERVED 2 NOH %! ", + "%@Help Display%!" +"SET RESERVED 3 N %@------------------------------------- *", + "--------------------------------------- " +"SET RESERVED 4 N" + +"SET RESERVED -3 N" +"SET RESERVED -2 N %@------------------------------------- *", + "--------------------------------------- " +"SET RESERVED -1 N %@PF3/PF12%! Quit ", + "%@PF7%! Previous Screen ", + "%@PF8%! Next Screen" + +"CURSOR SCREEN 1 80" + +address command + +exit \ No newline at end of file diff --git a/vmworkshop-vmarcs/1995/stumai95/isarcinf.isarchlp b/vmworkshop-vmarcs/1995/stumai95/isarcinf.isarchlp new file mode 100644 index 0000000..73bb35d --- /dev/null +++ b/vmworkshop-vmarcs/1995/stumai95/isarcinf.isarchlp @@ -0,0 +1,12 @@ + About Individual Student Accounts Help Screen + ============================================= + + Press PF8 to scroll forward in the display file and view the next + screen. + + Press PF7 to scroll backwards in the display file and view the + previous screen. + + Press PF3 or PF12 to exit from the display file and quit viewing. + + -------------------------END OF FILE----------------------------- \ No newline at end of file diff --git a/vmworkshop-vmarcs/1995/stumai95/isarcinf.xedit b/vmworkshop-vmarcs/1995/stumai95/isarcinf.xedit new file mode 100644 index 0000000..01c8b0d --- /dev/null +++ b/vmworkshop-vmarcs/1995/stumai95/isarcinf.xedit @@ -0,0 +1,141 @@ +/*********************************************************************/ +/* */ +/* ISARCINF XEDIT */ +/* */ +/* Usage: ISARCINF is an XEDIT-based interactive viewing screen */ +/* designed to be invoked from the ISARC EXEC. */ +/* */ +/* ISARCINF is an interactive viewing screen which allows the */ +/* customer to view about information and other such information */ +/* in a restricted environment. The information displayed will */ +/* usually be updated by those service committees related to */ +/* individual student accounts or by teams within Data Center */ +/* Services. */ +/* */ +/* Exit Code Definitions: */ +/* Exit Codes are not used. */ +/* */ +/* Required Files: */ +/* ISARC EXEC (Calling program) */ +/* ISARCINF ISARCHLP (Help for the about file viewing screen) */ +/* INFORM ISARCTXT (Plain text file containing about info) */ +/* */ +/* Mod Date Init Description */ +/* -------- ---- ------------------------------------------------- */ +/* 07181994 PDL Initial Development */ +/* 07261994 PDL Removed "Print" option. */ +/* 07291994 PDL Program/modules names changed. */ +/* 07291994 PDL Changed to new help display method. */ +/* 07291994 PDL Changed PF1 key wording to "Help". */ +/* 07291994 PDL Changed userid display to mod/level display. */ +/* 08011994 PDL Various message text changes. */ +/* 08041994 PDL Added code to detect presence of ISARCHLP prior */ +/* to invoking the help display function. */ +/* */ +/*********************************************************************/ + +level="107" + +/* Make sure we have no extraneous information on the stack. */ +"DESBUF" + +/* Set up the XEDIT environment in a way conducive to */ +/* viewing a file in a very restricted manner. */ +address xedit + +"SET CTLCHAR % ESCAPE" +"SET CTLCHAR @ PROTECT HIGH" +"SET CTLCHAR ! PROTECT NOHIGH" +"SET CTLCHAR $ NOPROTECT HIGH" + +"SET CASE MIXED" +"SET LINEND OFF" +"SET TOFEOF OFF" +"SET PREFIX OFF" +"SET SCALE OFF" +"SET MSGLINE ON -4 2" +"SET CMDLINE OFF" +"SET MSGMODE ON" +"SET CURLINE ON 5" +"VERIFY OFF 1 80" + +/* "un-RESERVE" all of the XEDIT lines */ +/* that were reserved, if any. */ +"EXTRACT /RESERVED */" +do index=1 to RESERVED.0 + parse var RESERVED.index linenum otherstuff + "SET RESERVED" linenum "OFF" +end + +/* Default all of the PF keys */ +do index=1 to 24 + "SET PF"index "BEFORE EMSG You have pressed an invalid PF key. ", + "Valid PF keys are shown below." +end + +/* Does help for this XEDIT screen exist? */ +"PIPE CMS STATE ISARCINF ISARCHLP * | HOLE" +retcode=RC +"PIPE CMS STATE ISARCHLP XEDIT * | HOLE" +if retcode=0 then retcode=RC +if retcode ^= 0 then do + help_available="NO" + help_state="EMSG ERROR INF001: Help for this screen (ISARCINF) is", + "currently not available. Please report this to the", + "HelpDesk at 502/852-7997." +end +else do + help_available="YES" + help_state="CMS XEDIT ISARCINF ISARCHLP * (PROFILE ISARCHLP NOLOCK)" +end + +"SET PF1 BEFORE" help_state +/* CODE DISABLED PER 07261994 MODIFICATION */ +/* "SET PF2 BEFORE CMS CMSPRINT STUDREQ INFO *" */ +"SET PF3 BEFORE QQUIT" +"SET PF7 BEFORE BACKWARD" +"SET PF8 BEFORE FORWARD" +"SET PF9 BEFORE" help_state +"SET PF12 BEFORE QQUIT" +"SET PF13 BEFORE" help_state +/* CODE DISABLED PER 07261994 MODIFICATION */ +/* "SET PF14 BEFORE CMS CMSPRINT STUDREQ INFO *" */ +"SET PF15 BEFORE QQUIT" +"SET PF19 BEFORE BACKWARD" +"SET PF20 BEFORE FORWARD" +"SET PF21 BEFORE" help_state +"SET PF24 BEFORE QQUIT" + +"SET COLOR FILEAREA DEFAULT NONE NOHIGH" +"SET COLOR CURLINE DEFAULT NONE NOHIGH" + +"SET RESERVED 1 NOH %!ISARCINF ("level") ", + "%@University of Louisville%! ", + left(date(),11) +"SET RESERVED 2 NOH %! ", + "%@About Individual Student Accounts%!" +"SET RESERVED 3 N %@------------------------------------- *", + "--------------------------------------- " +"SET RESERVED 4 N" + +/* CODE REPLACED PER 07261994 MODIFICATION */ +/* "SET RESERVED -4 N" */ +/* "SET RESERVED -3 N %@------------------------------------- *", */ +/* "--------------------------------------- " */ +/* "SET RESERVED -2 N %@PF1/PF9%! Help ", */ +/* " %@PF2%! Print Information ", */ +/* " %@PF3/PF12%! Quit" */ +/* "SET RESERVED -1 N %@PF7%! Previous Page ", */ +/* " %@PF8%! Next Page " */ + +"SET RESERVED -3 N" +"SET RESERVED -2 N %@------------------------------------- *", + "--------------------------------------- " +"SET RESERVED -1 N %@PF1/PF9%! Help %@PF3/PF12%! Quit ", + "%@PF7%! Previous Screen %@PF8%! Next Screen" + +"CURSOR SCREEN 1 80" + +address command + +exit \ No newline at end of file diff --git a/vmworkshop-vmarcs/1995/stumai95/isarcins.xedit b/vmworkshop-vmarcs/1995/stumai95/isarcins.xedit new file mode 100644 index 0000000..a901b90 --- /dev/null +++ b/vmworkshop-vmarcs/1995/stumai95/isarcins.xedit @@ -0,0 +1,101 @@ +/*********************************************************************/ +/* */ +/* ISARCINS XEDIT */ +/* */ +/* Usage: ISARCINS is an XEDIT-based interactive viewing screen */ +/* designed to be invoked from the ISARC EXEC. */ +/* */ +/* ISARCINS is an interactive viewing screen which allows the */ +/* customer to view request instructions and other such information */ +/* in a restricted environment. The information displayed will */ +/* usually be updated by those service committees related to */ +/* individual student accounts or by teams within Data Center */ +/* Services. */ +/* */ +/* Exit Code Definitions: */ +/* Exit Codes are not used. */ +/* */ +/* Required Files: */ +/* ISARC EXEC (Calling program) */ +/* INSTRUCT ISARCTXT (Plain text file containing request */ +/* instruction information) */ +/* */ +/* Mod Date Init Description */ +/* -------- ---- ------------------------------------------------- */ +/* 07291994 PDL Initial Development */ +/* */ +/*********************************************************************/ + +level="100" + +/* Make sure we have no extraneous information on the stack. */ +"DESBUF" + +/* Set up the XEDIT environment in a way conducive to */ +/* viewing a file in a very restricted manner. */ +address xedit + +"SET CTLCHAR % ESCAPE" +"SET CTLCHAR @ PROTECT HIGH" +"SET CTLCHAR ! PROTECT NOHIGH" +"SET CTLCHAR $ NOPROTECT HIGH" + +"SET CASE MIXED" +"SET LINEND OFF" +"SET TOFEOF OFF" +"SET PREFIX OFF" +"SET SCALE OFF" +"SET MSGLINE ON -4 2" +"SET CMDLINE OFF" +"SET MSGMODE ON" +"SET CURLINE ON 5" +"VERIFY OFF 1 80" + +/* "un-RESERVE" all of the XEDIT lines */ +/* that were reserved, if any. */ +"EXTRACT /RESERVED */" +do index=1 to RESERVED.0 + parse var RESERVED.index linenum otherstuff + "SET RESERVED" linenum "OFF" +end + +/* Default all of the PF keys */ +do index=1 to 24 + "SET PF"index "BEFORE EMSG You have pressed an invalid PF key. ", + "Valid PF keys are shown below." +end + +"SET PF6 BEFORE QQUIT" +"SET PF7 BEFORE BACKWARD" +"SET PF8 BEFORE FORWARD" +"SET PF18 BEFORE QQUIT" +"SET PF19 BEFORE BACKWARD" +"SET PF20 BEFORE FORWARD" + +"SET COLOR FILEAREA DEFAULT NONE NOHIGH" +"SET COLOR CURLINE DEFAULT NONE NOHIGH" + + +"SET RESERVED 1 NOH %!ISARCINS ("level") ", + "%@University of Louisville%! ", + left(date(),11) +"SET RESERVED 2 NOH %! ", + "%@Individual Student Account%!" +"SET RESERVED 3 NOH %! ", + " %@Request Instructions%!" +"SET RESERVED 4 N %@------------------------------------- *", + "--------------------------------------- " +"SET RESERVED 5 N" + +"SET RESERVED -3 N" +"SET RESERVED -2 N %@------------------------------------- *", + "--------------------------------------- " +"SET RESERVED -1 N %@PF6%! Continue ", + "%@PF7%! Previous Screen ", + " %@PF8%! Next Screen" + +"CURSOR SCREEN 1 80" + +address command + +exit \ No newline at end of file diff --git a/vmworkshop-vmarcs/1995/stumai95/isarcmnu.isarchlp b/vmworkshop-vmarcs/1995/stumai95/isarcmnu.isarchlp new file mode 100644 index 0000000..91fd88b --- /dev/null +++ b/vmworkshop-vmarcs/1995/stumai95/isarcmnu.isarchlp @@ -0,0 +1,23 @@ + Individual Student Account Main Menu Help Screen + ================================================ + + To select a menu item, place the cursor on the desired menu item and + press ENTER. + + About Individual Student Accounts + --------------------------------- + Takes you into browse on an information file that will give you general + information about individual student accounts. + + Request an Individual Student Account + ------------------------------------- + Displays a preliminary information screen of helpful tips on completing + your request, then accepts input required to create your individual + student account. + + Check the Status of an Account Request + -------------------------------------- + Allows you to view the most current status message concerning your + request and the creation of your individual student account. + + -------------------------END OF FILE----------------------------------- \ No newline at end of file diff --git a/vmworkshop-vmarcs/1995/stumai95/isarcmnu.xedit b/vmworkshop-vmarcs/1995/stumai95/isarcmnu.xedit new file mode 100644 index 0000000..0a232cf --- /dev/null +++ b/vmworkshop-vmarcs/1995/stumai95/isarcmnu.xedit @@ -0,0 +1,625 @@ +/*********************************************************************/ +/* */ +/* ISARCMNU XEDIT */ +/* */ +/* Usage: ISARCMNU is an XEDIT-based interactive input panel */ +/* designed to be invoked from the ISARC EXEC. */ +/* */ +/* ISARCMNU is an interactive menu panel which present three (3) */ +/* selections to the customer: view about information, query the */ +/* status of an account, request an account. The results of the */ +/* selection is returned to ISARC EXEC, and the appropriate menu */ +/* item is called from ISARC EXEC. */ +/* */ +/* Exit Code Definitions: */ +/* Exit Codes are not used. Results returned via the program */ +/* stack: */ +/* o Literal text "FINISHED" returned if the customer wanted */ +/* to exit the account request mechanism. */ +/* o Literal text "UNAVAILABLE" returned if none of the profiles */ +/* for the menu items could be located. */ +/* o Literal text "QUERY" returned if the customer wanted to */ +/* query the status of an account. */ +/* o Literal text "REQUEST" returned if the customer wanted to */ +/* request an account. */ +/* o Literal text "INFORMATION" returned if the customer wanted */ +/* to view the about information for student accounts. */ +/* o Literal text "MAINT" returned if ISARC was issued a maint */ +/* request either via presence of the file $MAINT $DISABLE on */ +/* VMSERV02 491 or via presence of all of the menu item */ +/* $DISABLE files ($ABOUT, $QUERY, $REQUEST) on VMSERV02 491. */ +/* */ +/* Required Files: */ +/* ISARC EXEC (Calling program) */ +/* ISARCMNU ISARCHLP (Help for the top level menu) */ +/* ISARCREQ XEDIT (Profile containing the account request panel)*/ +/* ISARCQRY XEDIT (Profile containing the account query panel) */ +/* ISARCINF XEDIT (Profile containing the account info panel) */ +/* ISARCQST XEDIT (Profile containing query results display) */ +/* ISARCRST XEDIT (Profile containing services wait message) */ +/* MESSAGE TABLE (Plain text file with mechanism messages) */ +/* MESSAGE MASTER (Plain text overnight results file) */ +/* INFORM ISARCTXT (Plain text file with info on accounts) */ +/* INSTRUCT ISARCTXT (Plain text file with request instructions) */ +/* */ +/* Mod Date Init Description */ +/* -------- ---- ------------------------------------------------- */ +/* 07181994 PDL Initial Development */ +/* 07251994 PDL Enabled code for ACCESSing the public data file */ +/* area. */ +/* 07261994 PDL Added code to preserve the cursor placement after */ +/* leaving the menus. This works in conjunction */ +/* with STUDREQ EXEC via the program stack. */ +/* 07291994 PDL Program/modules names changed. */ +/* 07291994 PDL Changed to new help display method. */ +/* 07291994 PDL Changed PF1 key wording to "Help". */ +/* 07291994 PDL Changed userid display to mod/level display. */ +/* 07291994 PDL Changed description text to read "Place the */ +/* cursor on the desired menu item and press ENTER.".*/ +/* 07291994 PDL Changed screen title to display on two lines. */ +/* 07291994 PDL Swapped display of menu items "Check..." and */ +/* "Request...". "Request..." now displays before */ +/* "Check...". */ +/* 08011994 PDL Added ability for administrator-level people */ +/* to at will disable menu items. */ +/* 08011994 PDL Changed all-filemode search on disable menu item */ +/* ability to a search for specifically the filemode */ +/* accessing VMSERV02 491. */ +/* 08011994 PDL Various message text changes. */ +/* 08021994 PDL Added code to display critical conditions when */ +/* one or more menu items are not available. */ +/* 08031994 PDL Added code to display "menu item(s) down..." */ +/* message when one or more menu items are not */ +/* available and the disable file(s) are not present.*/ +/* 08031994 PDL Added code to position cursor properly when */ +/* one or more menu items are disabled. */ +/* 08031994 PDL Added code to detect whether or not the files */ +/* INSTRUCT ISARCTXT and ISARCINS XEDIT are present */ +/* for the request menu item. */ +/* 08031994 PDL Added code to make disabling/maint requests more */ +/* robust. Resulted in addition of exit code */ +/* "MAINT". */ +/* 08041994 PDL Added code to make sure ISARCHLP exists before */ +/* invoking the help display module. */ +/* 08051994 PDL Added fix to cursor positioning code. Cursor not */ +/* properly positioned under case where last item */ +/* is made not available and the first item was */ +/* already not available. */ +/* 08111994 PDL Added message change. When "Z" accounts are */ +/* attempting to access ISARC, the message displayed */ +/* will not be "there is a problem, contact the */ +/* HelpDesk". Instead, it will state that requesting*/ +/* accounts and checking the status of accounts are */ +/* only available from ULINFO from the main UofL */ +/* logo screen. Otherwise, the menu will come up, */ +/* but the "check" and "request" items will be */ +/* unavailable. */ +/* 08121994 PDL Modified where ISARCMNU looks for the disabler */ +/* files. ISARCMNU will now look on 319-P for these */ +/* files instead of VMSERV02 491. This was done so */ +/* that "Z" accounts will also see the disabler files*/ +/* as needed. */ +/* 09011994 PDL Modified presentation method of the three menu */ +/* choices. The cursor is now placed directly on */ +/* the menu items instead of beside the menu item. */ +/* 09061994 PDL Modified procedure "check_for_presence_of_files". */ +/* Code was added to call function */ +/* "DetermineCodeMode" to find at which filemode the */ +/* ISARC code and files are located. The disabler */ +/* files ($MAINT $DISABLE, $ABOUT $DISABLE, $QUERY */ +/* $DISABLE, and $REQUEST $DISABLE) will be looked */ +/* for at the filemode determined by */ +/* "DetermineCodeMode". */ +/* */ +/*********************************************************************/ + +trace off + +level="123" +master_loc="VMSYS:VMSERV01.ISARC.PUBLIC_ACCESS" + +/* CODE DISABLED PER 07261994 MODIFICATION */ +/* Make sure we have no extraneous information on the stack. */ +/* "DESBUF" */ + +/* Retrieve the last line and column that the cursor was on. */ +parse pull lastline +parse pull lastcol + +address command + +/* Make sure that the menu item profiles exist. */ +freemode="" +first_request_for_check="YES" +call check_for_presence_of_files + +if display_no_items = "YES" then do + queue "QQUIT" + queue value_to_return + queue "0" + queue "0" + exit +end + +call position_cursor + +/* Main part of ISARCMNU. Call routines from here and exit out. */ +call prepare_full_screen_environment +call initialize_variables +call process_input +address xedit "QQUIT" +exit + +/****************************************************************/ +/* Input panel processing routine. This routine issues a XEDIT */ +/* screen READ and parses that information. */ +/****************************************************************/ +process_input: +/* We do not actually need to specify that we loop once, but */ +/* this will give the loop a name in case we must LEAVE it. */ +do loop = 1 + /* First, let us display the screen */ + call display_screen + address xedit "READ NOCHANGE NUMBER TAG" + call check_for_presence_of_files + call position_cursor + if display_no_items = "YES" then do + do queued() + parse pull throwaway + end + queue "QQUIT" + queue value_to_return + queue "0" + queue "0" + exit + end + /* Now let us process the information returned from the XEDIT READ */ + do queued() + parse pull key line col text + /* Prevent escapes from being acted upon */ + text=translate(text," ","%") + select + when key = "PFK" then select + when (line = 1) | (line = 9) |, + (line = 13) | (line = 21) then do + "PIPE CMS STATE ISARCMNU ISARCHLP * | HOLE" + retcode=RC + "PIPE CMS STATE ISARCHLP XEDIT * | HOLE" + if retcode=0 then retcode=RC + if retcode ^= 0 then + message = "ERROR MNU001: Help for this screen (ISARCMNU)", + "is currently not available. Please report this", + "message to the HelpDesk at 502/852-7797." + else + address cms "XEDIT ISARCMNU ISARCHLP * (PROFILE", + "ISARCHLP NOLOCK)" + end + when (line = 3) | (line = 12) |, + (line = 15) | (line = 24) then do + queue "FINISHED" + leave loop + end + otherwise message = "You have pressed an invalid PF key. Valid", + "PF keys are shown below." + end + when key = "ETK" then do + call process_selection + if queue_line_info = "YES" then + leave loop + end + otherwise nop + end + end +end +return + +/****************************************************************/ +/* This routine will process any selections made by determining */ +/* what line and column the cursor was on and translate that */ +/* to the desired selection. */ +/****************************************************************/ +process_selection: + +address xedit "EXTRACT /CURSOR/" + +selline=CURSOR.1 +selcol=CURSOR.2 + +"DESBUF" /* Discard any other changed lines */ + +queue_line_info="NO" +select + when (selline = 9) & (display_info_item = "YES") then do + queue "INFORMATION" + queue_line_info="YES" + end + when (selline = 11) & (display_request_item = "YES") then do + queue "REQUEST" + queue_line_info="YES" + end + when (selline = 13) & (display_query_item = "YES") then do + queue "QUERY" + queue_line_info="YES" + end + otherwise nop +end + +/* Now send back the line and column the cursor was on. */ +/* This will preserve the cursor placement for the customer. */ +if queue_line_info = "YES" then do + queue selline + queue selcol +end + +return + +/**********************************************************************/ +/* Set up the XEDIT screen for an input panel. Un-RESERVE all lines, */ +/* default all PF keys, enable/disable certain XEDIT features to make */ +/* the screen conducive to an input panel. */ +/**********************************************************************/ +prepare_full_screen_environment: +address xedit "SET SCALE OFF" +address xedit "SET PREFIX OFF" +address xedit "SET TOFEOF OFF" +address xedit "SET CTLCHAR % ESCAPE" +address xedit "SET CTLCHAR @ PROTECT HIGH" +address xedit "SET CTLCHAR ! PROTECT NOHIGH" +address xedit "SET CTLCHAR $ NOPROTECT HIGH" +address xedit "SET CTLCHAR ¢ NOPROTECT NOHIGH" +address xedit "SET MSGLINE ON 21 2" +address xedit "SET CMDLINE OFF" +address xedit "SET MSGMODE ON" +address xedit "SET LINEND OFF" +address xedit "SET CASE MIXED" +address xedit "VERIFY OFF 1 80" + +do i = 1 to 24 + address xedit "SET PF"i "BEFORE EMSG ERROR MNU002: Internal failure.", + "Exit immediately and report this message to the", + "HelpDesk at 502/852-7997." +end + +address xedit "SET PF3 BEFORE QQUIT" +address xedit "SET PF12 BEFORE QQUIT" +address xedit "SET PF15 BEFORE QQUIT" +address xedit "SET PF24 BEFORE QQUIT" + +address xedit "EXTRACT /RESERVED */" +do index=1 to RESERVED.0 + parse var RESERVED.index linenum otherstuff + address xedit "SET RESERVED" linenum "OFF" +end + +return + +/*************************************************************/ +/* Initialize internal variables and default input fields to */ +/* certain values if there is a need to do so. */ +/*************************************************************/ +initialize_variables: +selline=0 +selcol=0 +err_line=lastline +err_col=lastcol +return + +/*******************************************************************/ +/* Display the actual input screen for the customer. Accomplished */ +/* by reserving the lines via XEDIT and PROTECTing/NOPROTECTing */ +/* the appropriate areas. Also contains the message parsing code */ +/* which formats the message (up to 2 lines) for proper display. */ +/*******************************************************************/ +display_screen: + +address xedit +"SET RESERVED 1 NOH %!ISARCMNU ("level") ", + "%@University of Louisville%! ", + left(date(),11) +"SET RESERVED 2 NOH %! ", + "%@Individual Student Account%!" +"SET RESERVED 3 NOH %! ", + " %@Main Menu%!" +"SET RESERVED 6 NOH %@Place the cursor on the desired menu item", + "and press ENTER." + +if display_info_item = "YES" then + "SET RESERVED 9 NOH %! ", + "%¢About Individual Student Accounts%!" +else + "SET RESERVED 9 NOH %@ NOT AVAILABLE ", + "%!About Individual Student Accounts" + +if display_request_item = "YES" then + "SET RESERVED 11 NOH %! ", + "%¢Request an Individual Student Account%!" +else + "SET RESERVED 11 NOH %@ NOT AVAILABLE ", + "%!Request an Individual Student Account" + +if display_query_item = "YES" then + "SET RESERVED 13 NOH %! ", + "%¢Check the Status of an Account Request%!" +else + "SET RESERVED 13 NOH %@ NOT AVAILABLE ", + "%!Check the Status of an Account Request" + +"SET RESERVED -1 NOH %@PF1/PF9%! Help ", + "%@PF3/PF12%! Quit" +address command + +if message ^= "" then do + if (correct_before_exec == 1) then do + message = "UNABLE TO SUBMIT REQUEST: "||message + correct_before_exec = 0 + end + + /* Now format the message for proper display */ + nextword="" + msglines.0=1 + msgindex=msglines.0 + do index=1 to 2 + msglines.index="" + end + do index=1 to words(message) + msgindex=msglines.0 + nextword=word(message,index) + /* If we can fit the next word into the line, then do so */ + if (length(msglines.msgindex)+length(nextword)) <= 78 then + if length(msglines.msgindex) = 0 then + msglines.msgindex=nextword + else + msglines.msgindex=msglines.msgindex||" "||nextword + /* Otherwise, pad the rest of the current line, */ + /* and start a new line. */ + else do + msglines.msgindex=left(msglines.msgindex,79) + msglines.0=msglines.0+1 + msgindex=msglines.0 + msglines.msgindex=nextword + end + end + msgtodisplay="" + do index=1 to msglines.0 + msgtodisplay=msgtodisplay||msglines.index + end + address xedit "EMSG" msgtodisplay +end +address xedit "CURSOR SCREEN" err_line err_col + +return + +/***********************************************************/ +/* This routine checks to see if the menu item profiles */ +/* exist. If an item does not exist, the appropriate */ +/* no-display flag is set. If none of the profiles exist, */ +/* then set the no-display-any flag to indicate a exit-out.*/ +/***********************************************************/ +check_for_presence_of_files: + +display_info_item="YES" +display_query_item="YES" +display_request_item="YES" +down_info_directed="NO" +down_query_directed="NO" +down_request_directed="NO" +value_to_return="" + +/* We must also re-access 319 P so that we can always get the */ +/* refreshed copy of the directory for 319 P. */ +address command "PIPE CMS ACCESS 319 P | HOLE" + +/* 09061994 ADDITION: Added call to DetermineCodeMode for */ +/* finding the filemode at which ISARC code*/ +/* and files are located. */ +isarc_mode=DetermineCodeMode(master_loc) + +/* First we must access the front-end "external" files that we need */ + +/* Try to access the file area with the MESSAGE TABLE and */ +/* MESSAGE MASTER files. */ + +address command "PIPE CMS QUERY ACCESSED | DROP FIRST | STEM SCAN491." +do scan_index= 1 to scan491.0 + parse var scan491.scan_index fm491 . . addr491 . + fm491=strip(fm491) + addr491=strip(addr491) + if (addr491 = "491") then + address command "RELEASE" fm491 +end + +address command "GETFMADR" +parse upper pull . freemode . check +if check ^= "" then do + display_query_item="NO" + display_request_item="NO" +end +else do + address command "PIPE CMS ACCESS 491" freemode "| HOLE" + if RC ^= 0 then do + display_query_item="NO" + display_request_item="NO" + end +end + +/* Now check to see if the MESSAGE TABLE file exists */ +if (display_query_item="YES") | (display_request_item="YES") then do + "PIPE CMS STATE MESSAGE TABLE * | HOLE" + if RC ^= 0 then do + display_query_item="NO" + display_request_item="NO" + end +end + +/* Now check to see if the MESSAGE MASTER file exists */ +if display_query_item="YES" then do + "PIPE CMS STATE MESSAGE MASTER * | HOLE" + if RC ^= 0 then + display_query_item="NO" +end + +/* Check for files needed for the about info item */ +if display_info_item="YES" then do + "PIPE CMS STATE ISARCINF XEDIT * | HOLE" + if RC ^= 0 then display_info_item="NO" +end + +/* 09061994 MODIFICATION: Now looking at "isarc_mode" instead of "P" */ +/* "PIPE CMS STATE $ABOUT $DISABLE P | HOLE" */ +"PIPE CMS STATE $ABOUT $DISABLE" isarc_mode "| HOLE" +if RC = 0 then do + display_info_item="NO" + down_info_directed="YES" +end + +if display_info_item="YES" then do + "PIPE CMS STATE INFORM ISARCTXT * | HOLE" + if RC ^= 0 then display_info_item="NO" +end + +/* Check for additional files needed for the query status item */ +if display_query_item="YES" then do + "PIPE CMS STATE ISARCQRY XEDIT * | HOLE" + if RC ^= 0 then display_query_item="NO" +end + +/* 09061994 MODIFICATION: Now looking at "isarc_mode" instead of "P" */ +/* "PIPE CMS STATE $QUERY $DISABLE P | HOLE" */ +"PIPE CMS STATE $QUERY $DISABLE" isarc_mode "| HOLE" +if RC = 0 then do + display_query_item="NO" + down_query_directed="YES" +end + +if display_query_item="YES" then do + "PIPE CMS STATE ISARCQST XEDIT * | HOLE" + if RC ^= 0 then display_query_item="NO" +end + +/* Check for additional files needed for the request account item */ +if display_request_item="YES" then do + "PIPE CMS STATE ISARCREQ XEDIT * | HOLE" + if RC ^= 0 then display_request_item="NO" +end + +if display_request_item="YES" then do + "PIPE CMS STATE INSTRUCT ISARCTXT * | HOLE" + if RC ^= 0 then display_request_item="NO" +end + +if display_request_item="YES" then do + "PIPE CMS STATE ISARCINS XEDIT * | HOLE" + if RC ^= 0 then display_request_item="NO" +end + +/* 09061994 MODIFICATION: Now looking at "isarc_mode" instead of "P" */ +/* "PIPE CMS STATE $REQUEST $DISABLE P | HOLE" */ +"PIPE CMS STATE $REQUEST $DISABLE" isarc_mode "| HOLE" +if RC = 0 then do + display_request_item="NO" + down_request_directed="YES" +end + +if display_request_item="YES" then do + "PIPE CMS STATE ISARCRST XEDIT * | HOLE" + if RC ^= 0 then display_request_item="NO" +end + +/* Check to see if the account request service machine is up... */ +if display_request_item="YES" then do + "PIPE CP QUERY USER VMSERV01 | HOLE" + if RC ^= 0 then + display_request_item="NO" +end + +if (display_info_item = "NO") &, + (display_query_item = "NO") &, + (display_request_item = "NO") then do + display_no_items="YES" + value_to_return="UNAVAILABLE" +end +else display_no_items="NO" + +/* Have we been directed to shutdown anyway? */ +if display_no_items="NO" then do + /* 09061994 MODIFICATION: Now looking at "isarc_mode" instead of "P" */ + /* "PIPE CMS STATE $MAINT $DISABLE P | HOLE" */ + "PIPE CMS STATE $MAINT $DISABLE" isarc_mode "| HOLE" + if RC = 0 then do + display_no_items="YES" + value_to_return="MAINT" + end +end + +/* If directed to display no items, was it because all of the disables */ +/* except the $MAINT disable was present? If so, then make it a */ +/* $MAINT disable instead. */ +if (display_no_items="YES") & (down_info_directed="YES") &, + (down_query_directed="YES") & (down_request_directed="YES") then + value_to_return="MAINT" + +message="" +if (display_no_items = "NO") then do + if ((display_info_item = "NO") & (down_info_directed = "NO")) |, + ((display_query_item = "NO") & (down_query_directed = "NO")) |, + ((display_request_item = "NO") & (down_request_directed = "NO")) + then do + if (substr(userid(),7,1) = "Z") then do + message="To request an account or check the status of an", + "account request, please access ULINFO from the main", + "U of L logo screen." + end + else do + message="ERROR MNU003: One or more menu items are not", + "available. Please report this message to the", + "HelpDesk at 502/852-7997." + end + end +end + +return + +position_cursor: + +if (lastline = 9) & (display_info_item = "NO") then lastline=11 +if (lastline = 11) & (display_request_item = "NO") then lastline=13 +if (lastline = 13) & (display_query_item = "NO") then do + if (display_info_item="YES") then lastline=9 + if (display_request_item="YES") then lastline=11 +end + +err_line=lastline +err_col=lastcol + +return + +/**********************************************************************/ +/**********************************************************************/ +/**********************************************************************/ +/* 09061994 ADDITION: Added function DetermineCodeMode to find the */ +/* filemode where */ +/* VMSYS:VMSERV01.ISARC.PUBLIC_ACCESS is accessed.*/ +/**********************************************************************/ + +DetermineCodeMode: procedure + + arg master_loc + + freemode="UNKNOWN" + + /* Get the mode definitions from CMS */ + address command "PIPE CMS QUERY ACCESSED", + "| DROP FIRST", + "| STEM MODES.", + "| HOLE" + + /* Now let us search through the mode definitions and find the mode */ + /* at which VMSYS:VMSERV01.ISARC.PUBLIC_ACCESS has been accessed. */ + do mode_index = 1 to modes.0 + parse upper var modes.mode_index cmode . . . cloc + cmode=left(strip(cmode),1) + cloc=strip(cloc) + if (cloc = master_loc) then freemode=cmode + end + +return freemode \ No newline at end of file diff --git a/vmworkshop-vmarcs/1995/stumai95/isarcqry.isarchlp b/vmworkshop-vmarcs/1995/stumai95/isarcqry.isarchlp new file mode 100644 index 0000000..a44da2f --- /dev/null +++ b/vmworkshop-vmarcs/1995/stumai95/isarcqry.isarchlp @@ -0,0 +1,13 @@ + Check the Status of an Account Request Help Screen + ================================================== + + To check the status of an account request, type your nine digit + social security number and press PF6 to submit your query. + + If you do not have a social security number, enter the nine digit + student number that has been assigned to you. + + You will receive a message screen giving you the most current status + message concerning your request and the creation of your account. + + -------------------------END OF FILE-------------------------------- \ No newline at end of file diff --git a/vmworkshop-vmarcs/1995/stumai95/isarcqry.xedit b/vmworkshop-vmarcs/1995/stumai95/isarcqry.xedit new file mode 100644 index 0000000..75abe8b --- /dev/null +++ b/vmworkshop-vmarcs/1995/stumai95/isarcqry.xedit @@ -0,0 +1,393 @@ +/*********************************************************************/ +/* */ +/* ISARCQRY XEDIT */ +/* */ +/* Usage: ISARCQRY is an XEDIT-based interactive input panel */ +/* designed to be invoked from the ISARC EXEC. */ +/* */ +/* ISARCQRY is an interactive input panel which asks the customer */ +/* for required information (SSN), and returns this information to */ +/* the ISARC EXEC. This information will be used to search */ +/* an account creation results file(s) containing any error */ +/* information for the SSN supplied. */ +/* */ +/* Exit Code Definitions: */ +/* Exit Codes are not used. Results returned via the program */ +/* stack: */ +/* o Literal text "EXECUTE" returned if STUDREQ is to perform */ +/* the account query. Other information passed includes the */ +/* SSN. */ +/* */ +/* o Literal text "DO NOT EXECUTE" returned if STUDREQ is not */ +/* to perform the account query. */ +/* */ +/* Required Files: */ +/* ISARC EXEC (Calling program) */ +/* ISARCQRY ISARCHLP (Help for the account query input panel) */ +/* */ +/* Mod Date Init Description */ +/* -------- ---- ------------------------------------------------- */ +/* 07181994 PDL Initial Development */ +/* 07291994 PDL Program/modules names changed. */ +/* 07291994 PDL Changed to new help display method. */ +/* 07291994 PDL Changed PF1 key wording to "Help". */ +/* 07291994 PDL Changed userid display to mod/level display. */ +/* 07291994 PDL Changed description text to read "To check the */ +/* status of an account, enter your Social Security */ +/* Number and press PF6.". */ +/* 07291994 PDL Expanded/Changed screen title to occupy 2 lines. */ +/* 08011994 PDL Modified code to request confirmation of data */ +/* prior to actual query submission. */ +/* 08011994 PDL Various message text changes. */ +/* 08041994 PDL Added code to detect presence of ISARCHLP module */ +/* prior to displaying help. */ +/* 09071994 PDL Added code to override display of a possible error*/ +/* message when help (PF1, etc.) is requested. */ +/* */ +/*********************************************************************/ + +trace off + +level="110" + +/* Make sure we have no extraneous information on the stack. */ +"DESBUF" + +/* Main part of ISARCQRY. Call routines from here and exit out. */ +address command +call prepare_full_screen_environment +call initialize_variables +call process_input +address xedit "QQUIT" +exit + +/****************************************************************/ +/* Input panel processing routine. This routine issues a XEDIT */ +/* screen READ and parses that information. */ +/****************************************************************/ +process_input: +/* We do not actually need to specify that we loop once, but */ +/* this will give the loop a name in case we must LEAVE it. */ +do loop = 1 + /* First, let us display the screen */ + call display_screen + address xedit "READ NOCHANGE NUMBER TAG" + /* Now let us process the information returned from the XEDIT READ */ + pfkeypressed="" + enterkeypressed="" + do queued() + parse pull key line col text + /* Prevent escapes from being acted upon */ + text=translate(text," ","%") + /* In this part, we will preserve any PF keypresses for later, */ + /* so that data for the fields can be processed beforehand. */ + select + when key = "PFK" then pfkeypressed=line + when key = "RES" then do + call process_fields + submit_confirmation_flag="NONE" + end + when key = "ETK" then enterkeypressed="YES" + otherwise nop + end + end + + /* Check to see if there are any errors before we get to the */ + /* PF key processing and ENTER key processing. */ + call process_errors + + /* Process the Enter key, if pressed. */ + if (enterkeypressed ^= "") &, + (error_flag ^= "THERE ARE ERRORS") then do + enterkeypressed="" + select + when submit_confirmation_flag = "NONE" then do + submit_confirmation_flag="READY" + message="If the above information is correct, press", + "the PF6 key to submit your request." + call display_message + end + when submit_confirmation_flag = "READY" then do + message="You must press the PF6 key to submit your request." + call display_message + end + otherwise nop + end + end + + /* Now let us process PF keypresses... */ + if pfkeypressed ^= "" then do + line=pfkeypressed + pfkeypressed="" + select + when (line = 1) | (line = 9) |, + (line = 13) | (line = 21) then do + "PIPE CMS STATE ISARCQRY ISARCHLP * | HOLE" + retcode=RC + "PIPE CMS STATE ISARCHLP XEDIT * | HOLE" + if retcode=0 then retcode=RC + if retcode ^= 0 then + message="ERROR QRY001: Help for this screen (ISARCQRY) is", + "currently not available. Please report this message", + "to the HelpDesk at 502/852-7997." + else do + address cms "XEDIT ISARCQRY ISARCHLP * (PROFILE", + "ISARCHLP NOLOCK)" + /* 09071994 ADDITION: Added code to override display of a */ + /* possible error message. */ + message="" + end + end + when (line = 3) | (line = 12) |, + (line = 15) | (line = 24) then do + DESBUF + queue "DO NOT EXECUTE" + leave loop + end + when (line = 6) | (line = 18) then do + if (error_flag ^= "THERE ARE ERRORS") then do + select + when submit_confirmation_flag = "NONE" then do + submit_confirmation_flag="READY" + message="If the above information is correct, press", + "the PF6 key again to submit your request." + call display_message + end + when submit_confirmation_flag = "READY" then do + call perform_execution + if exec_flag = "Done" then leave loop + end + otherwise nop + end + end + end + otherwise message = "You have pressed an invalid PF key. Valid", + "PF keys are shown below." + end + end +end +return + +/**********************************************************/ +/* This routine will queue all return data items if there */ +/* are no input errors preventing request submission. */ +/**********************************************************/ +perform_execution: +exec_flag = "Not Done" +if (error_flag == "THERE ARE ERRORS") then correct_before_exec = 1 +else do + queue "EXECUTE" + queue SSN + exec_flag = "Done" +end +return + +/******************************************************************/ +/* This routine will perform error checks on all screen input */ +/* data and make sure that it is valid before request submission. */ +/******************************************************************/ +process_errors: +error_flag = "THERE ARE NO ERRORS" +message="" + +/* If the SSN is not of numeric type, then pinpoint exactly where */ +/* the SSN is not numeric, and relay that to the customer by */ +/* positioning the cursor at the point of error. */ +if datatype(SSN) ^= "NUM" then do + do index=length(SSN) to 1 by -1 + if datatype(substr(SSN,index,1)) ^= "NUM" then location=index + end + err_col=36 + select + when (location >= 1) & (location <= 3) then + err_col=err_col+location-1 + when (location >= 4) & (location <= 5) then + err_col=err_col+location-1+3 + when (location >= 6) & (location <= 9) then + err_col=err_col+location-1+6 + otherwise nop + end + err_line = 12 + message = "Your Social Security Number must be numeric." +end + +/* If the SSN is not exactly 9 digits in length, then */ +/* position the cursor after the last digit for the customer. */ +if length(SSN) ^= 9 then do + SSNlength=length(SSN) + err_col=36 + select + when (SSNlength >= 1) & (SSNlength <= 2) then + err_col=err_col+SSNlength + when (SSNlength >= 3) & (SSNlength <= 4) then + err_col=err_col+SSNlength+3 + when (SSNlength >= 5) & (SSNlength <= 8) then + err_col=err_col+SSNlength+6 + otherwise nop + end + err_line = 12 + message = "Your Social Security Number must be 9 digits in length." +end + +if (SSN = "") then do + err_line = 12 + err_col = 36 + message = "Your Social Security Number is required." +end + +if message ^= "" then + error_flag = "THERE ARE ERRORS" +return + +/***************************************************************/ +/* This routine takes the input data from the panel processing */ +/* routine, and removes underscores and beginning and trailing */ +/* blanks. The data is then assigned to the appropriate */ +/* internal variable based on the source line number and source*/ +/* column number. */ +/***************************************************************/ +process_fields: +error_flag = "NO ERRORS" +text=strip(text,trailing,"_") +text=strip(text) +select + when (line = 12) & (col = 36) then SSN_1=text + when (line = 12) & (col = 42) then SSN_2=text + when (line = 12) & (col = 47) then SSN_3=text + otherwise nop +end + +/* Form the SSN by concatenating all 3 SSN input fields. */ +SSN=SSN_1||SSN_2||SSN_3 + +return + +/**********************************************************************/ +/* Set up the XEDIT screen for an input panel. Un-RESERVE all lines, */ +/* default all PF keys, enable/disable certain XEDIT features to make */ +/* the screen conducive to an input panel. */ +/**********************************************************************/ +prepare_full_screen_environment: +address xedit "SET SCALE OFF" +address xedit "SET PREFIX OFF" +address xedit "SET TOFEOF OFF" +address xedit "SET CTLCHAR % ESCAPE" +address xedit "SET CTLCHAR @ PROTECT HIGH" +address xedit "SET CTLCHAR ! PROTECT NOHIGH" +address xedit "SET CTLCHAR $ NOPROTECT HIGH" +address xedit "SET CTLCHAR ¢ NOPROTECT INVISIBLE" +address xedit "SET MSGLINE ON 21 2" +address xedit "SET CMDLINE OFF" +address xedit "SET MSGMODE ON" +address xedit "SET LINEND OFF" +address xedit "SET CASE MIXED" +address xedit "VERIFY OFF 1 80" + +do i = 1 to 24 + address xedit "SET PF"i "BEFORE EMSG ERROR QRY002: Internal failure.", + "Exit immediately and report this message to the", + " HelpDesk at 502/852-7997." +end + +address xedit "SET PF3 BEFORE QQUIT" +address xedit "SET PF12 BEFORE QQUIT" +address xedit "SET PF15 BEFORE QQUIT" +address xedit "SET PF24 BEFORE QQUIT" + +address xedit "EXTRACT /RESERVED */" +do index=1 to RESERVED.0 + parse var RESERVED.index linenum otherstuff + address xedit "SET RESERVED" linenum "OFF" +end + +return + +/*************************************************************/ +/* Initialize internal variables and default input fields to */ +/* certain values if there is a need to do so. */ +/*************************************************************/ +initialize_variables: +userid = userid() +SSN = "" +SSN_1 = "" +SSN_2 = "" +SSN_3 = "" +err_line = 12 +err_col = 36 +message = "" +error_flag="THERE ARE ERRORS" +submit_confirmation_flag="NONE" +pfkeypressed="" +enterkeypressed="" +return + +/*******************************************************************/ +/* Display the actual input screen for the customer. Accomplished */ +/* by reserving the lines via XEDIT and PROTECTing/NOPROTECTing */ +/* the appropriate areas. Also contains the message parsing code */ +/* which formats the message (up to 2 lines) for proper display. */ +/*******************************************************************/ +display_screen: + +address xedit +"SET RESERVED 1 NOH %!ISARCQRY ("level") ", + "%@University of Louisville%! ", + left(date(),11) +"SET RESERVED 2 NOH %! ", + "%@Individual Student Account%!" +"SET RESERVED 3 NOH %! ", + " %@Request Status%!" +"SET RESERVED 5 NOH %!To check the status of an account, enter your", + "Social Security Number and" +"SET RESERVED 6 NOH %!press PF6." +"SET RESERVED 12 NOH %! ", + " SSN:", +"%$"left(SSN_1,3,"_")"%!-%$"left(SSN_2,2,"_")"%!-%$"left(SSN_3,4,"_")"%!" +"SET RESERVED -1 NOH %@PF1/PF9%! Help ", + "%@PF3/PF12%! Quit", + " %@PF6%! Submit Query" +address command + +display_message: + +if message ^= "" then do + if (correct_before_exec == 1) then do + message = "UNABLE TO SUBMIT QUERY: "||message + correct_before_exec = 0 + end + + /* Now format the message for proper display */ + nextword="" + msglines.0=1 + msgindex=msglines.0 + do index=1 to 2 + msglines.index="" + end + do index=1 to words(message) + msgindex=msglines.0 + nextword=word(message,index) + /* If we can fit the next word into the line, then do so */ + if (length(msglines.msgindex)+length(nextword)) <= 78 then + if length(msglines.msgindex) = 0 then + msglines.msgindex=nextword + else + msglines.msgindex=msglines.msgindex||" "||nextword + /* Otherwise, pad the rest of the current line, */ + /* and start a new line. */ + else do + msglines.msgindex=left(msglines.msgindex,79) + msglines.0=msglines.0+1 + msgindex=msglines.0 + msglines.msgindex=nextword + end + end + msgtodisplay="" + do index=1 to msglines.0 + msgtodisplay=msgtodisplay||msglines.index + end + address xedit "EMSG" msgtodisplay + message="" +end +address xedit "CURSOR SCREEN" err_line err_col + +return \ No newline at end of file diff --git a/vmworkshop-vmarcs/1995/stumai95/isarcqst.xedit b/vmworkshop-vmarcs/1995/stumai95/isarcqst.xedit new file mode 100644 index 0000000..8e73183 --- /dev/null +++ b/vmworkshop-vmarcs/1995/stumai95/isarcqst.xedit @@ -0,0 +1,381 @@ +/*********************************************************************/ +/* */ +/* ISARCQST XEDIT */ +/* */ +/* Usage: ISARCQST is an XEDIT-based interactive viewing screen */ +/* designed to be invoked from the ISARC EXEC. */ +/* */ +/* ISARCQST is an interactive viewing screen which allows the */ +/* customer to view the status of their account request after a */ +/* search is performed on the MESSAGE MASTER file generated by the */ +/* VMSERV01 service machine. */ +/* */ +/* Exit Code Definitions: */ +/* Exit Codes are not used. */ +/* */ +/* Required Files: */ +/* ISARC EXEC (Calling program) */ +/* MESSAGE TABLE (Plain text file with mechanism messages) */ +/* MESSAGE MASTER (Plain text file with overnight create status)*/ +/* */ +/* Mod Date Init Description */ +/* -------- ---- ------------------------------------------------- */ +/* 07181994 PDL Initial Development */ +/* 07251994 PDL Added code to obtain actual userid of the customer*/ +/* from the VMSERV01 service machine. Needed to */ +/* properly display some of the status messages. */ +/* 07261994 PDL Revised date recognition code (searching for most */ +/* recent messages). Code will now be good up until */ +/* 01/01/2094. */ +/* 07291994 PDL Program/modules names changed. */ +/* 07291994 PDL Changed userid display to mod/level display. */ +/* 07291994 PDL Changed/Expanded screen title to 2 lines. */ +/* 07291994 PDL Replaced entire messaging system and modified */ +/* component-defined messages to conform. */ +/* 08011994 PDL Various message text changes. */ +/* 08051994 PDL Added fix to message display utility. The message*/ +/* area was not properly cleared before displaying */ +/* another subsequent message. */ +/* 08091994 PDL Added fix to code around problems experienced */ +/* with reading the MESSAGE MASTER file. Code will */ +/* now read the file without use of parsing to */ +/* extract the data. Code will now be column */ +/* dependent. */ +/* 09091994 PDL Changed wording of the message displayed when */ +/* no status is available for a given SSN. */ +/* */ +/*********************************************************************/ + +trace off + +level="110" +message="" +status_code="" + +/* Obtain the SSN that we are to search for in the status file. */ +parse pull SSN + +current_date=date("STANDARD") +current_year=substr(current_date,1,4) +current_month=substr(current_date,5,2) +if (current_year >= 2093) & (current_month >= 08) then do + say "WARNING: Date recognition/determination code is either", + "out-of-date or will" + say "soon be out-of-date. This code will reach this state", + "at 12:00:00 AM," + say "January 1, 2094. Please warn support personnel of this", + "message and report" + say "it to the HelpDesk at 502/852-7997." + say "" + say "Press ENTER to continue..." + parse pull waiting +end + +/* Set up the XEDIT environment in a way conducive to */ +/* viewing a message in a very restricted manner. */ +address xedit + +"SET SCALE OFF" +"SET PREFIX OFF" +"SET TOFEOF OFF" +"SET CTLCHAR % ESCAPE" +"SET CTLCHAR @ PROTECT HIGH" +"SET CTLCHAR ! PROTECT NOHIGH" +"SET CTLCHAR $ NOPROTECT HIGH" +"SET CTLCHAR ¢ NOPROTECT NOHIGH" +"SET MSGLINE ON 21 2" +"SET CMDLINE OFF" +"SET MSGMODE ON" +"SET LINEND OFF" +"SET CASE MIXED" +"VERIFY OFF 10 80" + +/* "un-RESERVE" all of the XEDIT lines */ +/* that were reserved, if any. */ +"EXTRACT /RESERVED */" +do index=1 to RESERVED.0 + parse var RESERVED.index linenum otherstuff + "SET RESERVED" linenum "OFF" +end + +/* Default all of the PF keys */ +do index=1 to 24 + "SET PF"index "BEFORE EMSG You have pressed an invalid PF key. ", + "Valid PF keys are shown below." +end + +"SET RESERVED 1 NOH %!ISARCQST ("level") ", + "%@University of Louisville%! ", + left(date(),11) +"SET RESERVED 2 NOH %! ", + "%@Individual Student Account%!" +"SET RESERVED 3 NOH %! ", + " %@Request Status%!" +"SET RESERVED 4 N %@------------------------------------- *", + "--------------------------------------- " +"SET RESERVED 5 N" +"SET RESERVED -3 N" +"SET RESERVED -2 N %@------------------------------------- *", + "--------------------------------------- " + +"CURSOR SCREEN 1 80" + +"SET PF3 BEFORE QQUIT" +"SET PF12 BEFORE QQUIT" +"SET PF15 BEFORE QQUIT" +"SET PF24 BEFORE QQUIT" + +address command + +message.0=1 +message.1="Please wait...the status of your request is being", + "looked up..." +call display_message + +address xedit "REFRESH" + +/* CODE REPLACED PER 08091994 MODIFICATION +"PIPE < MESSAGE MASTER * |", /* Read in the account status file */ +" LOCATE /"SSN"/ |", /* Find messages relevant to the SSN */ +" STEM STAT_MSG. " /* Dump the messages to the stem */ +*/ + +"PIPE < MESSAGE MASTER * |", /* Read in the account status file */ +" LOCATE 1.9 /"SSN"/ |", /* Find messages relevant to the SSN */ +" STEM STAT_MSG. " /* Dump the messages to the stem */ + +/* CODE ADDED TO HANDLE PARSING PROBLEMS - 08091994 MODIFICATION */ +/* Extract the data items needed and put them back together in */ +/* proper parsing format so the rest of the code will work. */ +do change_index = 1 to stat_msg.0 + change_ssn=substr(stat_msg.change_index,1,9) + change_ladate=substr(stat_msg.change_index,11,6) + change_code=substr(stat_msg.change_index,18,2) + stat_msg.change_index=change_ssn||" "||change_ladate||" "||change_code +end + +if stat_msg.0 = 0 then do + message.0=5 + message.1="No status is available for the Social Security Number entered." + message.2="" + message.3="If you have requested an account, please remember there" + message.4="is a turnaround period. Your account will be ready for" + message.5="use after 8 A.M. tomorrow." + status_code="NO MESSAGES" +end + +/* The last action date recognition code below will function properly */ +/* until the year 2094. At the year of 2093 this code will need */ +/* updated, or the code in another process will need updated to supply*/ +/* the full date (yyyymmdd) to this process. This process assumes we */ +/* are receiving a date in the format of yymmdd. */ +if status_code = "" then do + /* First, find out what the latest action date for the SSN is */ + latest_date="00000000" + do index=1 to stat_msg.0 + parse var stat_msg.index . nextdate . + change_year_info=substr(nextdate,1,2) + if (change_year_info >= 94) & (change_year_info <= 99) then + change_year_info="19"||change_year_info + else + change_year_info="20"||change_year_info + nextdate=change_year_info||substr(nextdate,3,4) + if nextdate > latest_date then latest_date=nextdate + end + /* Now let's determine the message numbers to post for the */ + /* latest action date and SSN specified above. */ + postindex=1 + do index=1 to stat_msg.0 + parse var stat_msg.index . nextdate messageno . + if (substr(latest_date,3,6)) = nextdate then do + messages_to_post.postindex=messageno + postindex=postindex+1 + end + end + messages_to_post.0=postindex-1 + message="" + + /* Before we start retrieving messages from the message table, let */ + /* us go ahead and obtain the userid for the SSN given. The userid*/ + /* may be needed for substitution purposes in the message(s). */ + call ask_server_for_id + /* Was the server able to give us the userid? If not, we need to */ + /* replace certain message codes with others that do not contain */ + /* references to the substitution word $ACCTID$. At this time, and*/ + /* if this is the case,... */ + /* Message 62 would be replaced with Message 64 */ + /* Message 63 would be replaced with Message 65 */ + if (cant_get_id="TRUE") then call force_message_replacement + + message_index=1 + do index=1 to messages_to_post.0 + return_code=messages_to_post.index + call retrieve_message_from_table + end + message.0=message_index - 1 +end + +call display_message + +address xedit "SET RESERVED -1 N %! ", + "%@PF3/PF12%! Quit" + +exit + +display_message: + +if message.0 ^= 0 then do + /* How many messages need to be displayed? If it is more than */ + /* what we can, display what we can and also report a problem. */ + if (message.0 > 14) then do + message.0=14 + address xedit "EMSG ERROR QST001: Message display overflow, Module", + "ISARCQST. Please report this message to the", + "HelpDesk at 502/852-7997." + end + + /* Now determine the largest length we have in this group of msgs...*/ + largest_length=0 + do find_largest = 1 to (message.0) + if length(message.find_largest) > largest_length then + largest_length=length(message.find_largest) + end + if (largest_length > 78) then do + do trunc_index = 1 to message.0 + if (length(message.trunc_index) > 78) then + message.trunc_index=left(message.trunc_index,78) + end + address xedit "EMSG ERROR QST002: Message display overflow, Module", + "ISARCQST. Please report this message to the", + "HelpDesk at 502/852-7997." + end + + /* Now determine how much padding we will need */ + /* on the left to center the body of messages. */ + left_padding="" + if largest_length < 78 then + left_padding=left(left("",78),((78-largest_length)%2)) + + /* Now pad the messages, if necessary... */ + if length(left_padding) ^= 0 then do + do pad_index=1 to (message.0) + message.pad_index = left_padding||message.pad_index + end + end + + /* Clear the message area... */ + address xedit "EXTRACT /RESERVED */" + do display_index = 1 to RESERVED.0 + parse var RESERVED.display_index linenum otherstuff + if (linenum >= 6) & (linenum <= 19) then + address xedit "SET RESERVED" linenum "OFF" + end + + /* Finally display the messages... */ + do display_index = 6 to (6 + message.0 - 1) + message_ref_no=display_index-6+1 + address xedit "SET RESERVED" display_index "NOH", + "%!"message.message_ref_no"%!" + end + + address xedit "REFRESH" + + address xedit "SOS ALARM" + + /* Last but not least, clear out our message variables...*/ + do clear_messages = 1 to (message.0) + message.clear_messages="" + end + message.0=0 +end + +return + +retrieve_message_from_table: + +trans_date=substr(latest_date,3,2)||"-"||substr(latest_date,5,2)||, + "-"||substr(latest_date,7,2) + +/* Read in the message file, and locate the messages to display */ +"PIPE < MESSAGE TABLE * |", /* Read in the message file */ +" LOCATE 1-9 /"return_code"/ |", /* Locate the needed messages */ +" CHANGE /$LADATE$/"trans_date"/ |", /* Change ladate to last actn */ +" CHANGE /$ACCTID$/"actual_id"/ |", /* Change acctid to real id */ +" STACK FIFO " /* Stack the message lines */ + +do indexm=1 to queued() + parse pull . message_line + message_line=strip(message_line) + message.message_index=message_line + message_index=message_index + 1 +end + +return + +ask_server_for_id: + +cant_get_id="FALSE" +actual_id="" +number_of_attempts=1 + +do loop=1 + + "PIPE CP SMSG VMSERV01 REQID" SSN "| HOLE" + if RC ^= 0 then do + cant_get_id="TRUE" + leave loop + end + "WAKEUP +00:00:20 ( QUIET SMSG" + select + when RC=2 then do + number_of_attempts=number_of_attempts+1 + if number_of_attempts <> 4 then do + message.0=2 + message.1="The system is responding slowly at this time. Your" + message.2="request is being re-submitted. Please wait..." + call display_message + end + else do + cant_get_id="TRUE" + leave loop + end + end + when RC=1 then do + response="" + parse pull flag transmit_id response_type response . + response=strip(response) + if flag ^= "*SMSG" then try_again=1 + if transmit_id ^= "VMSERV01" then try_again=1 + if response_type ^= "REQID" then try_again=1 + if try_again ^= 1 then do + if response="" then do + cant_get_id="TRUE" + actual_id="" + end + else do + actual_id=response + cant_get_id="FALSE" + end + leave loop + end + end + otherwise nop + end +end + +return + +force_message_replacement: + +do replace_index = 1 to messages_to_post.0 + select + when (messages_to_post.replace_index = "62") then + messages_to_post.replace_index="64" + when (messages_to_post.replace_index = "63") then + messages_to_post.replace_index="65" + otherwise nop + end + +end + +return \ No newline at end of file diff --git a/vmworkshop-vmarcs/1995/stumai95/isarcreq.isarchlp b/vmworkshop-vmarcs/1995/stumai95/isarcreq.isarchlp new file mode 100644 index 0000000..208f96b --- /dev/null +++ b/vmworkshop-vmarcs/1995/stumai95/isarcreq.isarchlp @@ -0,0 +1,26 @@ + Request an Individual Student Account Help Screen + ================================================== + + ********************************************************************* + **** You must be a registered UofL student to request an account **** + ********************************************************************* + + Enter the following pieces of information and press PF6 to submit + your request. The next screen to be displayed will tell you the + userid of your account. WRITE IT DOWN. + + Name: + **** Enter your full name in upper and lower case. If you do not + have a middle initial, enter 0 (zero). Or if you leave the + middle initial field blank, 0 (zero) will be used. + + Social Security Number: + **** Enter your nine digit social security number. If you do not + have a social security number, enter the nine digit student + number that was assigned to you. + + Once you have requested your account, do not change your TouchTone + Registration PIN until after you have successfully logged onto + your account the first time. + + -------------------------END OF FILE----------------------------------- \ No newline at end of file diff --git a/vmworkshop-vmarcs/1995/stumai95/isarcreq.xedit b/vmworkshop-vmarcs/1995/stumai95/isarcreq.xedit new file mode 100644 index 0000000..f628af4 --- /dev/null +++ b/vmworkshop-vmarcs/1995/stumai95/isarcreq.xedit @@ -0,0 +1,601 @@ +/*********************************************************************/ +/* */ +/* ISARCREQ XEDIT */ +/* */ +/* Usage: ISARCREQ is an XEDIT-based interactive input panel */ +/* designed to be invoked from the ISARC EXEC. */ +/* */ +/* ISARCREQ is an interactive input panel which asks the customer */ +/* for required information (Name, SSN, Touch-Tone PIN), and returns */ +/* this information to the ISARC EXEC for submission to the */ +/* VMSERV01 service machine. */ +/* */ +/* Exit Code Definitions: */ +/* Exit Codes are not used. Results returned via the program */ +/* stack: */ +/* o Literal text "EXECUTE" returned if STUDREQ is to submit */ +/* the account request. Other information passed includes */ +/* the first name, middle initial, last name, SSN, and the */ +/* Touch-Tone PIN. */ +/* */ +/* o Literal text "DO NOT EXECUTE" returned if STUDREQ is not */ +/* to submit the account request. */ +/* */ +/* Required Files: */ +/* ISARC EXEC (Calling program) */ +/* ISARCREQ ISARCHLP (Help for the account request input panel) */ +/* */ +/* Mod Date Init Description */ +/* -------- ---- ------------------------------------------------- */ +/* 07181994 PDL Initial Development */ +/* 07251994 PDL Revised entry check code for middle initials. */ +/* 07291994 PDL Program/modules names changed. */ +/* 07291994 PDL Changed to new help display method. */ +/* 07291994 PDL Changed PF1 key wording to "Help". */ +/* 07291994 PDL Changed userid display to mod/level display. */ +/* 07291994 PDL Modified middle initial field check code to */ +/* accept only alphabetic or zero. */ +/* 07291994 PDL Modified last name field check code to accept */ +/* only alphabetic, hyphen, or apostrophe. */ +/* 07291994 PDL Modified first name field check code to accept */ +/* only alphabetic, apostrophe, or hyphen. */ +/* 07291994 PDL Disabled code which automatically uppercases */ +/* the first letter of the first name, the middle */ +/* initial, and the first letter of the last name. */ +/* 07291994 PDL Modified middle initial field check code. */ +/* 08011994 PDL Modified code to request confirmation of data */ +/* prior to actual request submission. */ +/* 08011994 PDL Various message text changes. */ +/* 08041994 PDL Added code to detect presence of ISARCHLP module */ +/* prior to display of help. */ +/* 09071994 PDL Added code to override display of a possible error*/ +/* message when help (PF1, etc.) is requested. */ +/* 01051995 DAK Commented out code for Touch Tone PIN, removing */ +/* it from the request screen. The TT_PIN variable */ +/* is set to XXXXXX as a dummy value. */ +/* */ +/*********************************************************************/ + +trace off + +level="115" + +/* Make sure we have no extraneous information on the stack. */ +"DESBUF" + +/* Main part of ISARCREQ. Call routines from here and exit out. */ +address command +call prepare_full_screen_environment +call initialize_variables +call process_input +address xedit "QQUIT" +exit + +/****************************************************************/ +/* Input panel processing routine. This routine issues a XEDIT */ +/* screen READ and parses that information. */ +/****************************************************************/ +process_input: +/* We do not actually need to specify that we loop, but */ +/* this will give the loop a name in case we must LEAVE it.*/ +do loop = 1 + /* First, let us display the screen */ + call display_screen + address xedit "READ NOCHANGE NUMBER TAG" + /* Now let us process the information returned from the XEDIT READ */ + pfkeypressed="" + enterkeypressed="" + do queued() + parse pull key line col text + /* Prevent escapes from being acted upon */ + text=translate(text," ","%") + /* In this part, we will preserve any PF keypresses for later, */ + /* so that data for the fields can be processed beforehand. */ + select + when key = "PFK" then pfkeypressed=line + when key = "RES" then do + call process_fields + submit_confirmation_flag="NONE" + end + when key = "ETK" then enterkeypressed="YES" + otherwise nop + end + end + + /* Check to see if there are any errors before we get to the */ + /* PF key processing and ENTER key processing. */ + call process_errors + + /* Process the Enter key, if pressed. */ + if (enterkeypressed ^= "") &, + (error_flag ^= "THERE ARE ERRORS") then do + enterkeypressed="" + select + when submit_confirmation_flag = "NONE" then do + submit_confirmation_flag="READY" + message="If the above information is correct, press", + "the PF6 key to submit your request." + call display_message + end + when submit_confirmation_flag = "READY" then do + message="You must press the PF6 key to submit your request." + call display_message + end + otherwise nop + end + end + + /* Now let us process PF keypresses... */ + if pfkeypressed ^= "" then do + line=pfkeypressed + pfkeypressed="" + select + when (line = 1) | (line = 9) |, + (line = 13) | (line = 21) then do + "PIPE CMS STATE ISARCREQ ISARCHLP * | HOLE" + retcode=RC + "PIPE CMS STATE ISARCHLP XEDIT * | HOLE" + if retcode=0 then retcode=RC + if retcode ^= 0 then + message="ERROR REQ001: Help for this screen (ISARCREQ) is", + "currently not available. Please report this message", + "to the HelpDesk at 502/852-7997." + else do + address cms "XEDIT ISARCREQ ISARCHLP * (PROFILE", + "ISARCHLP NOLOCK)" + /* 09071994 ADDITION: Added code to override display of a */ + /* possible error message. */ + message="" + end + end + when (line = 3) | (line = 12) |, + (line = 15) | (line = 24) then do + "DESBUF" + queue "DO NOT EXECUTE" + leave loop + end + when (line = 6) | (line = 18) then do + if (error_flag ^= "THERE ARE ERRORS") then do + select + when submit_confirmation_flag = "NONE" then do + submit_confirmation_flag="READY" + message="If the above information is correct, press", + "the PF6 key again to submit your request." + call display_message + end + when submit_confirmation_flag = "READY" then do + call perform_execution + if exec_flag = "Done" then leave loop + end + otherwise nop + end + end + end + otherwise message = "You have pressed an invalid PF key. Valid", + "PF keys are shown below." + end + end +end +return + +/**********************************************************/ +/* This routine will queue all return data items if there */ +/* are no input errors preventing request submission. */ +/**********************************************************/ +perform_execution: +exec_flag = "Not Done" +if (error_flag == "THERE ARE ERRORS") then correct_before_exec = 1 +else do + queue "EXECUTE" + queue First_Name + if Middle_Init = "" then queue "0" + else queue Middle_Init + queue Last_Name + queue SSN + queue TT_PIN + exec_flag="Done" +end +return + +/******************************************************************/ +/* This routine will perform error checks on all screen input */ +/* data and make sure that it is valid before request submission. */ +/******************************************************************/ +process_errors: +error_flag = "THERE ARE NO ERRORS" +message="" + +/******************************************************************/ +/* */ +/*if (TT_PIN_Verify ^= TT_PIN) then do */ +/* err_line=16 */ +/* err_col=44 */ +/* message = "Your Touch-Tone Registration PIN entries do not match.", */ +/* "Re-enter your PIN number twice." */ +/*end */ +/* */ +/*if datatype(TT_PIN_Verify) ^= "NUM" then do */ +/* err_line = 17 */ +/* err_col = 44 */ +/* message = "Your PIN verification must be numeric." */ +/*end */ +/* */ +/*if length(TT_PIN_Verify) ^= 6 then do */ +/* err_line = 17 */ +/* err_col = 44 */ +/* message = "Your PIN verification must be 6 digits in length." */ +/*end */ +/* */ +/*if TT_PIN_Verify = "" then do */ +/* err_line = 17 */ +/* err_col = 44 */ +/* message = "Please verify your Touch-Tone Registration PIN by entering */ +/* "it again." */ +/*end */ +/* */ +/*if datatype(TT_PIN) ^= "NUM" then do */ +/* err_line = 16 */ +/* err_col = 44 */ +/* message = "Your Touch-Tone Registration PIN must be numeric." */ +/*end */ +/* */ +/*if length(TT_PIN) ^= 6 then do */ +/* err_line = 16 */ +/* err_col = 44 */ +/* message = "Your Touch-Tone Registration PIN must be", */ +/* "6 digits in length." */ +/*end */ +/* */ +/*if TT_PIN = "" then do */ +/* err_line = 16 */ +/* err_col = 44 */ +/* message = "Your Touch-Tone Registration PIN is required." */ +/*end */ +/* */ +/******************************************************************/ + +/* If the SSN is not of numeric type, then pinpoint exactly where */ +/* the SSN is not numeric, and relay that to the customer by */ +/* positioning the cursor at the point of error. */ +if datatype(SSN) ^= "NUM" then do + do index=length(SSN) to 1 by -1 + if datatype(substr(SSN,index,1)) ^= "NUM" then location=index + end + err_col=42 + select + when (location >= 1) & (location <= 3) then + err_col=err_col+location-1 + when (location >= 4) & (location <= 5) then + err_col=err_col+location-1+3 + when (location >= 6) & (location <= 9) then + err_col=err_col+location-1+6 + otherwise nop + end + err_line = 14 + message = "Your Social Security Number must be numeric." +end + +/* If the SSN is not exactly 9 digits in length, then */ +/* position the cursor after the last digit for the customer. */ +if length(SSN) ^= 9 then do + SSNlength=length(SSN) + err_col=42 + select + when (SSNlength >= 1) & (SSNlength <= 2) then + err_col=err_col+SSNlength + when (SSNlength >= 3) & (SSNlength <= 4) then + err_col=err_col+SSNlength+3 + when (SSNlength >= 5) & (SSNlength <= 8) then + err_col=err_col+SSNlength+6 + otherwise nop + end + err_line = 14 + message = "Your Social Security Number must be 9 digits in length." +end + +if (SSN = "") then do + err_line = 14 + err_col = 42 + message = "Your Social Security Number is required." +end + +if Last_Name = "" then do + err_line = 12 + err_col = 42 + message = "Your last name is required." +end + +if Last_Name ^= "" then do + bad_char = 0 + do lastnameindex = 1 to length(Last_Name) + next_char=substr(Last_Name,lastnameindex,1) + if (next_char ^= "'") & (next_char ^= "-") &, + (datatype(next_char,"MIXED CASE") ^= 1) then + bad_char=lastnameindex + end + if bad_char=0 then do + if (length(Last_Name) = 1) &, + ((Last_Name = "'") | (Last_Name = "-")) then do + err_line=12 + err_col=42 + message="Your last name must consist of more than a hyphen or", + "apostrophe." + end + end + else do + err_line=12 + err_col=42+bad_char-1 + message = "Your last name must contain only the alphabetic,", + "hyphen, or apostrophe characters." + end +end + +if Middle_Init = "" then do + err_line = 11 + err_col = 42 + Middle_Init="0" + message = "Your middle initial is required. If you do not have a", + "middle initial or do not supply one, then '0' will be used." +end + +if (Middle_Init ^= "") then + if (Middle_Init = "0") then nop + else if (datatype(Middle_Init,"MIXED CASE") ^= 1) then do + err_line=11 + err_col=42 + message="Your middle initial must be alphabetic or zero." + end + +if First_Name = "" then do + err_line = 10 + err_col = 42 + message = "Your first name is required." +end + +if First_Name ^= "" then do + bad_char = 0 + do firstnameindex = 1 to length(First_Name) + next_char=substr(First_Name,firstnameindex,1) + if (next_char ^= "'") & (next_char ^= "-") &, + (datatype(next_char,"MIXED CASE") ^= 1) then + bad_char=firstnameindex + end + if bad_char=0 then do + if (length(First_Name) = 1) &, + ((First_Name = "'") | (First_Name = "-")) then do + err_line=10 + err_col=42 + message="Your first name must consist of more than a hyphen or", + "apostrophe." + end + end + else do + err_line=10 + err_col=42+bad_char-1 + message = "Your first name must contain only the alphabetic,", + "hyphen, or apostrophe characters." + end +end + +if (Last_Name = "") & (First_Name = "") & (Middle_Init = "0") &, + (SSN_1 = "") & (SSN_2 = "") & (SSN_3 = "") then do +/***************************************************************/ +/* (TT_PIN = "") & (TT_PIN_Verify = "") then do */ +/***************************************************************/ + err_line=10 + err_col=42 + Middle_Init="" + message = "The above information must be supplied to request an", + "account." +end + +if (message ^= "") then + error_flag = "THERE ARE ERRORS" + +return + +/***************************************************************/ +/* This routine takes the input data from the panel processing */ +/* routine, and removes underscores and beginning and trailing */ +/* blanks. The data is then assigned to the appropriate */ +/* internal variable based on the source line number and source*/ +/* column number. */ +/***************************************************************/ +process_fields: +error_flag = "NO ERRORS" +text=strip(text,trailing,"_") +text=strip(text) +select + when (line = 10) then First_Name=text + when (line = 11) then Middle_Init=text + when (line = 12) then Last_Name=text + when (line = 14) & (col = 42) then SSN_1=text + when (line = 14) & (col = 48) then SSN_2=text + when (line = 14) & (col = 53) then SSN_3=text +/***************************************************************/ +/* when (line = 16) then TT_PIN=text */ +/* when (line = 17) then TT_PIN_Verify=text */ +/***************************************************************/ + otherwise nop +end + +/* CODE DISABLED PER 07291994 MODIFICATION */ +/* Upper case the first letter of the first name, if it exists. */ +/* if First_Name ^= "" then do */ +/* temp=translate(left(First_Name,1)) */ +/* First_Name=temp||right(First_Name,length(First_Name)-1) */ +/* end */ + +/* CODE DISABLED PER 07291994 MODIFICATION */ +/* Upper case the middle initial, if it exists. */ +/* if Middle_Init ^= "" then Middle_Init=translate(left(Middle_Init,1))*/ + +/* CODE DISABLED PER 07291994 MODIFICATION */ +/* Upper case the first letter of the last name, if it exists. */ +/* if Last_Name ^= "" then do */ +/* temp=translate(left(Last_Name,1)) */ +/* Last_Name=temp||right(Last_Name,length(Last_Name)-1) */ +/* end */ + +/* Form the SSN by concatenating all 3 SSN input fields. */ +SSN=SSN_1||SSN_2||SSN_3 + +return + +/**********************************************************************/ +/* Set up the XEDIT screen for an input panel. Un-RESERVE all lines, */ +/* default all PF keys, enable/disable certain XEDIT features to make */ +/* the screen conducive to an input panel. */ +/**********************************************************************/ +prepare_full_screen_environment: +address xedit "SET SCALE OFF" +address xedit "SET PREFIX OFF" +address xedit "SET TOFEOF OFF" +address xedit "SET CTLCHAR % ESCAPE" +address xedit "SET CTLCHAR @ PROTECT HIGH" +address xedit "SET CTLCHAR ! PROTECT NOHIGH" +address xedit "SET CTLCHAR $ NOPROTECT HIGH" +address xedit "SET CTLCHAR ¢ NOPROTECT INVISIBLE" +address xedit "SET MSGLINE ON 21 2" +address xedit "SET CMDLINE OFF" +address xedit "SET MSGMODE ON" +address xedit "SET LINEND OFF" +address xedit "SET CASE MIXED" +address xedit "VERIFY OFF 1 80" + +do i = 1 to 24 + address xedit "SET PF"i "BEFORE EMSG REQ002: Internal failure. Exit", + "immediately and report this message to the ", + "HelpDesk at 502/852-7997." +end + +address xedit "SET PF3 BEFORE QQUIT" +address xedit "SET PF12 BEFORE QQUIT" +address xedit "SET PF15 BEFORE QQUIT" +address xedit "SET PF24 BEFORE QQUIT" + +address xedit "EXTRACT /RESERVED */" +do index=1 to RESERVED.0 + parse var RESERVED.index linenum otherstuff + address xedit "SET RESERVED" linenum "OFF" +end + +return + +/*************************************************************/ +/* Initialize internal variables and default input fields to */ +/* certain values if there is a need to do so. */ +/*************************************************************/ +initialize_variables: +userid = userid() +Last_Name = "" +First_Name = "" +Middle_Init = "" +SSN = "" +SSN_1 = "" +SSN_2 = "" +SSN_3 = "" +TT_PIN="XXXXXX" +/*******************************************************************/ +/*TT_PIN_Verify="" */ +/*******************************************************************/ +Choice = "" +err_line = 10 +err_col = 42 +message = "" +error_flag="THERE ARE ERRORS" +submit_confirmation_flag="NONE" +pfkeypressed="" +enterkeypressed="" +return + +/*******************************************************************/ +/* Display the actual input screen for the customer. Accomplished */ +/* by reserving the lines via XEDIT and PROTECTing/NOPROTECTing */ +/* the appropriate areas. Also contains the message parsing code */ +/* which formats the message (up to 2 lines) for proper display. */ +/*******************************************************************/ +display_screen: + +address xedit +"SET RESERVED 1 NOH %!ISARCREQ ("level") ", + "%@University of Louisville%! ", + left(date(),11) +"SET RESERVED 2 NOH %! ", + "%@Individual Student Account Request%!" +"SET RESERVED 4 NOH %! ************************************************************************** " +"SET RESERVED 5 NOH %! **************************************************************************** " +"SET RESERVED 6 NOH %!***** %@YOU MUST BE A REGISTERED STUDENT TO REQUEST AN ACCOUNT.%! ***** " +"SET RESERVED 7 NOH %! **************************************************************************** " +"SET RESERVED 8 NOH %! ************************************************************************** " +"SET RESERVED 10 NOH %! ", + " First Name:", + "%$"left(First_Name,15,"_")"%!" +"SET RESERVED 11 NOH %! ", + " Middle Initial:", + "%$"left(Middle_Init,1,"_")"%!" +"SET RESERVED 12 NOH %! ", + " Last Name:", + "%$"left(Last_Name,15,"_")"%!" +"SET RESERVED 14 NOH %! ", + " SSN:", +"%$"left(SSN_1,3,"_")"%!-%$"left(SSN_2,2,"_")"%!-%$"left(SSN_3,4,"_")"%!" +/*******************************************************************/ +/*"SET RESERVED 16 NOH %! Touch-Tone", */ +/* "Registration PIN: ", */ +/* "{%¢"left(TT_PIN,6,"_")"%!}" */ +/*"SET RESERVED 17 NOH %! Please", */ +/* "re-type your PIN: ", */ +/* "{%¢"left(TT_PIN_Verify,6,"_")"%!}" */ +/*"SET RESERVED 19 NOH %@ ", */ +/* "(PIN entries will not be displayed for security" */ +/* "purposes.)" */ +/*******************************************************************/ +"SET RESERVED -1 NOH %@PF1/PF9%! Help ", + "%@PF3/PF12%! Quit", + " %@PF6%! Submit Request" +address command + +display_message: + +if message ^= "" then do + if (correct_before_exec == 1) then do + message = "UNABLE TO SUBMIT REQUEST: "||message + correct_before_exec = 0 + end + + /* Now format the message for proper display */ + nextword="" + msglines.0=1 + msgindex=msglines.0 + do index=1 to 2 + msglines.index="" + end + do index=1 to words(message) + msgindex=msglines.0 + nextword=word(message,index) + /* If we can fit the next word into the line, then do so */ + if (length(msglines.msgindex)+length(nextword)) <= 78 then + if length(msglines.msgindex) = 0 then + msglines.msgindex=nextword + else + msglines.msgindex=msglines.msgindex||" "||nextword + /* Otherwise, pad the rest of the current line, */ + /* and start a new line. */ + else do + msglines.msgindex=left(msglines.msgindex,79) + msglines.0=msglines.0+1 + msgindex=msglines.0 + msglines.msgindex=nextword + end + end + msgtodisplay="" + do index=1 to msglines.0 + msgtodisplay=msgtodisplay||msglines.index + end + address xedit "EMSG" msgtodisplay + message="" +end +address xedit "CURSOR SCREEN" err_line err_col + +return \ No newline at end of file diff --git a/vmworkshop-vmarcs/1995/stumai95/isarcrst.xedit b/vmworkshop-vmarcs/1995/stumai95/isarcrst.xedit new file mode 100644 index 0000000..168d362 --- /dev/null +++ b/vmworkshop-vmarcs/1995/stumai95/isarcrst.xedit @@ -0,0 +1,302 @@ +/*********************************************************************/ +/* */ +/* ISARCRST XEDIT */ +/* */ +/* Usage: ISARCRST is an XEDIT-based interactive viewing screen */ +/* designed to be invoked from the ISARC EXEC. */ +/* */ +/* ISARCRST is an interactive viewing screen which allows the */ +/* customer to view a basic "please wait" type of message while */ +/* awaiting a response from the VMSERV01 service machine (after a */ +/* account has been submitted). */ +/* */ +/* Exit Code Definitions: */ +/* Exit Codes are not used. */ +/* */ +/* Required Files: */ +/* ISARC EXEC (Calling program) */ +/* MESSAGE TABLE (Plain text with mechanism messages) */ +/* */ +/* Mod Date Init Description */ +/* -------- ---- ------------------------------------------------- */ +/* 07181994 PDL Initial Development */ +/* 07291994 PDL Program/modules names changed. */ +/* 07291994 PDL Changed title of screen to "Individual Student */ +/* Account Request". */ +/* 07291994 PDL Changed userid display to module name and level */ +/* display. */ +/* 07291994 PDL Replaced entire messaging system and modified */ +/* component-defined messages to conform. */ +/* 08011994 PDL Various message text changes. */ +/* 08051994 PDL Added fix for message display utility. The */ +/* message area was not properly cleared before */ +/* display of another message. */ +/* */ +/*********************************************************************/ + +trace off + +level="106" + +/* Obtain the record that we are to submit to the service machine. */ +parse pull record_to_submit + +/* Set up the XEDIT environment in a way conducive to */ +/* viewing a message in a very restricted manner. */ +address xedit + +"SET SCALE OFF" +"SET PREFIX OFF" +"SET TOFEOF OFF" +"SET CTLCHAR % ESCAPE" +"SET CTLCHAR @ PROTECT HIGH" +"SET CTLCHAR ! PROTECT NOHIGH" +"SET CTLCHAR $ NOPROTECT HIGH" +"SET CTLCHAR ¢ NOPROTECT NOHIGH" +"SET MSGLINE ON 21 2" +"SET CMDLINE OFF" +"SET MSGMODE ON" +"SET LINEND OFF" +"SET CASE MIXED" +"VERIFY OFF 10 80" + +/* "un-RESERVE" all of the XEDIT lines */ +/* that were reserved, if any. */ +"EXTRACT /RESERVED */" +do index=1 to RESERVED.0 + parse var RESERVED.index linenum otherstuff + "SET RESERVED" linenum "OFF" +end + +/* Default all of the PF keys */ +do index=1 to 24 + "SET PF"index "BEFORE EMSG You have pressed an invalid PF key. ", + "Valid PF keys are shown below." +end + +"SET RESERVED 1 NOH %!ISARCRST ("level") ", + "%@University of Louisville%! ", + left(date(),11) +"SET RESERVED 2 NOH %! ", + "%@Individual Student Account Request%!" +"SET RESERVED 3 N %@------------------------------------- *", + "--------------------------------------- " +"SET RESERVED 4 N" +"SET RESERVED -3 N" +"SET RESERVED -2 N %@------------------------------------- *", + "--------------------------------------- " + +"CURSOR SCREEN 1 80" + +address command + +bypass_transmission=0 + +address xedit "refresh" + +/* Check to make sure that the account request service machine is up...*/ +"PIPE CP QUERY USER VMSERV01 | HOLE" +if RC ^= 0 then do + message.0=3 + message.1="ERROR RST001: The account request system is currently not" + message.2="available. Please report this message to the HelpDesk at" + message.3="502/852-7997." + call display_message + bypass_transmission=1 +end + +if bypass_transmission <> 1 then do + message.0=2 + message.1="Your account request has been submitted to the system." + message.2="Please wait for a response." + call display_message + + number_of_attempts=1 + + do loop=1 + + address xedit "REFRESH" + "PIPE CP SMSG VMSERV01" record_to_submit "| HOLE" + if RC ^= 0 then do + message.0=3 + message.1="ERROR RST002: The account request system is currently" + message.2="not accepting requests. Please report this message" + message.3="to the HelpDesk at 502/852-7997." + call display_message + leave loop + end + "WAKEUP +00:00:20 ( QUIET SMSG" + + select + when RC=2 then do + number_of_attempts=number_of_attempts+1 + if number_of_attempts <> 4 then do + message.0=2 + message.1="The system is responding slowly at this time. Your" + message.2="request is being re-submitted. Please wait..." + call display_message + end + else do + message.0=3 + message.1="ERROR RST003: The system has not responded after" + message.2="several attempts. Please report this message to" + message.3="the HelpDesk at 502/852-7997." + call display_message + leave loop + end + end + when RC=1 then do + parse pull flag transmit_id response + response=strip(response) + if flag ^= "*SMSG" then try_again=1 + if transmit_id ^= "VMSERV01" then try_again=1 + if try_again ^= 1 then do + parse var response return_code off_id + select + /* Customer currently has an active account. */ + when return_code="21" then do + message_index=1 + call retrieve_message_from_table + message.0=message_index-1 + call display_message + end + /* Customer has an account on hold, but */ + /* will be re-activated. */ + when return_code="22" then do + message_index=1 + call retrieve_message_from_table + message.0=message_index-1 + call display_message + end + /* Customer does not have an account, but will have one. */ + when return_code="23" then do + message_index=1 + call retrieve_message_from_table + message.0=message_index-1 + call display_message + end + /* Customer has already requested an account today. */ + when return_code="24" then do + message_index=1 + call retrieve_message_from_table + message.0=message_index-1 + call display_message + end + otherwise + message.0=4 + message.1="ERROR RST004: The account request system has" + message.2="responded in an unexpected manner. Please report" + message.3="this problem to the HelpDesk at 502/852-7997. The" + message.4="response was" response"." + call display_message + leave loop + end + leave loop + end + end + otherwise nop + end + end +end + +address xedit + +"SET PF3 BEFORE QQUIT" +"SET PF12 BEFORE QQUIT" +"SET PF15 BEFORE QQUIT" +"SET PF24 BEFORE QQUIT" + +"SET RESERVED -1 N %! ", + "%@PF3/PF12%! Quit" + +address command + +exit + +display_message: + +if message.0 ^= 0 then do + /* How many messages need to be displayed? If it is more than */ + /* what we can, display what we can and also report a problem. */ + if (message.0 > 14) then do + message.0=14 + address xedit "EMSG RST005: Message display overflow, Module", + "ISARCRST. Please report this message ", + "to the HelpDesk at 502/852-7997." + end + + /* Now determine the largest length we have in this group of msgs...*/ + largest_length=0 + do find_largest = 1 to (message.0) + if length(message.find_largest) > largest_length then + largest_length=length(message.find_largest) + end + if (largest_length > 78) then do + do trunc_index = 1 to message.0 + if (length(message.trunc_index) > 78) then + message.trunc_index=left(message.trunc_index,78) + end + address xedit "EMSG RST006: Message display overflow, Module", + "ISARCRST. Please report this message ", + "to the HelpDesk at 502/852-7997." + end + + /* Now determine how much padding we will need */ + /* on the left to center the body of messages. */ + left_padding="" + if largest_length < 78 then + left_padding=left(left("",78),((78-largest_length)%2)) + + /* Now pad the messages, if necessary... */ + if length(left_padding) ^= 0 then do + do pad_index=1 to (message.0) + message.pad_index=left_padding||message.pad_index + end + end + + /* First clear all of the possible message lines */ + address xedit "EXTRACT /RESERVED */" + do display_index=1 to RESERVED.0 + parse var RESERVED.display_index linenum otherstuff + if (linenum >= 6) & (linenum <= 19) then + address xedit "SET RESERVED" linenum "OFF" + end + + /* Finally display the messages... */ + do display_index=6 to (6 + message.0 - 1) + message_ref_no=display_index-6+1 + address xedit "SET RESERVED" display_index "NOH", + "%!"message.message_ref_no"%!" + end + + address xedit "REFRESH" + + address xedit "SOS ALARM" + + /* Last but not least, clear out our message variables...*/ + do clear_messages = 1 to (message.0) + message.clear_messages="" + end + message.0=0 +end + +return + +retrieve_message_from_table: + +/* Read in the message file, and locate the messages to display */ +"PIPE (ENDC ?) < MESSAGE TABLE * |", /* Read in the message file */ +" LOCATE 1-9 /"return_code"/ |", /* Locate the needed messages */ +" CHANGE /$ACCTID$/"off_id"/ |", /* Change $ACCTID$ to userid */ +" STACK FIFO " /* Stack the message lines */ + +message="" +do index=1 to queued() + parse pull . message_line + message_line=strip(message_line) + message.message_index=message_line + message_index=message_index+1 +end + +return + \ No newline at end of file diff --git a/vmworkshop-vmarcs/1995/stumai95/makisarc.exec b/vmworkshop-vmarcs/1995/stumai95/makisarc.exec new file mode 100644 index 0000000..13ab164 --- /dev/null +++ b/vmworkshop-vmarcs/1995/stumai95/makisarc.exec @@ -0,0 +1,205 @@ +/* MAKISARC EXEC - Prepare ISARC for public access/execution */ +/* 09011994 PDL Modified for code move to VMSERV01 */ + +trace off + +say "Checking for memory requirements..." +"PIPE CP QUERY VIRTUAL STORAGE", +"| SPLIT AT BLANK", +"| DROP FIRST 2", +"| STRIP BOTH BLANK", +"| VAR VSAVAIL", +"| HOLE" +vsamount=left(vsavail,length(vsavail)-1) +if right(vsavail,1) = "M" then do + if vsamount < 5 then do + say "" + say "***** To make ISARC, at least 5M of virtual storage is needed." + say "" + exit + end +end +else do + if vsamount < 5120 then do + say "" + say "***** To make ISARC, at least 5120K of virtual storage", + "is needed." + say "" + exit + end +end + +say "Verifying VMSYS:VMSERV01.ISARC is at filemode C (R/W)..." +"PIPE CMS QUERY ACCESSED C | DROP FIRST | VAR fmc_definition" +parse var fmc_definition . fmc_state . . fmc_dir +if (fmc_state ^= "R/W") & (fmc_dir ^= "VMSYS:VMSERV01.ISARC") then do + say "" + say "***** Make of ISARC did not take place. Filemode C should be" + say "***** accessed as VMSYS:VMSERV01.ISARC in the R/W state." + say "" + exit +end + +say "Accessing VMSYS:VMSERV01.ISARC.PUBLIC_ACCESS at filemode D", + "(R/W)..." +"PIPE CMS ACCESS VMSYS:VMSERV01.ISARC.PUBLIC_ACCESS D (FORCERW | HOLE" +if RC ^= 0 then do + say "" + say "***** Unable to gain access to VMSYS:VMSERV01.ISARC.PUBLIC_ACCESS" + say "***** in R/W mode. Please make sure the proper authorization" + say "***** exists for access to the directory." + say "" + exit +end + +say "Code compilation begins..." +problems="FALSE" + +"REXXC ISARC EXEC C" +if (RC ^= 0) & (RC ^= 4) then do + say "" + say "***** PROBLEMS WITH COMPILATION OF ISARC (RC="RC")" + say "" + problems="TRUE" +end +else + say "ISARC compilation completed." + +"REXXC ISARCINS XEDIT C" +if (RC ^= 0) & (RC ^= 4) then do + say "" + say "***** PROBLEMS WITH COMPILATION OF ISARCINS (RC="RC")" + say "" + problems="TRUE" +end +else + say "ISARCINS compilation completed." + +"REXXC ISARCQST XEDIT C" +if (RC ^= 0) & (RC ^= 4) then do + say "" + say "***** PROBLEMS WITH COMPILATION OF ISARCQST (RC="RC")" + say "" + problems="TRUE" +end +else + say "ISARCQST compilation completed." + +"REXXC ISARCINF XEDIT C" +if (RC ^= 0) & (RC ^= 4) then do + say "" + say "***** PROBLEMS WITH COMPILATION OF ISARCINF (RC="RC")" + say "" + problems="TRUE" +end +else + say "ISARCINF compilation completed." + +"REXXC ISARCMNU XEDIT C" +if (RC ^= 0) & (RC ^= 4) then do + say "" + say "***** PROBLEMS WITH COMPILATION OF ISARCMNU (RC="RC")" + say "" + problems="TRUE" +end +else + say "ISARCMNU compilation completed." + +"REXXC ISARCQRY XEDIT C" +if (RC ^= 0) & (RC ^= 4) then do + say "" + say "***** PROBLEMS WITH COMPILATION OF ISARCQRY (RC="RC")" + say "" + problems="TRUE" +end +else + say "ISARCQRY compilation completed." + +"REXXC ISARCREQ XEDIT C" +if (RC ^= 0) & (RC ^= 4) then do + say "" + say "***** PROBLEMS WITH COMPILATION OF ISARCREQ (RC="RC")" + say "" + problems="TRUE" +end +else + say "ISARCREQ compilation completed." + +"REXXC ISARCRST XEDIT C" +if (RC ^= 0) & (RC ^= 4) then do + say "" + say "***** PROBLEMS WITH COMPILATION OF ISARCRST (RC="RC")" + say "" + problems="TRUE" +end +else + say "ISARCRST compilation completed." + +"REXXC ISARCHLP XEDIT C" +if (RC ^= 0) & (RC ^= 4) then do + say "" + say "***** PROBLEMS WITH COMPILATION OF ISARCHLP (RC="RC")" + say "" + problems="TRUE" +end +else + say "ISARCHLP compilation completed." + +if (problems="TRUE") then do + say "" + say "***** Aborted due to compilation problems." + say "" + exit +end +else + say "Code compilation completed." + +say "Erasing compiler LISTING files..." +"ERASE ISARC LISTING C" +"ERASE ISARCHLP LISTING C" +"ERASE ISARCQST LISTING C" +"ERASE ISARCINF LISTING C" +"ERASE ISARCREQ LISTING C" +"ERASE ISARCRST LISTING C" +"ERASE ISARCQRY LISTING C" +"ERASE ISARCINS LISTING C" +"ERASE ISARCMNU LISTING C" + +say "Erasing contents of PUBLIC_ACCESS..." +"ERASE ISARC EXEC D" +"ERASE * XEDIT D" +"ERASE * ISARCHLP D" +"ERASE * ISARCTXT D" +"ERASE $$TEMP$$ $$FILE$$ D" + +say "Copying new code to PUBLIC_ACCESS..." +"COPY ISARC CEXEC C = EXEC D" +"COPY ISARCHLP CXEDIT C = XEDIT D" +"COPY ISARCQST CXEDIT C = XEDIT D" +"COPY ISARCINF CXEDIT C = XEDIT D" +"COPY ISARCREQ CXEDIT C = XEDIT D" +"COPY ISARCRST CXEDIT C = XEDIT D" +"COPY ISARCQRY CXEDIT C = XEDIT D" +"COPY ISARCINS CXEDIT C = XEDIT D" +"COPY ISARCMNU CXEDIT C = XEDIT D" + +say "Copying auxiliary files to PUBLIC_ACCESS..." +"COPY * ISARCTXT C = = D" +"COPY $$TEMP$$ $$FILE$$ C = = D" +"COPY * ISARCHLP C = = D" + +say "Erasing compiler results..." +"ERASE ISARC CEXEC C" +"ERASE ISARCHLP CXEDIT C" +"ERASE ISARCQST CXEDIT C" +"ERASE ISARCINF CXEDIT C" +"ERASE ISARCREQ CXEDIT C" +"ERASE ISARCRST CXEDIT C" +"ERASE ISARCQRY CXEDIT C" +"ERASE ISARCINS CXEDIT C" +"ERASE ISARCMNU CXEDIT C" + +say "Releasing filemode D (VMSYS:VMSERV01.ISARC.PUBLIC_ACCESS)..." +"RELEASE D" + +say "Make of ISARC complete." diff --git a/vmworkshop-vmarcs/1995/stumai95/mmailusr.exec b/vmworkshop-vmarcs/1995/stumai95/mmailusr.exec new file mode 100644 index 0000000..ee88ece --- /dev/null +++ b/vmworkshop-vmarcs/1995/stumai95/mmailusr.exec @@ -0,0 +1,6 @@ +/* MMAILUSR EXEC - Front end for MailBook Mail Userid command. +Author: Barbara Jones, IT-DCS, 6/13/94. +Requires: DOPANEL EXEC, MMAILUSR XEDIT (by PDL, IT-DCS) +History: 07/27/94 In production (without help files) +*/ +'DOPANEL MMAILUSR' diff --git a/vmworkshop-vmarcs/1995/stumai95/mmailusr.helpcms b/vmworkshop-vmarcs/1995/stumai95/mmailusr.helpcms new file mode 100644 index 0000000..e98135f --- /dev/null +++ b/vmworkshop-vmarcs/1995/stumai95/mmailusr.helpcms @@ -0,0 +1,89 @@ +.cm ***************************************************************** +.cm * Help for MMAILUSR HELPCMS * +.cm * Barbara Jones, IT-DCS, 8/12/94 * +.cm * Modified, 8/15/94, PDL, added .cs blocks * +.cm ***************************************************************** +.cs 1 on +MMAILUSR SEND MAIL USING MAILBOOK + +This screen prompts for the information most commonly used to send a note +with MailBook. + +After filling in the desired fields, press Enter to proceed to the Sending +Mail screen where you will enter the text of your note. + +Note: All entries on the screen may be entered in lower case for +convenience. However, the subject should be entered in mixed case just as +you would enter the body of the note. + +.cs 1 off +.cs 2 on +Send Mail to ... + +Userid/ - Enter either a userid, the CMS nickname you have defined + Nickname for the recipient, or the nickname of a list of names. The + full userid@nodename format should be entered if the + recipient is not on ULKYVM, the U of L IBM system you are + on right now (See HELP NAMES for more about creating + nicknames.) + +Subject - Enter the subject for your note. The subject is not + required, but it is very helpful! + + +Mailing Options ... + +Type an X in the following fields that apply: + +Receive acknowledgement when read - + When the recipient opens this note, an automatic + acknowledgement (ack) note is returned to you. Note: The ack + is only sent back when the note is read using MailBook or + some other mail system that recognizes MailBook + acknowledgment requests. + +Do not log the outgoing note - + By default, notes are logged automatically when sent. If you + don't want this note logged, mark this selection. Logging a + note means it is saved in a notebook. The notebook name will + be ALL NOTEBOOK unless you have assigned another notebook + name for this recipient in your CMS nickname file. + +Include a file in the note - + Enter the filename and filetype of a file containing text to + be pulled into the note. The filemode may be omitted if the + file is on the 'A' disk, otherwise enter the filemode letter + where the file can be found. The SFS directory may be + omitted unless the file exists in a filespace directory not + already accessed. + +Selecting a PF key gives you: + +PF1/PF9 - Brings you to this help screen. + Help + +PF2 - Displays the online help about the options available + MailBook Help for the MMail command. + +PF3/PF12 - Exits without sending a note. + Quit + +PF4 - Resumes a note that was saved or suspended when you + Resume enter the same userid/nickname as was used when a + previous note was suspended. + +.cs 2 off +.cs 5 on +Usage Notes: +1. This input screen helps you use the MMAIL command to send notes. You +may also use the MMAIL command from the command line at the bottom of the +main menu screens along with the necessary parameters. Example: Send a +note to JQPUBLZ1 and request an acknowledgment with: + + MMAIL JQPUBLZ1 (ACK + +2. The original MailBook command to send notes is MAIL, and that command +name can be used when outside the student account menus. Use the MMAIL +command instead from the command line of the student account menu screens. +MMAIL will also work outside the student menus. +.cs 5 off \ No newline at end of file diff --git a/vmworkshop-vmarcs/1995/stumai95/mmailusr.xedit b/vmworkshop-vmarcs/1995/stumai95/mmailusr.xedit new file mode 100644 index 0000000..8d192e6 --- /dev/null +++ b/vmworkshop-vmarcs/1995/stumai95/mmailusr.xedit @@ -0,0 +1,567 @@ +/* */ +/* MMAILUSR XEDIT */ +/* */ +/* Usage: This file is to be used by either invoking the DOPANEL */ +/* command and supplying the command with the name of this */ +/* panel or invoking a XEDIT session on a file with this */ +/* file specified as the PROFILE to be used. */ +/* */ +/* MMAILUSR is a XEDIT file containing various XEDIT and REXX */ +/* instructions combined to construct an input panel and the */ +/* instructions necessary to process the input gathered from the */ +/* customer. See the USAGE statement above for information on how */ +/* to invoke the MMAILUSR panel. */ +/* */ +/* Exit Code Definitions: */ +/* Not applicable. */ +/* */ +/* Mod Date Init Description */ +/* -------- ---- ------------------------------------------------- */ +/* 06291994 PDL Initial development. */ +/* 07071994 PDL Changed default of yes for log the note to no. */ +/* This was done so as to respect the personal mail */ +/* profile of the customer. */ +/* 07071994 PDL Removed code to set NOLOG option if the customer */ +/* did not specify logging the outgoing note. Done */ +/* to respect the personal mail profile. */ +/* 07071994 PDL Removed code to set NOACK option if the customer */ +/* did not specify acknowledge receipt of the note. */ +/* Done to respect the personal mail profile. */ +/* 07071994 PDL Accentuated "or" with "-or-" between the filemode */ +/* and SFS directory spec fields. */ +/* 07201994 PDL Added message handler */ +/* 07201994 PDL Added code to un-RESERVE lines. */ +/* 07221994 PDL Removed BETA descriptor from panel. Release level*/ +/* 107 meant for first public release. */ +/* */ +/* 08171994 PDL Changed the option "Log the outgoing note" to */ +/* "Do not log the outgoing note". Execution code */ +/* was also updated properly. */ +/* */ + +level="108" + +/* Define the control characters for panel definition */ +address xedit +"SET CTLCHAR % ESCAPE" +"SET CTLCHAR @ PROTECT HIGH" +"SET CTLCHAR ! PROTECT NOHIGH" +"SET CTLCHAR $ NOPROTECT HIGH" + +/* Set up the XEDIT environment for panel definition */ +"SET CASE MIXED" +"SET LINEND OFF" +"SET TOFEOF OFF" +"SET PREFIX OFF" +"SET SCALE OFF" +"SET MSGLINE ON 21 2" +"SET CMDLINE OFF" +"SET MSGMODE ON" +"VERIFY OFF 1 80" + +/* Ensure the PF keys are defined as we need them so */ +/* that we can avoid the problem with a key defined */ +/* as TABKEY, COPYKEY, NULLKEY, or CP BRKKEY (which */ +/* will cause a XEDIT READ to -NOT- terminate). We */ +/* cannot have this. */ +do index=1 to 24 + "SET PF"index "BEFORE EMSG INTERNAL FAILURE: EXIT", + "IMMEDIATELY AND REPORT THIS TO THE HELPDESK (7997)" +end + +/* Make sure that we set the appropriate PF */ +/* keys with a QQUIT definition. This is to*/ +/* make sure the customer can get out even */ +/* though an internal failure has occurred. */ +"SET PF3 BEFORE QQUIT" +"SET PF12 BEFORE QQUIT" +"SET PF15 BEFORE QQUIT" +"SET PF24 BEFORE QQUIT" + +/* "un-RESERVE" all of the XEDIT lines */ +/* that were reserved, if any. */ +"EXTRACT /RESERVED */" +do index=1 to RESERVED.0 + parse var RESERVED.index linenum otherstuff + "SET RESERVED" linenum "OFF" +end + +address command + +/* Request that the panel be constructed, and place the cursor */ +/* at the first input field. */ +call BuildDisplay +address xedit "CURSOR SCREEN 8 29" + +/* Initialize all input variables */ +towhom="" +subject="" +acknowledge="" +donotlognote="" +includefile="" +filename="" +filetype="" +filemode="" +sfsdir1="" +sfsdir2="" +sfsdir3="" +sfsdir4="" + +/* Begin processing of the panel. The "status" variable indicates */ +/* what mode we are in. */ +/* Status=0 indicates that the customer has submitted the */ +/* panel for processing. Syntax/Field checking */ +/* is performed as required, and if no problem is */ +/* found then the external command is */ +/* constructed and executed. */ +/* Status=1 indicates that reading of the panel is to */ +/* continue until otherwise indicated. */ +/* Status=2 indicates that an exit from the panel has been */ +/* requested. */ +/* Status=3 indicates that help has been requested. */ +/* Status=4 indicates that the customer wants to resume */ +/* a previously suspended note. */ +status=1 +do while (status = 1) + + /* Request that the panel be rebuilt to reflect customer entries */ + call BuildDisplay + /* Request that XEDIT read the panel and return the results */ + address xedit "READ NOCHANGE NUMBER TAG" + + /* Process the results of the XEDIT READ until no more are left */ + do queued() + parse pull tag line column data + + /* If the result was from an input field, then process it */ + if tag = "RES" then do + /* Remove all blanks and underscore characters */ + /* from the input */ + data=strip(data,trailing,"_") + data=strip(data) + select + /* Line 8 is the userid/nickname field */ + when line = 8 then do + upper data + towhom=data + end + /* Line 9 is the subject field */ + when line = 9 + then subject=data + /* Line 13 is the sfs dirspec field, line 1 */ + when line = 13 then do + upper data + acknowledge=data + end + /* Line 14 is the do not log outgoing note field */ + when line = 14 then do + upper data + donotlognote=data + end + /* Line 15 is the include file field */ + when line = 15 then do + upper data + includefile=data + end + /* Line 16, Column 28 is the filename field */ + when (line = 16) & (column = 28) then do + upper data + filename=data + end + /* Line 16, Column 47 is the filetype field */ + when (line = 16) & (column = 47) then do + upper data + filetype=data + end + /* Line 17 is the filemode field */ + when line = 17 then do + upper data + filemode=data + end + /* Line 18 is the SFS directory spec field, line 1 */ + when line = 18 then do + upper data + sfsdir1=data + end + /* Line 19 is the SFS directory spec field, line 2 */ + when line = 19 then do + upper data + sfsdir2=data + end + /* Line 20 is the SFS directory spec field, line 3 */ + when line = 20 then do + upper data + sfsdir3=data + end + otherwise nop + end + + end + + /* If the customer pressed a PF key, process it */ + if tag = "PFK" then do + + select + /* If the customer pressed PF1, PF13, PF9, PF21, */ + /* PF2, or PF14 then help is requested on the */ + /* panel or on XEDIT options. */ + when (line = 1) | (line = 13) |, + (line = 9) | (line = 21) |, + (line = 2) | (line = 14) then status=3 + /* If the customer pressed PF3, PF15, PF12, or PF24 */ + /* then the customer wishes to exit. */ + when (line = 3) | (line = 15) |, + (line = 12) | (line = 24) then do + "DESBUF" + status=2 + leave + end + /* If the customer pressed PF4 or PF16, then the */ + /* customer wants to RESUME a previously */ + /* SUSPENDed note. */ + when (line = 4) | (line = 16) then + status=4 + /* Otherwise, the PF key is not defined to us. */ + otherwise + message="PFKey is not defined." + call display_message + end + + end + + /* If the customer pressed the ENTER key, then set the */ + /* status flag to "check/process input panel". */ + if tag = "ETK" then status=0 + + end + + /* The customer requested assistance for the panel */ + /* or XEDIT options. */ + if status = 3 then do + if (line = 2) | (line = 14) then + address command "HELP MAIL ( DETAIL OPTIONS" + else address command "HELP MMAILUSR" + /* Now, resume panel input/processing */ + status=1 + end + + /* If the customer wanted to resume, then resume */ + if (status = 4) then do + if (towhom = "") then do + message="A userid or nickname must be", + "supplied to resume a previously", + "suspended note." + call display_message + address xedit "CURSOR SCREEN 8 29" + status=1 + end + else do + status=4 + /* Let us go ahead and try to resume */ + address cms "PIPE CMS MAIL" towhom, + "(RESUME | STACK FIFO" + /* Did we get a message back stating that */ + /* the resume MAIL file could not be found? */ + cannotresume=0 + do queued() + parse upper pull text + if (find(text,"CAN'T FIND") ^= 0) &, + (find(text,"MAIL FILE TO RESUME.") ^= 0) then + cannotresume=1 + end + /* MailBook RESUME failed, so resume panel */ + /* input processing. */ + if (cannotresume = 1) then do + status=1 + message="Unable to resume any", + "previously suspended note", + "for the userid or nickname", + "supplied." + call display_message + end + else + "DESBUF" + end + end + + /* Was panel checking/processing requested? */ + if status = 0 then do + + /* Check to see if we have any "error" conditions... */ + select + /* Scenario 1: The customer has not supplied a */ + /* userid or a nickname */ + when (towhom = "") then do + status=1 + message="A userid or nickname must be", + "supplied to send mail to a person", + "or group." + call display_message + address xedit "CURSOR SCREEN 8 29" + end + /* Scenario 2: The customer wants to include a file, but*/ + /* did not specify a filename. */ + when (filename = "") & (includefile ^= "") then do + status=1 + message="A filename must be supplied to", + "include a file." + call display_message + address xedit "CURSOR SCREEN 16 28" + end + /* Scenario 3: The customer wants to include a file, but*/ + /* did not specify a filetype. */ + when (filetype = "") & (includefile ^= "") then do + status=1 + message="A filetype must be supplied to", + "include a file." + call display_message + address xedit "CURSOR SCREEN 16 47" + end + /* Scenario 4: The customer wants to include a file */ + /* but specified neither a filemode or */ + /* a SFS directory. */ + when (sfsdir1 = "") & (sfsdir2 = "") &, + (sfsdir3 = "") & (filemode = "") &, + (includefile ^= "") then do + status=1 + message="A filemode or SFS directory", + "must be supplied to include a file." + call display_message + address xedit "CURSOR SCREEN 17 28" + end + /* Scenario 5: The customer wants to include a file */ + /* and has specified both a filemode and*/ + /* a SFS directory. */ + when ((sfsdir1 ^= "") | (sfsdir2 ^= "") |, + (sfsdir3 ^= "")) & (filemode ^= "") &, + (includefile ^= "") then do + status=1 + message="Both a filemode and a SFS", + "directory cannot be supplied to", + "include a file." + call display_message + address xedit "CURSOR SCREEN 17 28" + end + otherwise nop + end + + end + + /* If status is still zero then we have passed the panel checks. */ + /* Now let us construct and perform the command for the customer.*/ + if status = 0 then do + /* Initialize the By-pass Send flag */ + bypasssend=0 + /* Initialize the Access Performed flag */ + accessperformed=0 + /* Form part of the MailBook options string */ + options="" + + /* Did the customer want an acknowledgement? */ + if (acknowledge ^= "") then + options=options||" ACK" + + /* Did the customer not want logging of the outgoing note? */ + if (donotlognote ^= "") then + options=options||" NOLOG" + + /* Did the customer want to include a file? */ + if (includefile ^= "") then do + /* Form the SFS dirspec strings */ + sfsdir=sfsdir1||sfsdir2||sfsdir3 + /* Did the customer specify a SFS directory spec? */ + /* If so, we will have to make sure that is accessed, and */ + /* if not, then attempt to access the directory */ + if (sfsdir ^= "") then do + /* First, let us make the directory exists or has */ + /* been specified correctly. */ + address cms "PIPE CMS LISTDIR" sfsdir " (NOSUB |", + "STACK FIFO" + /* Did we get a return code (^= 0)? If so, error */ + if RC ^= 0 then do + /* Discard anything stacked and set the flags */ + do queued() + pull trash + end + bypasssend=1 + status=1 + message="The SFS directory specification", + "you supplied could not be resolved. ", + "Please check the SFS directory", + "you specified and make sure it is", + "correct." + call display_message + address xedit "CURSOR SCREEN 18 33" + end + /* Otherwise, the directory exists... */ + /* Now check to see if it is already accessed... */ + else do + pull trash + parse upper pull fmaccessed . + fmaccessed=strip(fmaccessed) + /* If a hyphen was returned, then the directory */ + /* has not been accessed. */ + if fmaccessed = "-" then do + /* Now, let us see if we can get */ + /* a free filemode */ + address cms "GETFMADR" + parse upper pull . freemode . check + if (check ^= "") then do + message="Unable to obtain a free", + "filemode to access the specified SFS", + "directory. Please exit, release a", + "filemode and then try again." + call display_message + address xedit "CURSOR SCREEN 18 33" + bypasssend=1 + status=1 + end + /* We were able to get a free filemode, so */ + /* let us go ahead and access it. */ + else do + address cms "PIPE CMS ACCESS" sfsdir, + freemode "| HOLE" + accessperformed=1 + filemode=freemode + end + end + /* The directory has already been */ + /* accessed, so just pass it on. */ + else filemode=fmaccessed + end + end + /* Otherwise, the customer supplied a filemode. So let us */ + /* check to make sure that the filemode supplied exists. */ + else do + /* Get a list of filemodes used */ + address cms "PIPE CMS QUERY ACCESSED | STACK FIFO" + modefound=0 + /* Discard the header line */ + pull trash + do queued() + parse upper pull mode . + /* Obtain only the first character */ + /* of the given mode */ + mode=strip(left(mode,1)) + if (mode = filemode) then modefound=1 + end + if (modefound = 0) then do + bypasssend=1 + status=1 + message="Unable to resolve the filemode", + "that you specified. Please specify", + "a filemode that currently exists." + call display_message + address xedit "CURSOR SCREEN 17 28" + end + end + options=options||" FILE" filename filetype filemode + end + + /* Did the customer want to include a subject? */ + if (subject ^= "") then + options=options||" SUBJECT" subject + + if (bypasssend = 0) then do + /* Check to make sure the include file exists, if needed */ + if (includefile ^= "") then + "PIPE CMS STATE" filename filetype filemode "| HOLE" + if (RC ^= 0) & (includefile ^= "") then do + status=1 + message="The include file specified does not", + "exist. Please check the file", + "information you supplied and", + "make sure it is correct." + call display_message + address xedit "CURSOR SCREEN 16 28" + end + else + address cms "MAIL" towhom "(" options + end + if (sfsdir ^= "") then do + if (accessperformed = 1) then do + address cms "RELEASE" filemode + accessperformed=0 + filemode="" + end + end + end +end + +address xedit "QQUIT" +exit + +/* Construct the input panel for the customer... */ +BuildDisplay: +address xedit +"SET RESERVED 1 N %!MMAILUSR %@SEND MAIL USING", + "MAILBOOK%! LEVEL"level +"SET RESERVED 3 N %@Enter the information below to send", + "mail to a person or a group of people.%!" +"SET RESERVED 4 N %@Assistance for MailBook options on this", + "panel is available by pressing PF2.%!" +"SET RESERVED 6 N %! Send Mail To...%!" +"SET RESERVED 8 N %! UserID/Nickname", + "%$"left(towhom,50,"_")"%!" +"SET RESERVED 9 N %! Subject ", + "%$"left(subject,50,"_")"%!" +"SET RESERVED 11 N %! Mailing Options... " +"SET RESERVED 13 N %! {%$"left(acknowledge,1,"_")"%!}", + "Receive acknowledgment when read%!" +"SET RESERVED 14 N %! {%$"left(donotlognote,1,"_")"%!}", + "Do not log the outgoing note%!" +"SET RESERVED 15 N %! {%$"left(includefile,1,"_")"%!}", + "Include a file in the note%!" +"SET RESERVED 16 N %! ", + "Filename%$"left(filename,8,"_")"%!", + "Filetype%$"left(filetype,8,"_")"%!" +"SET RESERVED 17 N %! ", + "Filemode%$"left(filemode,1,"_")"%! -or-" +"SET RESERVED 18 N %! ", + "SFS Directory%$"left(sfsdir1,46,"_")"%!" +"SET RESERVED 19 N %! ", + "%$"left(sfsdir2,46,"_")"%!" +"SET RESERVED 20 N %! ", + "%$"left(sfsdir3,44,"_")"%!" +"SET RESERVED -1 N %@PF1/PF9%! Help %@PF2%! MailBook Help ", + "%@PF3/PF12%! Quit %@PF4%! Resume a Note" +address command +return + +display_message: + +if message ^= "" then do + /* Now format the message for proper display */ + nextword="" + msglines.0=1 + msgindex=msglines.0 + do index=1 to 2 + msglines.index="" + end + do index=1 to words(message) + msgindex=msglines.0 + nextword=word(message,index) + /* If we can fit the next word into the line, then do so */ + if (length(msglines.msgindex)+length(nextword)) <= 78 then + if length(msglines.msgindex) = 0 then + msglines.msgindex=nextword + else + msglines.msgindex=msglines.msgindex||" "||nextword + /* Otherwise, pad the rest of the current line, */ + /* and start a new line. */ + else do + msglines.msgindex=left(msglines.msgindex,79) + msglines.0=msglines.0+1 + msgindex=msglines.0 + msglines.msgindex=nextword + end + end + msgtodisplay="" + do index=1 to msglines.0 + msgtodisplay=msgtodisplay||msglines.index + end + address xedit "EMSG" msgtodisplay + message="" +end + +return diff --git a/vmworkshop-vmarcs/1995/stumai95/putdata.rexx b/vmworkshop-vmarcs/1995/stumai95/putdata.rexx new file mode 100644 index 0000000..e2077f9 --- /dev/null +++ b/vmworkshop-vmarcs/1995/stumai95/putdata.rexx @@ -0,0 +1,19 @@ +/* PUTDATA REXX */ +Arg datafid /* GET DATA FILE NAME */ +'READTO inputjcl' /* READ RECORD */ +Do until rc=12 /* do until eof */ + /* check for input dd */ + If inputjcl='//SYSUT1 DD *' then do + 'OUTPUT 'inputjcl /* write the line */ + 'READTO inputjcl' /* read the BLANK record */ + 'OUTPUT 'inputjcl /* write the BLANK line */ + rfname= Delstr(Date(O),3,1) /* build request file name */ + rfname= 'ST'Delstr(rfname,5,1) + 'CALLPIPE < 'datafid , /* GET DATA FILE */ + '| *:' + End + Else + 'OUTPUT' inputjcl /* copy record to output */ + 'READTO inputjcl' /* read the next record */ + End /* end JCL file read */ +EXIT RC*(RC^=12) /* RC = 0 IF END-OF-FILE */ diff --git a/vmworkshop-vmarcs/1995/stumai95/samserve.exec b/vmworkshop-vmarcs/1995/stumai95/samserve.exec new file mode 100644 index 0000000..408d4da --- /dev/null +++ b/vmworkshop-vmarcs/1995/stumai95/samserve.exec @@ -0,0 +1,354 @@ +/* Service machine waits for job listings from VMSECURE attempts to + reset MVS passwords in synch with VM password updates. + Will eventually also process student account requests to prepare + file for batch creation of those accounts. */ + +Trace All +'CP SPOOL CONSOLE MAINT START' /* for a while */ +'ACCESS 492 B' /* make sure of disks */ + +/* initialize */ +quit_flag= 'NO' +create_flag= 1 /* assume all jobs ok */ +message_flag= 0 /* reset until new file */ +verify_flag= 0 /* reset until new file */ +inact_flag= 0 /* reset until new file */ +sam5_flag= 0 /* SET JOB FLAGS */ +sam6_flag= 0 +vercount= 0 /* count verify files */ +/*** if SAMSERVE is restarted between 12:00AM and 12:05AM the filename + for submitting the data will not be correct ***/ +subfname= Delstr(Date(O),3,1) /* set submit fn at startup */ +subfname= 'ST'Delstr(subfname,5,1) +/* use to create duplicate userid characters */ +counter= '1 2 3 4 5 6 7 8 9 A B C D E F G H I J K L M N O P Q R S', +'T U V W X Y Z' + +/* WAKEUP for RDR files or SMSG */ +'WAKEUP AT 00:15:00 ( RDR SMSG CONS' + +Do while quit_flag^='YES' /* governing loop */ + Select + + When rc=1 then do /* SMSG processing */ + + /* GET SMSG DATA SENT from ULINFO userid */ + /* PROCESS 2: FOR STUDENT ACCOUNT REQUEST SETUP */ + 'ACCESS 491 C' /* make sure of disks */ + 'CP LINK * 192 192 RR' /* relink 192 */ + 'ACCESS 192 D' + srecord= 'NONE' /* reset variables */ + rrecord= 'NONE' + msgcode= 0 + dutotal= 0 + rutotal= 0 + rfname= Delstr(Date(O),3,1) /* reset request fn */ + rfname= 'ST'Delstr(rfname,5,1) + Parse Pull flag aisuser userdata /* get SMSG data */ + /* VERIFY is AIS user and type of SMSG request */ + Parse var userdata checkreq restreq + If Substr(aisuser,1,5)='S7C4E', + | aisuser='PDLEWI01', /* special test cases */ + | aisuser='TEST1111', + | aisuser='TEST2222', + | aisuser='TEST2222' then + If checkreq='REQID' then do + Parse var restreq msgssn 11 msgdate 18 msgid . + 'PIPE < STUDBASE MASTER D', + '| FIND 'msgssn||, /* for ssn */ + '| VAR MRECORD' /* read record */ + Parse var mrecord master 20 muserid . + msgcode= 'REQID 'muserid /* requested id info */ + 'CP SMSG 'aisuser msgcode /* send response back */ + End /* end userid request */ + Else Do /* regular request */ + Parse var userdata rssn 11 tcode 13 rpin 20 ruserid 29 rlast , + 44 rfirst 59 rinitial + 'PIPE < STUDBASE MASTER D ', /* read database */ + '| FIND 'rssn||, /* for ssn */ + '| VAR SRECORD' /* read reacord */ + Parse var srecord sssn 11 scode 13 sdate 20 suserid 29 sLAST , + 44 sfirst 59 sinitial + + If srecord='NONE' | srecord='SRECORD' then do /* user is new? */ + 'PIPE < 'rfname' REQUEST B ', /* check requests for SSN */ + '| FIND 'rssn||, /* for ssn */ + '| VAR RRECORD' /* read reacord */ + /* user not yet requested */ + If rrecord='NONE' | rrecord='RRECORD' then do + /* count occurrences of userid string */ + rusertry= Substr(ruserid,1,7) /* drop last digit */ + 'PIPE < STUDBASE MASTER D ', /* read database */ + '| APPEND < 'rfname' REQUEST * ',/* read requests */ + '| LOCATE 20-26 /'rusertry'/',/* get userids */ + '| SPECS 27 1 ', /* get id characters used */ + '| JOIN *', /* join into 1 string */ + '| VAR USERUSED' /* put in variable to test */ + /* determine next appropriate userid identfier character */ + Do idcount= 1 to 36 /* check all codes */ + nextchar= Word(counter,idcount) /* get next character */ + chartest= Pos(nextchar,userused) /* already used? */ + If chartest=0 then do /* build new userid */ + rusertry= rusertry||nextchar + idcount= 36 /* exit counted loop */ + End + End + /* build request userid */ + userdata= Overlay(rusertry,userdata,20) + 'PIPE VAR USERDATA' , /* use new record */ + '| >> 'rfname' REQUEST B' /* append to request file */ + msgcode= '23 'rusertry /* info for request ok */ + End /* end new user process do */ + Else do /* userid already requested */ + Parse var rrecord rdssn 11 rdcode 13 rdpin 20 rduserid , + 29 rdlast 44 rdfirst 59 rdinitial + msgcode= '24 'rduserid + End + End /* end no active ssn do */ + /* user found in database */ + Else + If scode='H' then do /* user on HOLD? */ + /* make request userid match existing held userid */ + userdata= Overlay(suserid,userdata,20) + 'PIPE VAR USERDATA' , /* use new request data */ + '| >> 'rfname' REQUEST B' /* append to request file */ + msgcode= '22 'suserid /* INFO FOR HELD MESSAGE */ + End + Else msgcode= '21 'suserid /* info for ACTIVE message */ + + 'CP SMSG 'aisuser msgcode /* send response back */ + + End /* end SMSG user ok do */ + + End /* end SMSG do */ + + When rc=2 then do /* Timer interrupt */ + + /* It will process the jobs required to update the MVS + datasets for request files */ + + 'ACCESS 491 C' /* make sure of disks */ + 'ACCESS 192 D' + + /* initialize */ + newpass= '' + create_flag= 1 /* assume all jobs ok */ + message_flag= 0 /* reset until new file */ + verify_flag= 0 /* reset until new file */ + inact_flag= 0 /* reset until new file */ + vercount= 0 /* count verify jobs */ + /* reset TAB files for new set */ + 'ERASE PROD OLDEVER B' + 'ERASE PROD OLDEMSG B' + 'ERASE PROD OLDEINA B' + 'RENAME PROD EMAILVER B PROD OLDEVER B' + 'RENAME PROD EMAILMSG B PROD OLDEMSG B' + 'RENAME PROD EMAILINA B PROD OLDEINA B' + + /* modify SAMGEN JCL fields: jobname,pw */ + 'EXECIO 1 DISKR SAMGEN DATA A 1 (VAR JOBDATA ' /* get jobname */ + Parse var jobdata jobname jobrest + jobnum= Right(Substr(jobname,7,2)+1,2,0) + /* put jobname back together with new number */ + jobname= Substr(jobname,1,6)||jobnum + /* record new jobname in data file */ + 'EXECIO 1 DISKW SAMGEN DATA A 1 (VAR JOBNAME FINIS' + + /* create userdata for job, on Saturday change pw */ + If Date(W)='Saturday' then do + /* GENERATE RANDOM 8 CHARACTER string */ + alpha = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' + newpw= '' + Do I = 1 to 8 by 1 /* RANDOM LETTER LOOP */ + newpw= newpw || SUBSTR(alpha,Random(1,26),1) + End /* END RANDOM LETTER LOOP */ + newpass= newpw /* set newpass parameter */ + End + 'EXECIO 1 DISKR SAMGEN DATA A 2 (VAR PCARD ' + Parse var pcard pstring userdata + If newpass^='' then do /* rebuild the card */ + userdata= Strip(userdata)'/'newpass + pcard= pstring newpass + /* record new in data file */ + 'EXECIO 1 DISKW SAMGEN DATA A 2 (VAR PCARD FINIS' + End + + /* prepare for punch */ + 'CP SPOOL PUN RSCS CONT' + 'CP TAG DEV 00D ULKYMVS2 JOB' + /* submit request file update */ + sam5_flag= 0 /* reSET JOB FLAG */ + Call SUBJCL 'SAMD050 'subfname' REQUEST B' + /* submit master file update */ + sam6_flag= 0 /* reSET JOB FLAG */ + If newpass^='' then /* was password updated */ + userdata= Substr(userdata,10,8) /* no pw update on second job */ + Call SUBJCL 'SAMD060 STUDBASE MASTER D' + + /* if there is no request file, reset old file names. This + prevent VMSERV02 filename query from getting an old file */ + 'STATE 'subfname' REQUEST B' + If rc^=0 then 'RENAME * REQUEST B = REQUESTD =' + + creatname= subfname /* save old name for creation */ + subfname= Delstr(Date(O),3,1) /* reset subfn for new day */ + subfname= 'ST'Delstr(subfname,5,1) + + 'CP SLEEP 1 MIN' /* don't wake right back up */ + + End /* end timer do */ + + When rc=4 then do /* RDR file received */ + + /* This code will process job listings in the reader and verify + that the VMXACF2,SAMD jobs have condition code of 0. If the + condition code is not 0 the file will be forwarded to ASKSAMIT + for review and a note generated. */ + + /* initialize variables */ + + /* read job listing rdr info into stem */ + 'PIPE CP QUERY RDR * NOHOLD ALL', + '| STEM RDRFILES. ' + + 'CP SPOOL RDR KEEP' /* preserve files */ + Do rdrcnt= 2 to rdrfiles.0 /* skip header line */ + cond0000= 0 /* reset for each file */ + /* get spoolid and jobname data for next pipe */ + Parse var rdrfiles.rdrcnt . spoolid . . . . status . . qname , + qtype . + + Select /* select file processing */ + + /* VMSECURE reset jobs */ + When Substr(qname,1,6)='VMXACF' then do + /* PIPE to count occurences of COND 0000 into variable */ + 'PIPE READER FILE 'spoolid , + '| LOCATE /IEF142I 'qname' ACFB01 STEP01 - STEP WAS EXECUTED', + '- COND CODE 0000/', + '| COUNT LINES ', + '| VAR COND0000 ' + /* if condcode 0000 not found send file for review */ + If cond0000=0 then do + /* send note about error also */ + 'MAIL ASKSAMIT ( NOLOG NOEDIT NOPROMPT FILE BADRESET', + 'LISTING A SUBJECT Bad MVS Password Reset Job ' + 'CP TRANSFER RDR 'spoolid' MAINT ' /* send for review */ + End + End /* end VMXACF listings do */ + + /* SAMGEN jobs */ + When Substr(qname,1,5)='SAMD0' then do + If Substr(qname,6,1)=5 then /* DETERMINE WHICH JOB */ + jobstep= 'SAM0501' + If Substr(qname,6,1)=6 then /* DETERMINE WHICH JOB */ + jobstep= 'SAM0601' + /* PIPE to count occurences of COND 0000 into variable */ + 'PIPE READER FILE 'spoolid , + '| LOCATE /IEF142I 'qname jobstep' - STEP WAS EXECUTED', + '- COND CODE 0000/', + '| COUNT LINES ', + '| VAR COND0000 ' + /* if condcode 0000 not found send file for review */ + If cond0000=0 then do + /* send note about error also */ + 'MAIL ASKSAMIT ( NOLOG NOEDIT NOPROMPT FILE BADUPDT', + 'LISTING A SUBJECT 'qname' Update Job Failed' + 'CP TRANSFER RDR 'spoolid' ASKSAMIT' /* send for review */ + create_flag= 0 /* both jobs must run */ + /* create "no create" message file from request file */ + 'PIPE < 'subfname' REQUEST B', + '| SPECS 1-9 1 /'Substr(subfname,3)'/ nextword', + '/31/ nextword', + '| > PROD EMAILMSG B' + message_flag= 1 /* pretend we received file */ + End /* end bad job cc if */ + Else do /* update job flags */ + If jobstep='SAM0501' then sam5_flag= 1 + If jobstep='SAM0601' then sam6_flag= 1 + End + End /* end SAMGEN listings do */ + + /* receive output from verify jobs */ + When Substr(qname,1,5)='SAMD9' then do + /* receive to replace existing versions */ + 'PIPE CMS EXEC RECEIVE 'spoolid' = = B ( REPL NOPROMPT', + '| VAR RECDATA' + Parse var recdata . recfn recft recfm . + 'CP PURGE RDR 'spoolid /* don't let KEEP save file */ + If recfn='PROD' & recft='EMAILVER' then do + vercount= vercount+1 /* update count */ + verify_flag= 1 + End + If recfn='PROD' & recft='EMAILMSG' then do + vercount= vercount+1 /* update count */ + message_flag= 1 + End + If recfn='PROD' & recft='EMAILINA' then do + vercount= vercount+1 /* update count */ + inact_flag= 1 + End + End + + Otherwise /* put odd files on hold */ + 'CP CHANGE RDR 'spoolid' HOLD' /* no wakeup for held files */ + + End /* end rdr file select */ + + End /* end rdr q do */ + + 'CP SPOOL RDR NOKEEP' /* reset rdr */ + /* is it time to kick off creation machine */ +say create_flag verify_flag message_flag inact_flag + If create_flag & verify_flag & message_flag & inact_flag then do + 'CP SMSG VMSERV02 CREATE 'creatname + verify_flag= 0 /* reset flags */ + message_flag= 0 + inact_flag= 0 + sam5_flag= 0 + sam6_flag= 0 + End + + End /* end rdr do */ + + When rc=6 then do /* Console interrupt */ + + /* used to exit exec when loggin on */ + quit_flag= 'YES' + + End /* end console do */ + + Otherwise Nop + End /* end rc select processing */ + + If quit_flag^='YES' then /* reset WAKEUP */ + 'WAKEUP AT 00:15:00 ( RDR SMSG CONS' + + End /* end governing loop */ + +EXIT: +Exit + +subjcl: + /* subroutine to build and submit JCL for request and master file + updates (called by timer process (RC=2)) */ + + Arg jobid datafid + /* fix jobname */ + jobcode= Substr(jobid,6,1) + jobname= Overlay(jobcode,jobname,6,1) + + /* create JCL for SAMGEN */ + 'PIPE < 'jobid' JCL D', + '| REXX PUTDATA 'datafid , + '| LITERAL /*ROUTE PRINT ULKYVM.VMSERV01', /* add job card records */ + '| LITERAL //*PASSWORD 'userdata, + '| LITERAL //*LOGONID VMSERV01', + '| LITERAL // REGION=1024K', + '| LITERAL // TIME=(,5),MSGLEVEL=(1,1),', + '| LITERAL // CLASS=4,', + '| LITERAL //'jobname' JOB (ACF12399,MAINT),''LOUIS.W'',', + '| PUNCH' + 'CP SPOOL PUN CLOSE NOCONT' + Say 'End of JOB card build' /* exit message */ + Return diff --git a/vmworkshop-vmarcs/1995/stumai95/students.exec b/vmworkshop-vmarcs/1995/stumai95/students.exec new file mode 100644 index 0000000..8a7f8f2 --- /dev/null +++ b/vmworkshop-vmarcs/1995/stumai95/students.exec @@ -0,0 +1,320 @@ +/*********************************************************************/ +/* */ +/* University of Louisville */ +/* Non-OV Calendar View Service Machine Code */ +/* */ +/* Exit Code Definitions: */ +/* Not Applicable */ +/* */ +/* Required Files: */ +/* STUDENTS AUTHORIZ A Contains userids who have authorized */ +/* viewing of their calendars. */ +/* INFO CODES A Contains return codes from OFFICE */ +/* APPOINTM that are to be returned as */ +/* informational messages to the customer. */ +/* STUDENTS ADMIN A Contains userids authorized to */ +/* administrate STUDENTS. */ +/* */ +/* Mod Date Init Description */ +/* -------- ------- ---------------------------------------------- */ +/* 01261995 BAJ/PDL Initial Development */ +/* 02031995 PDL Changed results transmission method from the */ +/* SENDFILE command to a combination of */ +/* PUNCH/CHANGE/TRANSFER commands. This is so */ +/* the WAKEUP on the client side can distinguish */ +/* incoming calendar results via class Z reader */ +/* files. */ +/* 02031995 PDL Added calendar viewing authorization file */ +/* code to check and make sure that the calendar */ +/* requested is authorized for viewing. */ +/* 02031995 PDL Added code to discard the "$$CAL$$ userid" */ +/* generated by obtaining authorizations from the */ +/* OV calendar service machine. The presence of */ +/* the file was suspending processing because */ +/* OV would ask for permission to overwrite the */ +/* file when getting the actual calendar. */ +/* 02031995 PDL Added code to log all incoming and outgoing */ +/* transactions. */ +/* 02061995 PDL Re-arranged logic in the AuthorizeToView */ +/* function. */ +/* 02071995 PDL Added code to handle various return codes */ +/* from OFFICE APPOINTM GETCAL command. */ +/* 02071995 PDL Added code to provide administration services */ +/* for authorized userids. Current services are */ +/* CP, CMS, STOP, STOP LOGOFF. */ +/* 02071995 PDL Fixed code to obtain calendar authorizations */ +/* in AuthorizeToView. Code did not properly */ +/* account for condition when requester had no */ +/* authorization to view calendar. OV function */ +/* used does not return an authorization file in */ +/* this case; rather, it returns rc=76. */ +/* 02131995 BAJ Added check for rc 12: not known OV id. */ +/* Reworded some of the 'not authorized' messages.*/ +/* 02141995 BAJ Check for calendar authorization before we */ +/* check if they are in the STUDETNS AUTHORIZ file*/ +/* so 'not OV' message is returned rather than */ +/* 'not authorized userid' msg if not OV userid. */ +/* Also moved the erase on old $$CAL$$ Userid */ +/* to happen all the time before we need it. */ +/* 02141995 BAJ Add code back in to check authorization file */ +/* for situation when OV user is using CALVIEW */ +/* but they have been restricted from viewing */ +/* the calendar they are requesting. */ +/* 04251995 BAJ Added code to reject requests before 4/24/95 */ +/* 05261995 BAJ Removed STUDENTS AUTHORIZ for full production. */ +/*********************************************************************/ + +'CP SPOOL CONSOLE BAJONE02 START NAME STUDENTS SERVRLOG' + +trace off + +Quit_flag= 'NO' + + +/* Check to make sure INFO CODES file exists, if not abort. */ +'PIPE CMS STATE INFO CODES A | HOLE' +if (RC ^= 0) then do + say 'The STUDENTS server could not locate the INFO CODES file.' + say 'STUDENTS server processing will stop.' + say '' + Quit_flag='YES' +end + +/* Check to make sure STUDENTS ADMIN file exists, if not abort. */ +'PIPE CMS STATE STUDENTS ADMIN A | HOLE' +if (RC ^= 0) then do + say 'The STUDENTS server could not locate the STUDENTS ADMIN file.' + say 'STUDENTS server processing will stop.' + say '' + Quit_flag='YES' +end + +say 'STUDENTS server processing online.' + +do while (Quit_flag^="YES") + + say 'Waiting for CP SMSG transaction...' + /* Wakeup for console interrupt or CP smsg */ + 'WAKEUP ( SMSG CONS' + + select /* major select to evaluate WAKEUP responses */ + + when (rc=1) then do /* SMSG received */ + + /* Get SMSG data and process */ + parse upper pull . Calrequester smsgdata + + "PIPE < STUDENTS ADMIN A |", + " STEM Serv_Admin. |", + " HOLE" + + parse upper var smsgdata admindirect command commanddata + if (admindirect = "ADMIN") then do + not_valid_admin="TRUE" + say 'Received ADMIN command from' Calrequester'.' + say 'ADMIN command was:' smsgdata + do admin_index = 1 to Serv_Admin.0 + if (Calrequester = Serv_Admin.admin_index) then do + not_valid_admin="FALSE" + say 'Attempting to parse/execute ADMIN command.' + select /* validate Admin command values */ + when (command = "STOP") then do + quit_flag="YES" + "TELL" Calrequester "Server processing stopped." + if (commanddata = "LOGOFF") then logoffserver="TRUE" + end + when (command = "CMS") then do + "PIPE CMS" commanddata "| STEM cmd_msgs. | HOLE" + cmdretcode=rc + do cmd_index=1 to cmd_msgs.0 + "TELL" Calrequester cmd_msgs.cmd_index + say "ADMIN Command result:" cmd_msgs.cmd_index + end + "TELL" Calrequester, + "Command return code="cmdretcode + say "ADMIN Command result: rc="cmdretcode + end + when (command = "CP") then do + "PIPE CP" commanddata "| STEM cmd_msgs. | HOLE" + cmdretcode=rc + do cmd_index=1 to cmd_msgs.0 + "TELL" Calrequester cmd_msgs.cmd_index + say "ADMIN Command result:" cmd_msgs.cmd_index + end + "TELL" Calrequester, + "Command return code="cmdretcode + say "ADMIN Command result: rc="cmdretcode + end + otherwise nop + "TELL" Calrequester "UNKNOWN ADMIN COMMAND." + end /* end on select for validation of command values */ + end /* end on do when requestor is in admin file */ + end /* end on do loop checking serv_admin entries */ + if (not_valid_admin = "TRUE") then do + "TELL" Calrequester "You are not authorized to administer", + "this service machine." + say '***** WARNING: Invalid attempt to administrate by', + Calrequester '*****' + end + end /* end for do if ADMIN request made */ + else do /* Not ADMIN request */ + + parse upper var smsgdata Caluser Caldate Caldays . + + say 'Received CP SMSG transaction from' Calrequester'.' + say Calrequester' is requesting the calendar for 'Caluser, + '('Caldate', 'Caldays').' + + /* Test request date and reject all before + implementation date: 4/24/95 */ + + CalMo=substr(Caldate,1,2) + Calyear=right(Caldate,2) + Calday=substr(Caldate,4,2) + if Calyear||Calmo||Calday < '950424' then + Authorized_result = "TOO_EARLY" + else + Authorized_result=AuthorizedToView(Caluser,Calrequester) + + select /* Evaluating Authorized_result */ + when (Authorized_result = "TOO_EARLY") then do + /* Reject view requests before April 24, 1995 */ + 'PIPE LITERAL You may not view calendars prior to', + 'April 24, 1995, using CALVIEW. |', + ' > $$CAL$$' Caluser 'A |', + ' HOLE' + end + when (Authorized_result = "NO_VIEW_ALLOWED") then do + /* Calendar owner has restricted this OV customer */ + 'PIPE LITERAL' Caluser 'has not authorized you to', + 'view the calendar. |', + ' > $$CAL$$' Caluser 'A |', + ' HOLE' + end + when (Authorized_result = "NO") then do + /* Calendar being sought has STUDENTS userid restricted */ + 'PIPE LITERAL' Caluser 'has restricted your view of', + 'the calendar through this service. |', + ' > $$CAL$$' Caluser 'A |', + ' HOLE' + end + when (Authorized_result = "NOT_SERVER_AUTHORIZED") then do + /* This test goes away when we open for full production */ + 'PIPE LITERAL This service is currently only available', + 'for viewing limited calendars. |', + ' APPEND LITERAL' Caluser 'is not one of them.|', + ' > $$CAL$$' Caluser 'A |', + ' HOLE' + end + when (Authorized_result = "NOTOV") then do + 'PIPE LITERAL' Caluser 'is not a known OfficeVision', + 'userid. |', + 'APPEND LITERAL No calendar is available.|', + ' > $$CAL$$' Caluser 'A |', + ' HOLE' + end + when (Authorized_result = "PROBLEM") then do + 'PIPE LITERAL Calendar cannot be retrieved at this time. |', + ' > $$CAL$$' Caluser 'A |', + ' HOLE' + end + otherwise /* Handles YES authorization */ + 'PIPE < INFO CODES A |', + ' STEM Info_Codes. |', + ' HOLE' + + /* Make sure there is not an old file left on A already. */ + 'PIPE CMS STATE $$CAL$$' Caluser 'A | HOLE' + if (rc = 0) then 'ERASE $$CAL$$' Caluser 'A' + + 'PIPE CMS OFFICE APPOINTM GETCAL', + Caluser Caldate Caldays 'FILE |', + ' STEM Getcal_Messages. |', + ' HOLE' + + if (rc ^= 0) then do + bypass_critical='FALSE' + + do rc_index= 1 to Info_Codes.0 + if (rc = Info_Codes.rc_index) then do + 'PIPE STEM Getcal_Messages. |', + ' > $$CAL$$' Caluser 'A |', + ' HOLE' + bypass_critical='TRUE' + end + end + + if (bypass_critical = 'FALSE') then do + 'PIPE STEM Getcal_Messages. |', + ' APPEND LITERAL |', + ' APPEND LITERAL PROCESSING FAILURE: Please report', + 'the message above to the HelpDesk at |', + ' APPEND LITERAL 502/852-7997. |', + ' > $$CAL$$' Caluser 'A |', + ' HOLE' + end + end + end /* end for Select to Evaluate Authorized_result */ + + 'PUNCH $$CAL$$' Caluser 'A' + 'CHANGE * PUN ALL CLASS Z' + 'TRANSFER PUN ALL TO' Calrequester 'RDR' + 'ERASE $$CAL$$' Caluser 'A' + say 'Transmitted calendar query results to' Calrequester'.' + end /* End for Not Admin Request processing */ + end /* end for WAKEUP rc = 1 processing */ + + when (rc=6) then Quit_flag="YES" /* Console interrupt */ + + otherwise nop + end /* end for first select to evaluate WAKEUP responses */ +end /* end major Do While on Quit_flag test */ + +say 'STUDENTS service machine processing stopped.' + +if (logoffserver = "TRUE") then do + "TELL" Calrequester "STUDENTS service machine logged off." + queue "LOGOFF" +end + +exit + +AuthorizedToView: procedure + + Arg Caluser,Calrequester + + /* Make sure there is not an old file left on A already. */ + 'PIPE CMS STATE $$CAL$$' Caluser 'A | HOLE' + if (rc = 0) then 'ERASE $$CAL$$' Caluser 'A' + + 'OFFICE APPOINTM AU' Caluser 'FILE' + + select + when (rc = 12) then + authorize_status="NOTOV" + when (rc = 76) then + authorize_status="NO" + when (rc = 0) then do /* Authorization file returned */ + 'PIPE < $$CAL$$' Caluser' A |', + ' LOCATE /'Calrequester'/ |', + ' VAR Auth_results |', + ' HOLE' + if (Auth_results = "AUTH_RESULTS") then /* no restrictions */ + authorize_status = "YES" + else do /* Found requestor userid in the authorization list */ + Time_auth=substr(Auth_results,41,1) + View_auth=substr(Auth_results,46,1) + if ((Time_auth = "N") & (View_auth = "N")) then + authorize_status = "NO_VIEW_ALLOWED" + end + end /* end on do when authorization file returned */ + otherwise do /* (rc ^= 0) */ + authorize_status="PROBLEM" + say 'STUDENTS could not obtain calendar authorizations for', + Caluser'.' + end + 'ERASE $$CAL$$' Caluser 'A' + + end /* end on select */ + +return authorize_status \ No newline at end of file diff --git a/vmworkshop-vmarcs/1995/stumai95/tellprmt.exec b/vmworkshop-vmarcs/1995/stumai95/tellprmt.exec new file mode 100644 index 0000000..db25200 --- /dev/null +++ b/vmworkshop-vmarcs/1995/stumai95/tellprmt.exec @@ -0,0 +1,6 @@ +/* TELLPRMT EXEC - Front end for TELL command. +Author: Barbara Jones, IT-DCS, 6/13/94 +Requires: DOPANEL EXEC, TELLPRMT XEDIT (by PDL, IT-DCS) +History: 07/27/94 In Production (without help screens) +*/ +'DOPANEL TELLPRMT' diff --git a/vmworkshop-vmarcs/1995/stumai95/tellprmt.helpcms b/vmworkshop-vmarcs/1995/stumai95/tellprmt.helpcms new file mode 100644 index 0000000..932b74b --- /dev/null +++ b/vmworkshop-vmarcs/1995/stumai95/tellprmt.helpcms @@ -0,0 +1,72 @@ +.cm ******************************************************************** +.cm ** ** +.cm ** Help for TELLPRMT ** +.cm ** ** +.cm ** 08141994 PDL Initial Development. ** +.cm ** 08151994 PDL Added proper .cs blocks ** +.cm ** ** +.cm ******************************************************************** +.cs 1 on +TELLPRMT SEND INTERACTIVE MESSAGE + +General Instructions +-------------------- + +After filling in all of the fields on the screen, press ENTER to send +your message to the recipient. The nickname or userid may be entered +in any case; it is case insensitive. However, input your message +exactly as you want it to appear to the recipient. + +.cs 1 off +.cs 2 on +Field Descriptions +------------------ + +Nickname or You may specify any valid nickname or userid. If the +UserID user you are trying to communicate with is at a different + node (and that node is a BITNET node), you may also + specify that user as "userid AT node". Such userids with + nodes may also be placed in your nickname file. You may + not specify Internet domains with this screen. In + addition, you also can not specify the words "AT" or + "CC:" as valid userids. + +Message type your message exactly as you want it to appear to + the recipient. You may use any wording you like up to + the maximum number of characters. + +Key Descriptions +---------------- + +PF1/PF9 (Help) Brings you to this help screen. + +PF3/PF12 (Quit) Exits without sending a message to a recipient. + +.cs 2 off +.cs 5 on +Usage Notes +----------- + +1. After all of the fields have been filled in and you have pressed + ENTER, you will be returned to the menus. The message has been + sent. However, if the recipient you are sending the message to + is not logged on to the system (or node specified), you will + receive a message stating that the recipient is not logged on. + Recipients must be logged on to receive interactive messages. + +2. The "SEND INTERACTIVE MESSAGE" screen was designed to make it easier + to send messages to recipients; however, you may also use the actual + command to do this. To send messages to someone, use the following + command: + + TELL userid messagetext + + TELL userid AT node messagetext + + where "userid" is the id of the recipient, "messagetext" is the + message you want to send, and "node" is the node the person is + logged on to. You may use the first form of the TELL command if + the recipient is logged on to the U of L system (ULKYVM). The + second form of the TELL command is to be used when the recipient + is logged on to a distant node, such as the U of K system. +.cs 5 off \ No newline at end of file diff --git a/vmworkshop-vmarcs/1995/stumai95/tellprmt.xedit b/vmworkshop-vmarcs/1995/stumai95/tellprmt.xedit new file mode 100644 index 0000000..7b59862 --- /dev/null +++ b/vmworkshop-vmarcs/1995/stumai95/tellprmt.xedit @@ -0,0 +1,391 @@ +/* */ +/* TELLPRMT XEDIT */ +/* */ +/* Usage: This file is to be used by either invoking the DOPANEL */ +/* command and supplying the command with the name of this */ +/* panel or invoking a XEDIT session on a file with this */ +/* file specified as the PROFILE to be used. */ +/* */ +/* TELLPRMT is a XEDIT file containing various XEDIT and REXX */ +/* instructions combined to construct an input panel and the */ +/* instructions necessary to process the input gathered from the */ +/* customer. See the USAGE statement above for information on how */ +/* to invoke the TELLPRMT panel. */ +/* */ +/* Exit Code Definitions: */ +/* Not applicable. */ +/* */ +/* Mod Date Init Description */ +/* -------- ---- ------------------------------------------------- */ +/* 06291994 PDL Initial development. */ +/* 07071994 PDL Combined Nickname/UserID Fields. */ +/* 07211994 PDL Added message handler */ +/* 07211994 PDL Added code to un-RESERVE XEDIT lines. */ +/* 07211994 PDL Combined the Nickname/UserID (previously */ +/* combined) and the Node field. For all three items*/ +/* there now exists only one field. The one field */ +/* will be named "Nickname or UserID" and will be */ +/* expanded to allow 20 characters (to accomodate */ +/* "idornick at nodeidxx"). */ +/* 07211994 PDL Added code to allow the word "AT" to be the first */ +/* word of a message. Added because of a TELL */ +/* command restriction. */ +/* 07221994 PDL Also added code to not allow "AT" or "CC:" to be */ +/* used as a userid. Added because of a TELL */ +/* command restriction. */ +/* 07221994 PDL Removed BETA descriptor from panel. Code level */ +/* 107 is intended for first public release. */ +/* */ + +level="107" + +/* Define the control characters for panel definition */ +address xedit +"SET CTLCHAR % ESCAPE" +"SET CTLCHAR @ PROTECT HIGH" +"SET CTLCHAR ! PROTECT NOHIGH" +"SET CTLCHAR $ NOPROTECT HIGH" + +/* Set up the XEDIT environment for panel definition */ +"SET CASE MIXED" +"SET LINEND OFF" +"SET TOFEOF OFF" +"SET PREFIX OFF" +"SET SCALE OFF" +"SET MSGLINE ON 21 2" +"SET CMDLINE OFF" +"SET MSGMODE ON" +"VERIFY OFF 1 80" + +/* Ensure the PF keys are defined as we need them so */ +/* that we can avoid the problem with a key defined */ +/* as TABKEY, COPYKEY, NULLKEY, or CP BRKKEY (which */ +/* will cause a XEDIT READ to -NOT- terminate). We */ +/* cannot have this. */ +do index=1 to 24 + "SET PF"index "BEFORE EMSG INTERNAL FAILURE: EXIT", + "IMMEDIATELY AND REPORT THIS TO THE HELPDESK (7997)" +end + +/* Make sure that we set the appropriate PF */ +/* keys with a QQUIT definition. This is to*/ +/* make sure the customer can get out even */ +/* though an internal failure has occurred. */ +"SET PF3 BEFORE QQUIT" +"SET PF12 BEFORE QQUIT" +"SET PF15 BEFORE QQUIT" +"SET PF24 BEFORE QQUIT" + +/* "un-RESERVE" all of the XEDIT lines */ +/* that were reserved, if any. */ +"EXTRACT /RESERVED */" +do index=1 to RESERVED.0 + parse var RESERVED.index linenum otherstuff + "SET RESERVED" linenum "OFF" +end + +address command + +/* Request that the panel be constructed, and place the cursor */ +/* at the first input field. */ +call BuildDisplay +address xedit "CURSOR SCREEN 10 12" + +/* Initialize all input variables */ +nickname="" +/* CODE PRIOR TO 07071994 MODIFICATION */ +/* userid="" */ +/* CODE DISABLED -- 07211994 MODIFICATION */ +/* node="" */ +message1="" +message2="" + +/* Begin processing of the panel. The "status" variable */ +/* indicates what mode we are in. */ +/* Status=0 indicates that the customer has submitted the */ +/* panel for processing. Syntax/Field checking */ +/* is performed as required, and if no problem is*/ +/* found then the external command is */ +/* constructed and executed. */ +/* Status=1 indicates that reading of the panel is to */ +/* continue until otherwise indicated. */ +/* Status=2 indicates that an exit from the panel has been*/ +/* requested. */ +/* Status=3 indicates that help has been requested. */ +status=1 +do while (status = 1) + + /* Request that the panel be rebuilt to reflect customer entries */ + call BuildDisplay + /* Request that XEDIT read the panel and return the results */ + address xedit "READ NOCHANGE NUMBER TAG" + + /* Process the results of the XEDIT READ until no more are left */ + do queued() + parse pull tag line column data + + /* If the result was from an input field, then process it */ + if tag = "RES" then do + /* Remove all blanks and underscore characters from */ + /* the input */ + data=strip(data,trailing,"_") + data=strip(data) + select + /* Line 10, Column 12 is the nickname/id/node field */ + when (line = 10) & (column = 12) then do + nickname=data + upper nickname + end + + /* CODE INACTIVATED PER 07071994 MODIFICATION */ + /* Line 10, Column 40 is the userid field */ + /* when (line = 10) & (column = 40) then do */ + /* userid=data */ + /* upper userid */ + /* end */ + + /* CODE DISABLED -- 07211994 MODIFICATION */ + /* Line 10, Column 31 is the node field */ + /* when (line = 10) & (column = 31) then do */ + /* node=data */ + /* upper node */ + /* end */ + + /* Line 13 is the message field, line one */ + when line = 13 + then message1=data + /* Line 15 is the message field, line two */ + when line = 15 + then message2=data + otherwise nop + end + + end + + /* If the customer pressed a PF key, process it */ + if tag = "PFK" then do + + select + /* If the customer pressed PF1, PF13, PF9, or PF21 */ + /* then help for the panel is requested. */ + when (line = 1) | (line = 13) |, + (line = 9) | (line = 21) then status=3 + /* If the customer pressed PF3, PF15, PF12, or PF24 */ + /* then the customer wishes to exit. */ + when (line = 3) | (line = 15) |, + (line = 12) | (line = 24) then do + "DESBUF" + status=2 + leave + end + /* Otherwise, the PF key is not defined to us. */ + otherwise + message="PFKey is not defined." + call display_message + end + + end + + /* If the customer pressed the ENTER key, then set the */ + /* status flag to "check/process input panel". */ + if tag = "ETK" then status=0 + + end + + /* The customer requested assistance for the panel. */ + if status = 3 then do + /* Resume panel input/processing */ + address command "HELP TELLPRMT" + status=1 + end + + /* Was panel checking/processing requested? */ + if status = 0 then do + + /* Let us break up the towhom field into "userid at node" */ + /* and then determine if there are any errors... */ + parse upper var nickname checkid splitter checknode + + /* Check to see if we have any "error" conditions... */ + select + /* Scenario 1: The customer has not supplied any of the */ + /* fields with data. */ + when (nickname = "") &, + (message1 = "") & (message2 = "") then do + status=1 + message="Please supply the fields above", + "with the proper data, or press the QUIT", + "PFKey to exit this screen." + call display_message + address xedit "CURSOR SCREEN 10 12" + end + + /* Scenario 2: The customer has specified a separator */ + /* and node without a userid. */ + when (checkid = "AT") & (splitter ^= "") &, + (splitter ^= "AT") then do + status=1 + message="A userid must be specified. Press PF1 for", + "assistance on how to send a message to someone", + "on another system." + call display_message + address xedit "CURSOR SCREEN 10 12" + end + + /* Scenario 3: The customer has specified a userid with */ + /* a separator but without a node specified. */ + when (checkid ^= "") & (splitter = "AT") &, + (checknode = "") then do + status=1 + message="A node must be specified. Press PF1 for", + "assistance on how to send a message to someone", + "on another system." + call display_message + address xedit "CURSOR SCREEN 10 12" + end + + /* Scenario 4: The customer has specified a userid */ + /* and a node without a separator. */ + when (checkid ^= "") & (splitter ^= "AT") &, + (splitter ^= "") & (checknode = "") then do + status=1 + message="The userid and node must be separated by the", + "text 'AT'. Press PF1 for assistance on how", + "to send a message to someone on another system." + call display_message + address xedit "CURSOR SCREEN 10 12" + end + + /* SCENARIO 5 INACTIVE PER 07071994 MODIFICATION */ + /* Scenario 5: The customer has supplied both a nickname */ + /* and a userid and node. Only one is needed*/ + /* when (nickname ^= "") &, */ + /* ((userid ^= "") | (node ^= "")) then do */ + /* status=1 */ + /* message="Specify either a nickname or a", */ + /* "userid and a node." */ + /* call display_message */ + /* address xedit "CURSOR SCREEN 10 12" */ + /* end */ + + /* Scenario 6: The customer has specified "AT" or "CC:" */ + /* as a userid. */ + when (checkid = "AT") | (checkid = "CC:") then do + status=1 + message="The words 'AT' and 'CC:' can not be used as", + "a userid." + call display_message + address xedit "CURSOR SCREEN 10 12" + end + + /* Scenario 7: The customer has supplied a destination */ + /* but no message. */ + when (message1 = "") & (message2 = "") then do + status=1 + message="A message must be supplied." + call display_message + address xedit "CURSOR SCREEN 13 12" + end + /* Scenario 8: The customer has supplied a message, but */ + /* has not given a nickname or userid/node. */ + when ((message1 ^= "") | (message2 ^= "")) &, + (nickname = "") then do + status=1 + message="A nickname or userid", + "must be supplied." + call display_message + address xedit "CURSOR SCREEN 10 12" + end + otherwise nop + end + + end +end + +/* If status is still zero then we have passed the panel checks. */ +/* Now let us construct and perform the command for the customer. */ +if status = 0 then do + /* Form the message */ + message=space(message1||" "||message2) + + /* Now send the message */ + /* First, if the customer did not use the full fledged */ + /* syntax to describe who to send the */ + /* message to, then we will expand it to that format to */ + /* prevent a problem with the TELL command restriction */ + /* where the first word of the message cannot be "AT" */ + /* unless the full fledged syntax is used. */ + if words(nickname) = 1 then + address cms "TELL" nickname "AT ULKYVM" message + else + address cms "TELL" nickname message +end + +address xedit "QQUIT" +exit + +/* Construct the input panel for the customer... */ +BuildDisplay: +address xedit +"SET RESERVED 1 N %!TELLPRMT %@SEND INTERACTIVE", + "MESSAGE%! LEVEL"level +"SET RESERVED 5 N %@To send an interactive message to someone, enter", + "the nickname or userid and%!" +"SET RESERVED 6 N %@node of that person and then enter the message", + "that you want to send.%!" + +/* CODE PRIOR TO 07071994 MODIFICATION */ +/* "SET RESERVED 10 N %!Nickname %$"left(nickname,8,"_")"%! ", */ +/* " or UserID %$"left(userid,8,"_")"%! at Node", */ +/* "%$"left(node,8,"_")"%!" */ + +/* CODE PRIOR TO 07211994 MODIFICATION */ +/* "SET RESERVED 9 N %!Nickname%!" */ +/* "SET RESERVED 10 N %!or UserID%$"left(nickname,8,"_")"%!", */ +/* "at Node %$"left(node,8,"_")"%!" */ + +"SET RESERVED 9 N %!Nickname%!" +"SET RESERVED 10 N %!or UserID%$"left(nickname,20,"_")"%!" +"SET RESERVED 13 N %!Message %$"left(message1,60,"_")"%!" +"SET RESERVED 15 N %! %$"left(message2,60,"_")"%!" +"SET RESERVED -1 N %@PF1/PF9%! Help %@PF3/PF12%! Quit" +address command +return + +display_message: + +if message ^= "" then do + /* Now format the message for proper display */ + nextword="" + msglines.0=1 + msgindex=msglines.0 + do index=1 to 2 + msglines.index="" + end + do index=1 to words(message) + msgindex=msglines.0 + nextword=word(message,index) + /* If we can fit the next word into the line, then do so */ + if (length(msglines.msgindex)+length(nextword)) <= 78 then + if length(msglines.msgindex) = 0 then + msglines.msgindex=nextword + else + msglines.msgindex=msglines.msgindex||" "||nextword + /* Otherwise, pad the rest of the current line, */ + /* and start a new line. */ + else do + msglines.msgindex=left(msglines.msgindex,79) + msglines.0=msglines.0+1 + msgindex=msglines.0 + msglines.msgindex=nextword + end + end + msgtodisplay="" + do index=1 to msglines.0 + msgtodisplay=msgtodisplay||msglines.index + end + address xedit "EMSG" msgtodisplay + message="" +end + +return diff --git a/vmworkshop-vmarcs/1995/stumai95/whoisit.exec b/vmworkshop-vmarcs/1995/stumai95/whoisit.exec new file mode 100644 index 0000000..1a18de0 --- /dev/null +++ b/vmworkshop-vmarcs/1995/stumai95/whoisit.exec @@ -0,0 +1,55 @@ +/********************************************************************** + * WHOISIT EXEC - Shell to call WHOIS with some input params to * + * let WHOIS be called from OV menus. * + ********************************************************************** + * * + * Author : Victoria Harpe 4/17/93 * + * * + * +-------------+----------+------------+---------------------+ * + * | Rev. Number | Date | Programmer | Reason For Revision | * + * +=============+==========+============+=====================+ * + * | 1 | 4/27/93 |V Harpe |Add Messages Waiting | * + * | | | |and default to NAME | * + * +-------------+----------+------------+---------------------+ * + * | 2 | 5/7/93 |V Harpe |Add Help info; add | * + * | | | |default info | * + * +-------------+----------+------------+---------------------+ * + * 05/13/93 baj Changed wording; spaced responses out more. * + * * + **********************************************************************/ + +TRACE ON +SET EMSG OFF + +MAKEBUF + +SAY ' ' +SAY' Enter the name, dept or phone number you are looking for:' +PULL INFO + +SAY ' ' + +SAY 'Is this a NAME, DEPT, or PHONE: (if it is a name, just press ENTER)' +PULL WHAT_FIELD +IF WHAT_FIELD = "" then WHAT_FIELD = NAME + +'CLRSCRN' +say ' ' +SAY 'The command just entered for you is: WHOIS FIND', + WHAT_FIELD' 'INFO +SAY " " +SAY " " +SAY ' Searching ....' +SAY '' +SAY ' ' +SAY 'To learn more about WHOIS, enter HELP WHOIS at the OV command', + 'line.' +say '' +say '' +SAY '(Remember to press the Clear key when you see MORE..., HOLDING, ' +say ' or Messages Waiting.)' +say '' +say '' +'WHOIS FIND 'WHAT_FIELD' 'INFO +SET EMSG ON +EXIT diff --git a/vmworkshop-vmarcs/1995/stumai95/whosit.helpcms b/vmworkshop-vmarcs/1995/stumai95/whosit.helpcms new file mode 100644 index 0000000..9e54071 --- /dev/null +++ b/vmworkshop-vmarcs/1995/stumai95/whosit.helpcms @@ -0,0 +1,101 @@ +.cm ******************************************************************** +.cm ** ** +.cm ** Help for WHOSIT ** +.cm ** ** +.cm ** 08141994 PDL Initial Development. ** +.cm ** 08151994 PDL Added .cs control blocks ** +.cm ** ** +.cm ******************************************************************** +.cs 1 on +WHOSIT WHOIS ELECTRONIC DIRECTORY + +General Instructions +-------------------- + +After filling in the required fields on the screen, press ENTER to +submit your directory lookup request. You may fill in either the "For +Brief Information..." fields or the "For Extended Information..." fields +or both sets of fields. All of the fields are case-insensitive. + +.cs 1 off +.cs 2 on +Field Descriptions +------------------ + +For Brief Information... This set of fields when properly filled in + and submitted will return the userid and + node of the person searched for, the voice + telephone number, the full name, and whether + or not they are currently on the system. + + Name of Person Enter any part or all of the name of the + person that you are searching. + + Specify Type of Search... Select one of the following choices by + placing an "X" beside the item. + + Search only at U of L Selecting this type of search will result + in only the U of L database being searched. + + Search throughout the KY Educational Computing Network + Selecting this type of search will result + in all of the databases at each of the + KECNET member schools to be searched. + +For Extended Information... This set of fields when properly filled in + and submitted will return the full database + entry for the person searched for. + + Specify the Userid... Enter the userid of the person that you are + searching for. The userid may be up to 8 + characters in length. + + Specify the Node... Enter the node where the person you are + searching for is located. If the person you + are searching for is at U of L (node + ULKYVM), then there is no need to fill in + this field. + +Key Descriptions +---------------- + +PF1/PF9 (Help) Brings you to this help screen. + +PF3/PF12 (Quit) Exits without sending a query to the WHOIS + database. + +.cs 2 off +.cs 5 on +Usage Notes +----------- + +1. After the relevant fields have been filled in and you have pressed + ENTER, the screen will be cleared and a message stating that your + query has been submitted to the WHOIS database server will appear. + Your request will also be re-displayed. At that point, press the + CLEAR key to return to the menus. Your query response will be + returned to you in the message area of the menus (the lower portion + of the screen). The response may occupy more space than one screen + can display (a "MESSAGES WAITING" will appear in the lower right + corner). If this is the case, you will need to press the CLEAR + key to go to the next screen of messages/responses. + +2. The "WHOIS ELECTRONIC DIRECTORY" screen was designed to make it + easier to query the WHOIS database. However, you may also use the + actual command to do this. For example, to find a person with the + name of "John Public", you would need to issue the following + command: + + WHOIS FIND John Public + + Other forms of the WHOIS command are available as well. For more + assistance with the WHOIS command, please type "HELP WHOIS". + +3. When the query response is returned from the WHOIS database, you + should be aware that the information you see about a person may not + be entirely up to date. Updates and changes to the database are + completely under the control of the person whose entry is in the + database. If the owner of the entry does not update the database + in a regular fashion, then the information on that owner may become + out of date. Please keep this mind. +.cs 5 off \ No newline at end of file diff --git a/vmworkshop-vmarcs/1995/stumai95/whosit.location b/vmworkshop-vmarcs/1995/stumai95/whosit.location new file mode 100644 index 0000000..0c6ce0e --- /dev/null +++ b/vmworkshop-vmarcs/1995/stumai95/whosit.location @@ -0,0 +1,8 @@ +UK +UL +MDU +MSU +TU +WKU +EKU +NKU \ No newline at end of file diff --git a/vmworkshop-vmarcs/1995/stumai95/whosit.xedit b/vmworkshop-vmarcs/1995/stumai95/whosit.xedit new file mode 100644 index 0000000..c2ec4df --- /dev/null +++ b/vmworkshop-vmarcs/1995/stumai95/whosit.xedit @@ -0,0 +1,377 @@ +/* */ +/* WHOSIT XEDIT */ +/* */ +/* Usage: This file is to be used by either invoking the DOPANEL */ +/* command and supplying the command with the name of this */ +/* panel or invoking a XEDIT session on a file with this */ +/* file specified as the PROFILE to be used. */ +/* */ +/* WHOSIT is a XEDIT file containing various XEDIT and REXX */ +/* instructions combined to construct an input panel and the */ +/* instructions necessary to process the input gathered from the */ +/* customer. See the USAGE statement above for information on how */ +/* to invoke the WHOSIT panel. */ +/* */ +/* Exit Code Definitions: */ +/* Not applicable. */ +/* */ +/* Mod Date Init Description */ +/* -------- ---- ------------------------------------------------- */ +/* 06291994 PDL Initial development. */ +/* 07071994 PDL Fixed position problem with "KECNET search */ +/* not available" item display. */ +/* 07071994 PDL Inserted text "WHOIS" into panel title. Now will */ +/* read "WHOIS ELECTRONIC DIRECTORY". */ +/* 07211994 PDL Added message handler. */ +/* 07211994 PDL Added code to un-RESERVE XEDIT lines. */ +/* 07211994 PDL Combined First and Last Name fields into one field*/ +/* titled "Name". */ +/* 07221994 PDL Removed BETA descriptor from panel. Release level*/ +/* 106 intended for public release. */ +/* */ + +level="106" + +/* Define the control characters for panel definition */ +address xedit +"SET CTLCHAR % ESCAPE" +"SET CTLCHAR @ PROTECT HIGH" +"SET CTLCHAR ! PROTECT NOHIGH" +"SET CTLCHAR $ NOPROTECT HIGH" + +/* Set up the XEDIT environment for panel definition */ +"SET CASE MIXED" +"SET LINEND OFF" +"SET TOFEOF OFF" +"SET PREFIX OFF" +"SET SCALE OFF" +"SET MSGLINE ON 21 2" +"SET CMDLINE OFF" +"SET MSGMODE ON" +"VERIFY OFF 1 80" + +/* Ensure the PF keys are defined as we need them so */ +/* that we can avoid the problem with a key defined */ +/* as TABKEY, COPYKEY, NULLKEY, or CP BRKKEY (which */ +/* will cause a XEDIT READ to -NOT- terminate). We */ +/* cannot have this. */ +do index=1 to 24 + "SET PF"index "BEFORE EMSG INTERNAL FAILURE: EXIT", + "IMMEDIATELY AND REPORT THIS TO THE HELPDESK (7997)" +end + +/* Make sure that we set the appropriate PF */ +/* keys with a QQUIT definition. This is to*/ +/* make sure the customer can get out even */ +/* though an internal failure has occurred. */ +"SET PF3 BEFORE QQUIT" +"SET PF12 BEFORE QQUIT" +"SET PF15 BEFORE QQUIT" +"SET PF24 BEFORE QQUIT" + +/* "un-RESERVE" all of the XEDIT lines */ +/* that were reserved, if any. */ +"EXTRACT /RESERVED */" +do index=1 to RESERVED.0 + parse var RESERVED.index linenum otherstuff + "SET RESERVED" linenum "OFF" +end + +address command + +/* Does the WHOSIT LOCATION file exist? (This file contains the */ +/* KECNET locations that can be queried.) If not, indicate that */ +/* the KECNET search option is not available. */ +address cms "PIPE CMS STATE WHOSIT LOCATION * | HOLE" +if RC = 28 then locfile="NOTEXIST" +else locfile="EXIST" + +/* Request that the panel be constructed, and place the cursor */ +/* at the first input field. */ +call BuildDisplay +address xedit "CURSOR SCREEN 10 29" + +/* Initialize all input variables */ +name="" +/* VARIABLES REMOVED PER 07221994 MODIFICATION */ +/* firstname="" */ +/* lastname="" */ +searchuofl="X" +searchkecn="" +userid="" +node="" + +/* Begin processing of the panel. The "status" variable */ +/* indicates what mode we are in. */ +/* Status=0 indicates that the customer has submitted the */ +/* panel for processing. Syntax/Field checking */ +/* is performed as required, and if no problem is*/ +/* found then the external command is */ +/* constructed and executed. */ +/* Status=1 indicates that reading of the panel is to */ +/* continue until otherwise indicated. */ +/* Status=2 indicates that an exit from the panel has been*/ +/* requested. */ +/* Status=3 indicates that help has been requested. */ +status=1 +do while (status = 1) + + /* Request that the panel be rebuilt to reflect customer entries */ + call BuildDisplay + /* Request that XEDIT read the panel and return the results */ + address xedit "READ NOCHANGE NUMBER TAG" + + /* Process the results of the XEDIT READ until no more are left */ + do queued() + parse pull tag line column data + + /* If the result was from an input field, then process it */ + if tag = "RES" then do + /* Remove all blanks and underscore characters from the */ + /* input */ + data=strip(data,trailing,"_") + data=strip(data) + upper data + select + /* Line 10 is the name field. */ + when (line = 10) + then name=data + /* Line 10, Column 36 is the firstname field */ + /* when (line = 10) & (column = 36) */ + /* then firstname=data */ + /* Line 10, Column 59 is the lastname field */ + /* when (line = 10) & (column = 59) */ + /* then lastname=data */ + /* Line 13 is the search UofL domain selection */ + when line = 13 + then do + searchuofl=data + if searchuofl ^= "" then searchuofl="X" + end + /* Line 14 is the search KECNET domain selection */ + when line = 14 + then do + searchkecn=data + if searchkecn ^= "" then searchkecn="X" + end + /* Line 18 is the user identification field */ + when line = 18 + then userid=data + /* Line 19 is the user node field */ + when line = 19 + then node=data + otherwise nop + end + + end + + /* If the customer pressed a PF key, process it */ + if tag = "PFK" then do + + select + /* If the customer pressed PF1, PF13, PF9, or PF21 */ + /* then help is requested on the panel. */ + when (line = 1) | (line = 13) |, + (line = 9) | (line = 21) then status=3 + /* If the customer pressed PF3, PF15, PF12, or PF24 */ + /* then the customer wishes to exit. */ + when (line = 3) | (line = 15) |, + (line = 12) | (line = 24) then do + "DESBUF" + status=2 + leave + end + /* Otherwise, the PF key is not defined to us. */ + otherwise + message="PFKey is not defined." + call display_message + end + + end + + /* If the customer pressed the ENTER key, then set the */ + /* status flag to "check/process input panel". */ + if tag = "ETK" then status=0 + + end + + /* The customer requested assistance for the panel. */ + if status = 3 then do + address command "HELP WHOSIT" + /* Now, let us resume panel input/processing */ + status=1 + end + + /* Was panel checking/processing requested? */ + if status = 0 then do + + /* Check to see if we have any "error" conditions... */ + select + /* Scenario 1: The customer has given no firstname, */ + /* lastname, or userid to lookup. */ + when (userid = "") & (name = "") & (node = "") then do + status=1 + message="To perform a lookup, you must", + "at least specify either a name or a userid." + call display_message + address xedit "CURSOR SCREEN 10 29" + end + /* Scenario 2: The customer has requested that both the */ + /* UofL and KECNET domains be searched. */ + when (searchuofl ^= "") & (searchkecn ^= "") then do + status=1 + message="You can only request a search", + "in one domain at a time. Please select", + "either the UofL or KECNET", + "search domain." + call display_message + address xedit "CURSOR SCREEN 13 19" + end + /* Scenario 3: The customer has requested a brief search*/ + /* but has not indicated a search domain. */ + when (searchuofl = "") & (searchkecn = "") &, + (name ^= "") then do + status=1 + message="You must specify a search domain", + "to perform a search. Please select", + "either the UofL or KECNET search domain." + call display_message + address xedit "CURSOR SCREEN 13 19" + end + /* Scenario 4: The customer has indicated the desire for*/ + /* an extended search by supplying a node, */ + /* but a userid is also required. */ + when (userid = "") & (node ^= "") then do + status=1 + message="You must specify a userid", + "in addition to the node to perform", + "an extended search." + call display_message + address xedit "CURSOR SCREEN 18 32" + end + otherwise nop + end + + end +end + +/* If status is still zero then we have passed the panel checks. */ +/* Now let us construct and perform the command for the customer. */ +if status = 0 then do + address cms "CLRSCRN" + say "Your query has been submitted to the WHOIS server." + say "Please wait for a response." + say "" + say "Your query or queries were:" + + /* Was a brief search requested? */ + if (name ^= "") then do + /* Do we search only the UofL domain? */ + if (searchuofl ^= "") then do + say " Search the UofL directory for <"name">" + address cms "WHOIS FIND AT UL" name + end + /* Do we search all of KECNET? */ + if (searchkecn ^= "") then do + say " Search the KECNET directory for <"name">" + /* Read in the locations to search from WHOSIT LOCATION */ + address cms "PIPE < WHOSIT LOCATION * |", + " SPEC /WHOIS FIND AT/ 1", + " WORD 1 NEXTWORD |", + " STACK FIFO" + lastindex=queued() + do index=1 to lastindex + parse pull commandtext.index + end + do index=1 to lastindex + address cms commandtext.index name + end + end + end + /* Did the customer request an extended search? */ + if (userid ^= "") then + if (node = "") then do + say " Search for <"userid"> in the directory" + address cms "WHOIS SHOW" userid + end + else do + say " Search for <"userid"@"node"> in the directory" + address cms "WHOIS SHOW" userid"@"node + end +end + +address xedit "QQUIT" +exit + +/* Construct the input panel for the customer... */ +BuildDisplay: +address xedit +"SET RESERVED 1 N %!WHOSIT %@WHOIS ELECTRONIC", + "DIRECTORY%!", + " LEVEL"level +"SET RESERVED 4 N %@Enter the information for the person", + "you are searching for below. You may%!" +"SET RESERVED 5 N %@request both types of information by", + "completing all fields.%!" +"SET RESERVED 8 N %! For Brief Information...%!" +"SET RESERVED 10 N %! Name of Person:", + "%$"left(name,30,"_")"%!" +"SET RESERVED 12 N %! Specify Type of Search (pick one only)%!" +"SET RESERVED 13 N %! ", + "{%$"left(searchuofl,1,"_")"%!} Search only at", + "U of L%!" + +if locfile = "EXIST" then +"SET RESERVED 14 N %! ", + "{%$"left(searchkecn,1,"_")"%!} Search throughout", + "the KY Educational Computing Network%!" +else +"SET RESERVED 14 N %! ", + " %!*%! KECNET Search Not Available%!" + +"SET RESERVED 16 N %! For Extended Information...%!" +"SET RESERVED 18 N %! Specify the Userid", + "%$"left(userid,8,"_")"%!" +"SET RESERVED 19 N %! Specify the Node ", + "%$"left(node,8,"_")"%!" +"SET RESERVED -1 N %@PF1/PF9%! Help %@PF3/PF12%! Quit" +address command +return + +display_message: + +if message ^= "" then do + /* Now format the message for proper display */ + nextword="" + msglines.0=1 + msgindex=msglines.0 + do index=1 to 2 + msglines.index="" + end + do index=1 to words(message) + msgindex=msglines.0 + nextword=word(message,index) + /* If we can fit the next word into the line, then do so */ + if (length(msglines.msgindex)+length(nextword)) <= 78 then + if length(msglines.msgindex) = 0 then + msglines.msgindex=nextword + else + msglines.msgindex=msglines.msgindex||" "||nextword + /* Otherwise, pad the rest of the current line, */ + /* and start a new line. */ + else do + msglines.msgindex=left(msglines.msgindex,79) + msglines.0=msglines.0+1 + msgindex=msglines.0 + msglines.msgindex=nextword + end + end + msgtodisplay="" + do index=1 to msglines.0 + msgtodisplay=msgtodisplay||msglines.index + end + address xedit "EMSG" msgtodisplay + message="" +end + +return diff --git a/vmworkshop-vmarcs/1995/sun2ie95/README.md b/vmworkshop-vmarcs/1995/sun2ie95/README.md new file mode 100644 index 0000000..98aafcf --- /dev/null +++ b/vmworkshop-vmarcs/1995/sun2ie95/README.md @@ -0,0 +1,51 @@ +# ibm-sun(3,L) - IBM-Sun data conversion + +"", 3 June 1991 + + + + +# Purpose + +Converts SUN 386i workstation floating point data to a regular IEEE format for further use in computation. Assumes the data have been transferred from the workstation in binary format using ftp. + + + +# Library + +faux, Cornell's Fortran Auxiliary Library (libfaux.a) + + + +# Syntax + +``` +call drvsun(sund, ieee64, n) + + where: + sund -- SUN array of double words + ieee64 -- array of regular IEEE double presision numbers + n -- number of double words to convert + +call srvsun(suns, ieee32, m) + + where: + suns -- SUN array of single words + ieee32 -- array of regular IEEE single presision numbers + m -- number of words to revolve. +``` + + + +# Description + +Calling these routines you can convert (actually Revolve) bytes in double words of SUN 386i workstation data so that they are available for further use as regular IEEE format data. + +The SUN 368i keeps every single data element (integer, logical, and real*4 in words and real*8 in double words) in bytes "from higher addresses to lower addresses" which is opposite to what other computers do. + + + +# Notes + +1. Input and output data could be located at the same space. +2. Twice reversed data returns to its source. diff --git a/vmworkshop-vmarcs/1995/sun2ie95/drvsun.assemble b/vmworkshop-vmarcs/1995/sun2ie95/drvsun.assemble new file mode 100644 index 0000000..5d8190f --- /dev/null +++ b/vmworkshop-vmarcs/1995/sun2ie95/drvsun.assemble @@ -0,0 +1,113 @@ + TITLE ' Revolving of bytes in double words of SUN data ' +* --------------------------------------------------------------------* +* subroutine drvsun(from, to, n) * +* integer n * +* double precision from(n), to(n) * +* --------------------------------------------------------------------* +* PROCESSOR - ASSEMBLE H, VERSION 2, RELEASE 1. * +* * +* DEPENDENCES - NONE * +* * +* ATTRIBUTES - REENTERANT * +* * +* ENTRY POINT - DRVSUN: Double word's bytes ReVersing in SUN 386i's * +* data. * +* * +* STATUS - NEW: 05/17/90 * +* * +* Val I. Garger, Technology Integration * +* Group, CNSF, Cornell University * +* * +* vig@cornellf.tn.cornell.edu * +* vig@eagle.tn.cornell.edu * +* vig@cornellf.bitnet * +*-------------------------------------------------------------------- * +* * +* COPYRIGHT - VAL GARGER, CORNELL NATIONAL SUPERCOMPUTER FACILITY, * +* (JUNE 1990) CORNELL UNIVERSITY, ITHACA, NY. * +* CONTAINS RESTRICTED MATERIALS OF CORNELL UNIVERSITY, * +* (C) COPYRIGHT CORNELL UNIVERSITY 1990 * +* * +* --------------------------------------------------------------------* +* Reversing of bytes in double words in SUN 386i workstation data. * +* This is to further use of SUN's data FTPed to any other computer as * +* regular IEEE format data. * +* * +* input: from SUN array of double words. * +* n Number of double words to revolve. * +* output: to regular IEEE double words (like real*8). * +* * +* The result of reversing is an array of double words which can be * +* used in any further computation as a regular IEEE code. * +* * +* The fact is that SUN 368i keeps every single data element * +* (integer, logical, and real*4 in words and real*8 in double words) * +* in bytes "from higher addresses to lower addresses" which is * +* opposite to many other computers. * +* * +* Usage notes: * +* * +* 1. Input and output data could be located at the same space.* +* 2. Twice reversed data return to their source. * +*-------------------------------------------------------------------- * +_drvsun_ csect + entry _drvsun_ + b 34(,15) + dc al1(6+22) + dc cl6'drvsun' + dc cl22'05-01-90/vesion#1.7' + stm 2,15,x'10'(13) + lr 12,13 + la 11,x'68' + slr 13,11 + st 12,4(13) + lr 12,15 + using _drvsun_,12 +r0 equ 0 symbolic register equates +r1 equ 1 +r2 equ 2 +r3 equ 3 +r4 equ 4 +r5 equ 5 +r6 equ 6 +r7 equ 7 +r8 equ 8 +r9 equ 9 +r10 equ 10 +r11 equ 11 +r12 equ 12 +r13 equ 13 +r14 equ 14 +r15 equ 15 +* -------------------------- b o d y ------------ + lr r4,r2 + lr r3,r1 + lr r2,r0 + l r11,00(,r4) if (n == 0) go to exit + ltr r9,r11 + bz exit +next ds 0h + ic r5,03(,r2) load the last byte of the word + sll r5,8 0040 + ic r5,02(,r2) 0043 + sll r5,8 0430 + ic r5,01(,r2) 0432 + sll r5,8 4320 + ic r5,00(,r2) 4321 +* + ic r4,07(,r2) load the last byte of the word + sll r4,8 0080 + ic r4,06(,r2) 0087 + sll r4,8 0870 + ic r4,05(,r2) 0876 + sll r4,8 8760 + ic r4,04(,r2) 8765 +* + stm r4,r5,00(r3) save the first as a second one + la r2,8(r2) + la r3,8(r3) + bct 11,next +* --------- epiloge ----------------------------------------------- +exit lm 2,14,x'78'(13) + br 14 + end \ No newline at end of file diff --git a/vmworkshop-vmarcs/1995/sun2ie95/drvsun.fortran b/vmworkshop-vmarcs/1995/sun2ie95/drvsun.fortran new file mode 100644 index 0000000..bbbccfe --- /dev/null +++ b/vmworkshop-vmarcs/1995/sun2ie95/drvsun.fortran @@ -0,0 +1,60 @@ + subroutine drvsun(from, to, n) + integer from(2*n), to(2*n), n +* --------------------------------------------------------------------* +* PROCESSOR - VS FORTRAN, VERSION 2, RELEASE 4. * +* * +* DEPENDENCES - NONE * +* * +* ATTRIBUTES - SERIALLY REUSABLE * +* * +* ENTRY POINT - DRVSUN: Double word's bytes ReVersing in SUN 386i's * +* data. * +* * +* STATUS - NEW: 05/17/90 * +* * +* Val I. Garger, Technology Integration * +* Group, CNSF, Cornell University * +* * +* vig@cornellf.tn.cornell.edu * +* vig@eagle.tn.cornell.edu * +* vig@cornellf.bitnet * +*-------------------------------------------------------------------- * +* * +* COPYRIGHT - VAL GARGER, CORNELL NATIONAL SUPERCOMPUTER FACILITY, * +* (JUNE 1990) CORNELL UNIVERSITY, ITHACA, NY. * +* CONTAINS RESTRICTED MATERIALS OF CORNELL UNIVERSITY, * +* (C) COPYRIGHT CORNELL UNIVERSITY 1990 * +* * +* --------------------------------------------------------------------* +* Reversing of bytes in double words in SUN 386i workstation data. * +* This is to further use of SUN's data FTPed to any other computer as * +* regular IEEE format data. * +* * +* input: from SUN array of double words. * +* n Number of double words to revolve. * +* output: to regular IEEE double words (like real*8). * +* * +* The result of reversing is an array of double words which can be * +* used in any further computation as a regular IEEE code. * +* * +* The fact is that SUN 368i keeps every single data element * +* (integer, logical, and real*4 in words and real*8 in double words) * +* in bytes "from higher addresses to lower addresses" which is * +* opposite to many other computers. * +* * +* Usage notes: * +* * +* 1. Input and output data could be located at the same space.* +* 2. Twice reversed data return to their source. * +*-------------------------------------------------------------------- * + integer it + if (n .ne. 0 ) then + call srvsun(from, to, 2*n) + do j = 1, 2*n, 2 + it = from(j) + to(j) = from(j+1) + to(j+1) = it + enddo + endif + return + end \ No newline at end of file diff --git a/vmworkshop-vmarcs/1995/sun2ie95/srvsun.assemble b/vmworkshop-vmarcs/1995/sun2ie95/srvsun.assemble new file mode 100644 index 0000000..623ea33 --- /dev/null +++ b/vmworkshop-vmarcs/1995/sun2ie95/srvsun.assemble @@ -0,0 +1,105 @@ + TITLE ' Revolving of bytes in words in SUN workstation data ' +* --------------------------------------------------------------------* +* subroutine srvsun(from, to, n) * +* integer*4 n, from(n), to(n) * +* integer n * +* --------------------------------------------------------------------* +* PROCESSOR - ASSEMBLE H, VERSION 2, RELEASE 1. * +* * +* DEPENDENCES - NONE * +* * +* ATTRIBUTES - REENTERANT * +* * +* ENTRY POINT - _srvsun_ * +* * +* STATUS - new: 05/17/90 * +* * +* Val I. Garger, Technology Integration * +* Group, CNSF, Cornell University * +* * +* vig@cornellf.tn.cornell.edu * +* vig@eagle.cnsf.cornell.edu * +* vig@cornellf.bitnet * +*-------------------------------------------------------------------- * +* * +* COPYRIGHT - VAL GARGER, CORNELL NATIONAL SUPERCOMPUTER FACILITY, * +* (JUNE 1990) CORNELL UNIVERSITY, ITHACA, NY. * +* CONTAINS RESTRICTED MATERIALS OF CORNELL UNIVERSITY, * +* (C) COPYRIGHT CORNELL UNIVERSITY 1990 * +* * +* --------------------------------------------------------------------* +* Revolving of bytes in words of SUN 386i workstation data. * +* This is to further use of SUN's data FTPed to any other computer as * +* regular IEEE format data. * +* * +* input: from SUN array of words. * +* n Number of words to revolve. * +* output: to regular IEEE words (real*4, logical, integer). * +* * +* The result of reversing is an array of single words which can be * +* used in any further computation as a regular IEEE code. * +* * +* The fact is that SUN 368i keeps every single data element * +* (interger, logical, and real*4 in words and real*8 in double words) * +* in bytes "from higher addresses to lower addresses" which is * +* opposite to what other computers do. * +* * +* Usage notes: * +* * +* 1. Arguments "from" and "to" could be the same variable name, * +* which means revolving "in place" * +* 2. Twice revolved in place data return to their original value. * +*-------------------------------------------------------------------- * +_srvsun_ csect + entry _srvsun_ + b 34(,15) + dc al1(6+22) + dc cl6'srvsun' + dc cl22'05-17-90/vesion#1.1' + stm 2,15,x'10'(13) + lr 12,13 + la 11,x'68' + slr 13,11 + st 12,4(13) + lr 12,15 + using _srvsun_,12 +r0 equ 0 symbolic register equates +r1 equ 1 +r2 equ 2 +r3 equ 3 +r4 equ 4 +r5 equ 5 +r6 equ 6 +r7 equ 7 +r8 equ 8 +r9 equ 9 +r10 equ 10 +r11 equ 11 +r12 equ 12 +r13 equ 13 +r14 equ 14 +r15 equ 15 +* -------------------------- b o d y ------------ + lr r4,r2 + lr r3,r1 + lr r2,r0 + l r11,00(,r4) if (n == 0) go to exit + ltr r11,r11 + bz exit +next ds 0h + ic r5,03(,r2) load the last byte of the word + sll r5,8 0040 + ic r5,02(,r2) 0043 + sll r5,8 0430 + ic r5,01(,r2) 0432 + sll r5,8 4320 + ic r5,00(,r2) 4321 +* + st r5,00(r3) save the first as a second one + la r2,4(r2) + la r3,4(r3) + bct r11,next +* --------- epiloge ----------------------------------------------- +exit lm 2,14,x'78'(13) + br 14 + end \ No newline at end of file diff --git a/vmworkshop-vmarcs/1995/sun2ie95/srvsun.fortran b/vmworkshop-vmarcs/1995/sun2ie95/srvsun.fortran new file mode 100644 index 0000000..9077e6f --- /dev/null +++ b/vmworkshop-vmarcs/1995/sun2ie95/srvsun.fortran @@ -0,0 +1,63 @@ + subroutine srvsun(from, to, n) + character*1 from(4*n), to(4*n) + integer n +* --------------------------------------------------------------------* +* PROCESSOR - VS FORTRAN, VERSION 2, RELEASE 4. * +* * +* DEPENDENCES - NONE * +* * +* ATTRIBUTES - SERIALLY REUSABLE * +* * +* ENTRY POINT - SRVSUN: Single word bytes ReVersing in SUN 386i's * +* data. * +* * +* STATUS - NEW: 05/17/90 * +* * +* Val I. Garger, Technology Integration * +* Group, CNSF, Cornell University * +* * +* vig@cornellf.tn.cornell.edu * +* vig@eagle.tn.cornell.edu * +* vig@cornellf.bitnet * +*-------------------------------------------------------------------- * +* * +* COPYRIGHT - VAL GARGER, CORNELL NATIONAL SUPERCOMPUTER FACILITY, * +* (JUNE 1990) CORNELL UNIVERSITY, ITHACA, NY. * +* CONTAINS RESTRICTED MATERIALS OF CORNELL UNIVERSITY, * +* (C) COPYRIGHT CORNELL UNIVERSITY 1990 * +* * +* --------------------------------------------------------------------* +* Reversing of bytes in words in SUN 386i workstation data. * +* This is to further use of SUN's data FTPed to any other computer as * +* regular IEEE format data. * +* * +* input: from SUN array of words. * +* n Number of words to revolve. * +* output: to regular IEEE words (real*4, logical, integer). * +* * +* The result of reversing is an array of single words which can be * +* used in any further computation as a regular IEEE code. * +* * +* The fact is that SUN 368i keeps every single data element * +* (interger, logical, and real*4 in words and real*8 in double words) * +* in bytes "from higher addresses to lower addresses" which is * +* opposite to many other computers. * +* * +* Usage notes: * +* * +* 1. Input and output data could be located at the same space. * +* 2. Twice reversed data return to their source. * +*-------------------------------------------------------------------- * + character*1 ct + if (n .ne. 0 ) then + do j = 1,4*n,4 + ct = from(j) + to(j) = from(j+3) + to(j+3) = ct + ct = from(j+1) + to(j+1) = from(j+2) + to(j+2) = ct + enddo + endif + return + end \ No newline at end of file diff --git a/vmworkshop-vmarcs/1995/syslog95/README.md b/vmworkshop-vmarcs/1995/syslog95/README.md new file mode 100644 index 0000000..74a4ab2 --- /dev/null +++ b/vmworkshop-vmarcs/1995/syslog95/README.md @@ -0,0 +1,110 @@ +# SYSLOGS + +``` +SYSLOGS is the keeper of all system console logs which will +be compacted and archived to tape every Monday. + +For a console to be included in the SYSLOGS archival tape, +spool a userid's console to SYSLOGS and make sure its +console is closed every day at midnight (ie update ALL@0000 +EXEC on TIMERMNT). + +TODISK EXEC + +Nightly, SYSLOGS is autologged by TIMER and runs TODISK +EXEC. All reader files are placed on the 192-D disk with the +originating userid as the filename and the spool file +creation date (in YYMMDD format) as the filetype. + +TIMER console files are scanned for idle users and those +lines are appended to the IDLE USERS file. This file is not +archived. + +OPERATOR PROP logs are copied directly from OPERATOR 191 to +SYSLOGS 192 and scanned to generate MUSIC bad password +reports (PASSALL and PASSDATA YYMMDD). The OPERATOR 191 +minidisk is then cleared. + +TOVMARC EXEC + +Mondays at 11am, SYSLOGS is autologged by TIMER and runs +TOVMARC EXEC to package system logs into daily files. It +first erases the previous week's VMARC files on the A-disk, +packs all files on the D-disk and then runs VMARC PACK for +every day except TODAY. Finally, all files on the D-disk are +erased except for TODAY's files. + +TOTAPE EXEC + +Simply takes all VMARC files and dumps them to tape using +VMFPLC2 and its compression option. The current tape is +kept in Anne-Marie's box in the machine room, this procedure +is run manually after TOVMARC completes. + +RTOTAPE EXEC + +The next step towards automation. The 3494 is used to dump +VMARC files to tape using VMFPLC2 with the 3490C compression +option. The current tape is in the Robot, name is VMLGxx, +where xx = 01, 02, ..., 99. TIMER will start this job after +we have found a reliable way to share the drives between VM +and MVS. + +TOVMARC TOTAPE + +This file is updated by both TOVMARC and TOTAPE to ensure +the compacted data is written to tape before it is erased. +The second line contains the current VMLGxx tape number. + +CHECKLOG EXEC + +This utility was thrown together in record time to extract +records from huge console logs which cannot be edited. Usage +is: + + CHECKLOG userid yymmdd hh:mm:ss nbrlines + + + +Naming convention + +Console files are named ORIGINID YYMMDD + +Archival files are named YYMMDD VMARC + +Extracting a file from tape + +vmfplc2 load 950130 vmarc (eot find desired day and +load + +vmarc list 950130 vmarc list contents of +archive + +vmarc unpk 950130 vmarc a smtp * a to extract only smtp +950130 + +or + +vmarc unpk 950130 vmarc to unpack all files + + + +The resulting file(s) will be in CMS packed format. XEDIT +handles packed files just fine but PRINT doesn't, so do: + +copy smtp 950130 (unpack + +print smtp 950130 beware! that might be a lot of output + + + + Anne-Marie Marcoux 95/06/06 + (514) 398-3708 + + marie@vm1.mcgill.ca + + McGill University Computing Centre + 805 Sherbrooke West, room 218 + Montreal, Quebec, Canada + H3A 2K6 +``` diff --git a/vmworkshop-vmarcs/1995/syslog95/checklog.exec b/vmworkshop-vmarcs/1995/syslog95/checklog.exec new file mode 100644 index 0000000..3e05860 --- /dev/null +++ b/vmworkshop-vmarcs/1995/syslog95/checklog.exec @@ -0,0 +1,55 @@ +/* read syslogs console files and create a file on your a disk starting*/ +/* at the time you ask and day for length specified */ +/* written by Lyne Thibault ... May 3rd, 1995 */ + +ARG filename date time length +'state' filename date '*' +IF RC ^= 0 THEN SIGNAL usage +IF length = ' ' THEN SIGNAL usage +hh =SUBSTR(time,1,2) +mm =SUBSTR(time,4,2) +ss =SUBSTR(time,7,2) +hm =SUBSTR(time,3,1) +ms =SUBSTR(time,6,1) + +IF (hh > 23) THEN SIGNAL usage +IF (mm > 59) & (mm ^= ' ') THEN SIGNAL usage +IF (hh > 59) & (ss ^= ' ') THEN SIGNAL usage +IF (hm ^= ':') & (hm ^= ' ') THEN SIGNAL usage +IF (ms ^= ':') & (ms ^= ' ') THEN SIGNAL usage +IF length < 0 THEN SIGNAL usage + + +datei=substr(date,3,2)'/'substr(date,5,2)'/'substr(date,1,2) +month=WORD('January February March April May June July August September October November December',SUBSTR(date,3,2)) +day=SUBSTR(date,5,2) +IF day < 10 THEN day=WORD('1 2 3 4 5 6 8 9',day) +datem=day' 'month' 19'substr(date,1,2) + +'PIPE (endchar ?)', + ' < ' filename date, + '| unpack', + '| a:strfrlab %'datei time'%', + '| fin1: faninany ', + '| fin2: faninany ', + '| take' length, + '| >' filename 'c'date 'a variable', +'?', + 'a: ', + '| b: strfrlab %'time'%', + '|fin1:', +'?', + 'b: ', + '| strfrlab %'datem time'%', + '|fin2:' +EXIT 0 + +usage : + say;say 'CHECKLOG filename date time length ' + say;say 'where filename: userid console log from syslogs expected filemode "D"' + say ' date : yymmdd' + say ' time : hh:mm:ss bare minimum is hh' + say ' length : number of lines you want as output' + say;say 'OUTPUT will be a file on your "A" mdisk named using the filename date arguments' + say +EXIT 100 diff --git a/vmworkshop-vmarcs/1995/syslog95/musform.rexx b/vmworkshop-vmarcs/1995/syslog95/musform.rexx new file mode 100644 index 0000000..b08c55d --- /dev/null +++ b/vmworkshop-vmarcs/1995/syslog95/musform.rexx @@ -0,0 +1,33 @@ +/* Format MUSIC bad password report */ + +SIGNAL ON ERROR + +DO FOREVER + 'readto in' + SELECT /* format output line */ + WHEN POS('MUSICA',in) ^= 0 + THEN 'callpipe', + ' var in', + '| specs 12.7 1.7 5.6 9.6 5.6 16.6 /0/ 28.1 /0/ 35.1', + '| *:' + WHEN POS('MUSICB',in) ^= 0 + THEN 'callpipe', + ' var in', + '| specs 12.7 1.7 5.6 9.6 /0/ 21.1 5.6 23.6 /0/ 35.1', + '| *:' + WHEN POS('MUSICF',in) ^= 0 + THEN 'callpipe', + ' var in', + '| specs 12.7 1.7 5.6 9.6 /0/ 21.1 /0/ 28.1 5.6 30.6', + '| *:' + OTHERWISE, + 'callpipe', + ' var in', + '| specs 12.7 1.7 5.6 9.6 /*** Unknown system/ 37 20.6 nw', + '| *:' + END +END + +error: +IF RC = 12 THEN RC = 0 +EXIT RC diff --git a/vmworkshop-vmarcs/1995/syslog95/rtotape.exec b/vmworkshop-vmarcs/1995/syslog95/rtotape.exec new file mode 100644 index 0000000..8d52836 --- /dev/null +++ b/vmworkshop-vmarcs/1995/syslog95/rtotape.exec @@ -0,0 +1,66 @@ +/* archive console files to tape */ + +'CP SPOOL CONSOLE START TO marie' + +'PIPE', + '< tovmarc totape a', + '| stem action.' /* .1 is action, .2 is tape number */ + +IF action.1 = 'totape done' THEN SIGNAL dotovmarc + +/* mount current tape: VMLGxx where xx is record 2 of TOVMARC TOTAPE */ + +logtape = 'VMLG'action.2 + +SAY 'dfsmsrm mount volume' logtape '( readwrite attach * vdev 181 wait' +'dfsmsrm mount volume' logtape '( readwrite attach * vdev 181 wait' + +IF RC ^= 0 THEN SIGNAL no_mount /* RMSMASTR not answering */ + +/* position tape, empty tape must have 2 tape marks */ +'VMFPLC2 SKIP (EOT' /* go to end of tape */ +'VMFPLC2 BSF 2' /* and position right before 2nd tape mark*/ +'VMFPLC2 FSF 1' + +'VMFPLC2 MODESET ( 3490C' /* select best compression for device */ + +'VMFPLC2 DUMP * vmarc' +retcode = RC + +'VMFPLC2 WTM 2' /* finish off */ +IF retcode ^= 0 THEN SIGNAL eot + +'PIPE (endchar %)', + ' literal totape done', + '| fileslow tovmarc totape a from 1', + '%', + ' cp detach 181' + +'CP SPOOL CONSOLE STOP CLOSE' + +EXIT + +dotovmarc: + SAY 'Run TOVMARC before TOTAPE!!!' +EXIT 99 + +eot: + tapenbr = RIGHT(action.2 + 1,2,'0') /* need 2 digits */ + 'pipe (endchar %)', + ' literal' tapenbr, + '| fileslow tovmarc totape a from 2', + '%', + ' cp detach 181' + + SAY 'Check for possible end-of-tape condition, VMFPLC2 return code' retcode + SAY 'Waiting 10 seconds before Ejecting cartridge' logtape + 'CP SLEEP 10 SEC' + 'dfsmsrm set volcat volume' logtape 'targetcat eject (wait' + SAY 'Please insert new extended tape VMLG'tapenbr', initialize with TAPE WTM 2' + SAY +EXIT 98 + +no_mount: + SAY 'RMSMASTR not answering, check status before running RTOTAPE again' + 'EXEC mail marie (FILE rmsmastr error NOLOG NOEDIT NOPROMPT NOSCREEN SUBJECT RTOTAPE not done!' +EXIT 4 diff --git a/vmworkshop-vmarcs/1995/syslog95/todisk.exec b/vmworkshop-vmarcs/1995/syslog95/todisk.exec new file mode 100644 index 0000000..0e6ad12 --- /dev/null +++ b/vmworkshop-vmarcs/1995/syslog95/todisk.exec @@ -0,0 +1,82 @@ +/* read all console files in reader, create one file/userid/day */ + +'CP SPOOL CONSOLE START TO marie' + +SAY 'Executing Todisk' + +'pipe', /* enough space left on d-disk ? */ + ' cms query disk d', + '| fromlabel LABEL', /* in case d-disk not accessed */ + '| drop 1', /* drop header */ + '| specs fieldsep - field 2 1.2', + '| var howfull' + +IF howfull >= 95 THEN SIGNAL diskfull + +'pipe', + ' cp query rdr all *', + '| drop first 1', /* drop header record */ + '| specs word 8-9 1 word 1-2 nw', /* keep date,time,origin,spoolid*/ + '| sort', /* order by time */ + '| console', + '| specs', /* build callpipe subcommand */ + '/callpipe (stagesep ?)/ 1', + '/reader 00c file/ nw word 4 nw', /* read spool file */ + '/? specs 2-133 1/ nw', /* remove carriage control */ + '/? >>/ nw word 3 nw /95/ nw 1.2 n 4.2 n /d variable/ nw', + '/? *:/ nw', /* connect to pipcmd's output */ + '| console', + '| pipcmd' /* issue callpipe just built */ + +/* extract records from TIMER file */ +'pipe', + ' cms listfile timer * d', + '| nlocate /File not found/', /* so getfiles doesnt get upset */ + '| getfiles', /* read contents of those files */ + '| locate 10-* /Forced /', /* only interested in Forced msg */ + '| >> idle users d', + '| cms listfile timer * d', + '| specs /ERASE/ 1 1-* nw', + '| cms' + +/* now get Operator log */ +'pipe (endchar %)', + ' cms access 193 e', + '%', /* dont want output from access */ + ' cms listfile lg* mcgill1 e', + '| nlocate /LG'SUBSTR(DATE(Standard),3)'/', /* not current file */ + '| a: fanout', + '| specs', /* build subcommand */ + '/callpipe (stagesep ?)/ 1', + '/ operator/ nw 3-8 nw /d1/ nw', /* copy it to our 192 */ + '$? locate 50-62 /BAD PASSWORD/$ nw', /* that's what I want */ + '$? nlocate /MUSICT/$ nw', /* dont care about those */ + '$? specs word 1-3 1 word 10 nw 86-88 nw / BAD PASSWORD/ nw$ nw', + '/? > passall/ nw 3-8 nw /d/ nw', /* want date here */ + '/? specs word 4 2 word 3 nw/ nw', /*just userid and system*/ + '/? sort count/ nw', /* prefix count to record */ + '/? nfind _________1/ nw', /* report only >2 attempts */ + '/? nfind _________2/ nw', + '/? musform/ nw', /* format records */ + '/? literal code count MUSICA MUSICB MUSICF/ nw', /*add header*/ + '/? literal / nw', + '/? literal MUSIC invalid password list for/ nw 3-4 nw $/$ n 5-6 n $/$ n 7-8 n', + '/? > passdata/ nw 3-8 nw /d/ nw', /* keep report for DG */ + '/? cp msg operator cmd erase/ nw word 1-2 nw', /* dont need this*/ + '| console', /* check callpipe just in case */ + '| pipcmd', /* issue callpipe just built */ + '| console', + '%', + 'a:', /* secondary fanout output */ + '| specs /mail dg ( NOSCR NOLOG NOEDIT NOACK NOPROMPT FILE PASSDATA/ 1 3-8 nw /SUBJECT Invalid MUSIC Passwords/ nw', + '| cms' + +'CP SPOOL CONSOLE STOP CLOSE' + +EXIT + +diskfull: + 'EXEC TELL marie D-disk' howfull'% full, TODISK not run' + 'EXEC mail marie lyne (FILE diskfull error NOSCR NOLOG NOEDIT NOACK NOPROMPT SUBJECT SYSLOGS 192' howfull'% full' +EXIT 99 diff --git a/vmworkshop-vmarcs/1995/syslog95/totape.exec b/vmworkshop-vmarcs/1995/syslog95/totape.exec new file mode 100644 index 0000000..5369e07 --- /dev/null +++ b/vmworkshop-vmarcs/1995/syslog95/totape.exec @@ -0,0 +1,42 @@ +/* archive console files to tape */ + +'CP SPOOL CONSOLE START TO marie' + +'PIPE', + '< tovmarc totape a', + '| var action.' + +IF action.1 = 'totape done' THEN SIGNAL dotovmarc + +/* position tape, empty tape must have 2 tape marks */ +'VMFPLC2 SKIP (EOT' /* go to end of tape */ +'VMFPLC2 BSF 2' /* and position right before 2nd tape mark*/ +'VMFPLC2 FSF 1' + +'VMFPLC2 MODESET ( COMP' /* select best compression for device */ + +'VMFPLC2 DUMP * vmarc' +retcode = RC + +'VMFPLC2 WTM 2' /* finish off */ + +IF retcode ^= 0 THEN SIGNAL eot + +'PIPE (endchar %)', + ' literal totape done', + '| fileslow tovmarc totape a from 1', + '%', + ' cp detach 181' + +'CP SPOOL CONSOLE STOP CLOSE' + +EXIT + +dotovmarc: + SAY 'Run TOVMARC before TOTAPE!!!' +EXIT 99 + +eot: + SAY 'Check for possible end-of-tape condition' + SAY 'VMFPLC2 return code' RC +EXIT 98 diff --git a/vmworkshop-vmarcs/1995/syslog95/tovmarc.exec b/vmworkshop-vmarcs/1995/syslog95/tovmarc.exec new file mode 100644 index 0000000..c9aa1a5 --- /dev/null +++ b/vmworkshop-vmarcs/1995/syslog95/tovmarc.exec @@ -0,0 +1,76 @@ +/* archive console files to tape, one VMARC per day */ + +'CP SPOOL CONSOLE START TO marie' + +'PIPE', + '< tovmarc totape a', + '| var action.' + +IF action.1 = 'tovmarc done' THEN SIGNAL dototape + +'ERASE * vmarc a1' /* erase last week's vmarc's */ +'QUERY DISK' + +today = SUBSTR(DATE(Standard),3) + +SAY 'Running TOVMARC' today + +'PIPE (endchar ?)', + ' cms listfile * * d', + '| a:all /PASSDATA/ ! /PASSALL /', /* select MUSIC bad pswd reports */ + '| specs /ERASE/ 1 1-* nw', /* build ERASE command */ + '| cms', /* and execute it! */ + '?', + 'a:', /* all other fnames come here */ + '| nlocate /'today'/', /* remove today's files */ + '| nlocate /IDLE USERS/', /* and idle user file */ + '| > lastweek files a' /* files to be processed */ + +'PIPE', /* pack files before VMARC */ + ' < lastweek files a', /* get list of files to process */ + '| specs', /* build a callpipe subcmd*/ + '/callpipe (stagesep ?) / 1', + '// nw 1-* nw', /* packs and replaces it */ + '/fixed ? *:/ nw', /* connect to pipcmd's output */ + '| pipcmd' /* issue callpipe just built */ + +IF RC ^= 0 THEN SIGNAL notpacked + +'PIPE', + ' < lastweek files a', + '| specs word 2 1', + '| sort unique', /* order by date */ + '| specs /VMARC PACK */ 1 word 1 nw /D/ nw word 1 nw /VMARC A/ nw', + '| cms', + '| console' + +IF RC ^= 0 THEN SIGNAL noterased + +'PIPE (endchar ?)', + ' < lastweek files a', + '| specs /ERASE/ 1 1-* nw', /* build ERASE command */ + '| cms', /* and execute it! */ + '?', + ' literal tovmarc done', /* now update status line */ + '| fileslow tovmarc totape a from 1' + +'EXEC TELL marie Done with VMARC! Now run TOTAPE' +'EXEC mail marie lyne (FILE idle users NOLOG NOEDIT NOPROMPT NOSCREEN SUBJECT Time for TOTAPE!' +'ERASE idle users d' /* erase this file once a week */ + +'CP SPOOL CONSOLE STOP CLOSE' + +EXIT + +dototape: + SAY 'Run TOTAPE before TOVMARC!!!' +EXIT 99 + +noterased: + SAY 'Return code' RC 'from PIPE, Files not erased' +EXIT 98 + +notpacked: + SAY 'Return code' RC 'from PIPE, Files not packed' +EXIT 97 diff --git a/vmworkshop-vmarcs/1995/syslog95/tovmarc.totape b/vmworkshop-vmarcs/1995/syslog95/tovmarc.totape new file mode 100644 index 0000000..6137d3e --- /dev/null +++ b/vmworkshop-vmarcs/1995/syslog95/tovmarc.totape @@ -0,0 +1,2 @@ +totape done +02 diff --git a/vmworkshop-vmarcs/1995/vax2ib95/README.md b/vmworkshop-vmarcs/1995/vax2ib95/README.md new file mode 100644 index 0000000..1775337 --- /dev/null +++ b/vmworkshop-vmarcs/1995/vax2ib95/README.md @@ -0,0 +1,34 @@ +# IBM TO/FROM VAX FORMAT CONVERSION ROUTINES + +vig@cornellf 08/15/90 + +A set of subroutines callable from Fortran and C programs to convert arrays of floating point numbers between IBM and VAX data formats is available at the CNSF. + +CFSV32 -- convert floating point single precision IBM data format to VAX 32 bit long format + +CFDV64 -- convert floating point double precision IBM data format to VAX 64 bit long format + +CFDV32 -- convert floating point double precision IBM data format to VAX 32 bit long format + +CFV32S -- convert floating point VAX 32 bit long format to a single precision IBM data format + +CFV64D -- convert floating point VAX 64 bit long format to a double precision IBM data format + +CFV32D -- convert floating point VAX 32 bit long format to a double precision IBM data format + +All routines are written in VS FORTRAN and thus are available for both CMS and AIX/370 systems. They could be compiled by either 'fortvs' command under VM/CMS or 'fvs' command under AIX/370. + +Precision of the conversion is the best possible. When floating point formats differ in number of bits for mantissa, which affects data precision, the least mantissa bits are rounded. When formats differ in number of bits for exponent, which affects the range of data, the biggest possible value or zero value is assigned if the old number can't be represented. + +Routines convert data in memory and must be invoked with three arguments: input array name, output array name, and number of elements in each of two arrays. When called from a C program, the last parameter must be passed by the pointer. The same variable name can be used for the first and the second arguments. This means that conversion can be done "in place" thus saving memory space, if necessary. + +## EXAMPLE + +``` +call cfsv32(ibm, vax, n) + +where: + ibm input array of IBM floating point numbers, REAL*4 values. + n number of elements in ibm to convert, integer. + vax output array of 32-bit VAX floating point numbers, single precision. +``` diff --git a/vmworkshop-vmarcs/1995/vax2ib95/cfdv32.fortran b/vmworkshop-vmarcs/1995/vax2ib95/cfdv32.fortran new file mode 100644 index 0000000..cb3c3ee --- /dev/null +++ b/vmworkshop-vmarcs/1995/vax2ib95/cfdv32.fortran @@ -0,0 +1,73 @@ + subroutine cfdv32(ibm, vax, n) + integer ibm(*), vax(*), n +* ------------------------------------------------------------------ * +* author: Federico Carminati, CERN, Geneva. * +* restructured by Valery Garger, CNSF, Cornell University * +* * +* This is a subroutine to convert from ibm double precision * +* floating point format (64 bits) to vax short floating * +* point format (32 bits) * +* * +* ex: call cfdv32(ibm, vax, n) * +* * +* ibm an area of storage 64*n bits long in which * +* are stored one next to the other n 32 bits * +* ibm floating point numbers. * +* vax an area of storage 32*n bit long which * +* contains n 32 bits vax floating point numbers. * +* * +* ibm and vax could be equivalenced, i.e. could * +* be located at the same space and vax must * +* occupy first half of the space. * +* * +* n number of floating point numbers to convert * +* * +* ================================================================== * + logical btest + data ibig /z ffff 7fff/ + data isma /z 0000 0080/ +* + j = 1 + do while(j .le. n) +c +c check for exact 0 +c + if(ibm(2*j-1) .eq. 0) then + vax(j) = 0 + else +c +c get exponent and sign +c + iexp = ishft( ishft(ibm(2*j-1),1), -25) + if (btest(ibm(2*j-1),23)) then + left = 0 + elseif(btest(ibm(2*j-1),22)) then + left = 1 + elseif(btest(ibm(2*j-1),21)) then + left = 2 + elseif(btest(ibm(2*j-1),20)) then + left = 3 + else + left = 0 + endif +* + iexp = iexp * 4 - left - 128 + ibt = ishft(iand(ibm(2*j-1),2**24-1),left+1) + ibt = ior(ibt,ishft(ibm(2*j),-31+left))+1 + ispill = ishft(ibt,-25) + ibt = ishft(ibt,-ispill-1) + iexp = iexp+ispill + if(iexp .le. 0) then + ibt = isma + elseif(iexp .gt. 255) then + ibt = ibig + else + ibt = ior(ishft(ibt,16),ishft(ishft(ibt,9),-25)) + ibt = ior(ibt,ishft(iexp,7)) + endif + if(btest(ibm(2*j-1),31)) ibt = ibset(ibt,15) + vax(j) = ibt + endif + j = j + 1 + enddo + end \ No newline at end of file diff --git a/vmworkshop-vmarcs/1995/vax2ib95/cfdv64.fortran b/vmworkshop-vmarcs/1995/vax2ib95/cfdv64.fortran new file mode 100644 index 0000000..1b3cf41 --- /dev/null +++ b/vmworkshop-vmarcs/1995/vax2ib95/cfdv64.fortran @@ -0,0 +1,78 @@ + subroutine cfdv64(ibm, vax, n) + integer ibm(*), vax(*), n +c ------------------------------------------------------------------- * +c * +c author: Federico Carminati, CERN, Geneva * +c restructured by Valery Garger, CNSF, Cornell University * +c * +c This is a subroutine to convert from ibm double precision * +c floating point format (64 bits) to vax long floating point * +c format (64 bits) * +c * +c ex: call cfdv64(ibm, vax, n) * +c * +c ibm an area of storage 64*n bits long in which * +c are stored one next to the other n 64 bits * +c ibm floating point numbers. * +c * +c vax an area of storage 64*n bits long which * +c on output it will contain n 64 bits vax floating * +c point numbers * +c * +c ibm and vax could be located at the same space * +c * +c n number of floating point numbers to convert * +c * +c =================================================================== * +* + logical btest + data ibig /z ffff 7fff/ + data isma /z 0000 0080/ +* + j = 1 + do while (j .lt. 2*n) +c +c check for exact 0 +c + if(ibm(j) .eq. 0) then + vax(j) = 0 + vax(j+1) = 0 + else +c +c get exponent +c + iexp = ishft( ishft(ibm(j),1), -25) + if (btest(ibm(j),23)) then + left = 0 + elseif(btest(ibm(j),22)) then + left = 1 + elseif(btest(ibm(j),21)) then + left = 2 + elseif(btest(ibm(j),20)) then + left = 3 + else + left = 0 + endif + iexp = iexp * 4 - left - 128 + if(iexp .le. 0) then + ibt = 0 + it = isma + elseif(iexp.gt.255) then + ibt = not(0) + it = ibig + else + ibt = ishft(ibm(j+1),left) + it = ior(ishft(ishft(ibm(j),9+left),-9), + & ishft(ibm(j+1),-32+left)) + ibt = ior(ishft(ibt,16),ishft(ibt,-16)) + it = ior(ishft(it,16),ishft(it,-16)) + it = ior(it,ishft(iexp,7)) + endif + if(btest(ibm(j),31)) it = ibset(it,15) + vax(j) = ibt + vax(j+1) = it +* + endif + j = j + 2 + enddo + end \ No newline at end of file diff --git a/vmworkshop-vmarcs/1995/vax2ib95/cfsv32.fortran b/vmworkshop-vmarcs/1995/vax2ib95/cfsv32.fortran new file mode 100644 index 0000000..44e0d9e --- /dev/null +++ b/vmworkshop-vmarcs/1995/vax2ib95/cfsv32.fortran @@ -0,0 +1,68 @@ + subroutine cfsv32(ibm, vax, n) + integer vax(*), ibm(*), n +* ------------------------------------------------------------------- * +* author: Federico Carminati, CERN, Geneva * +* restructured by Valery Garger, CNSF, Cornell University * +* * +* This is a subroutine to convert from ibm short floating * +* point format (32 bits) to vax short floating point format * +* (32 bits) * +* * +* ex: call cfsv32(ibm, vax, n) * +* * +* ibm an area of storage 32*n bits long in which * +* are stored nf 32 bits ibm floating point * +* numbers. * +* vax an area of storage 32*n bits long which * +* on output will contain n * +* 32 bits vax floating point numbers. * +* * +* ibm and vax could be located at the same space * +* * +* n number of floating point numbers to convert * +* * +* =================================================================== * + logical btest + data ibig /z ffff 7fff/ + data isma /z 0000 0080/ +* + j = 1 + do while( j .le. n) +c +c check for exact 0 +c + if(ibm(j) .eq. 0) then + vax(j) = 0 + else +c +c get exponent +c + iexp = ishft(ishft(ibm(j),1), -25) +* + if (btest(ibm(j),23)) then + left = 0 + elseif(btest(ibm(j),22)) then + left = 1 + elseif(btest(ibm(j),21)) then + left = 2 + elseif(btest(ibm(j),20)) then + left = 3 + else + left = 0 + endif + iexp = iexp * 4 - left - 128 + if(iexp .le. 0) then + ibt = isma + elseif(iexp.gt.255) then + ibt = ibig + else + ibt = ior(ishft(ibm(j),16+left), + & ishft(ishft(ibm(j),9+left),-25)) + ibt = ior(ibt,ishft(iexp,7)) + endif + if(btest(ibm(j),31)) ibt = ibset(ibt,15) + vax(j) = ibt + endif + j = j + 1 + enddo + end \ No newline at end of file diff --git a/vmworkshop-vmarcs/1995/vax2ib95/cfv32d.fortran b/vmworkshop-vmarcs/1995/vax2ib95/cfv32d.fortran new file mode 100644 index 0000000..943c728 --- /dev/null +++ b/vmworkshop-vmarcs/1995/vax2ib95/cfv32d.fortran @@ -0,0 +1,63 @@ + subroutine cfv32d(vax, ibm, n) + integer vax(*), ibm(*), n +* ------------------------------------------------------------------- * +* author: Federico Carminati, CERN, Geneva * +* restructured by Valery Garger, CNSF, Cornell University * +* * +* this is a subroutine to convert from vax floating * +* point format (32 bits) to ibm double precision floating * +* format (64 bits). * +* * +* ex: call cfv32d(vax, ibm, n) * +* * +* vax an area of storage 64*n bits long in which are * +* stored n 32 bits vax floating point numbers * +* * +* ibm an area of storage 64*n bits long which * +* on output contains n 64 bits ibm * +* floating point numbers * +* * +* ibm and vax could be located at the same space * +* in which case vax must occupy first half of * +* the space. * +* * +* n number of floating point numbers to convert * +* * +* =================================================================== * + logical btest +* + j = n + do while (j .ge. 1) +c +c check for exact 0 +c + if(vax(j) .eq. 0) then + ibm(2*j-1) = 0 + ibm(2*j) = 0 + else +c +c get exponent +c + iexp = ishft(ishft(vax(j),17),-24) +c vax exp + vax bias + ibm bias +c iexp = iexp - 128 + 260 + iexp = iexp + 132 + iex16 = iexp/4 + left = 4 - mod(iexp,4) + if (left .eq. 4) then + left = 0 + iex16 = iex16 - 1 + endif + ibt = ishft(ishft(vax(j),25),-9) + ibt = ibset(ibt,23) + ibt = ior(ibt,ishft(vax(j),-16)) + it = ishft(ibt,32-left) + ibt = ishft(ibt,-left) + ibt = ior(ibt,ishft(iex16,24)) + if(btest(vax(j),15)) ibt = ibset(ibt,31) + ibm(2*j-1) = ibt + ibm(2*j ) = it + endif + j = j - 1 + enddo + end \ No newline at end of file diff --git a/vmworkshop-vmarcs/1995/vax2ib95/cfv32s.fortran b/vmworkshop-vmarcs/1995/vax2ib95/cfv32s.fortran new file mode 100644 index 0000000..a72334d --- /dev/null +++ b/vmworkshop-vmarcs/1995/vax2ib95/cfv32s.fortran @@ -0,0 +1,60 @@ + subroutine cfv32s(vax, ibm, n) + integer ibm(*), vax(*), n +c ------------------------------------------------------------------- * +c author: Federico Carminati, CERN, Geneva * +c restructured by Valery Garger, CNSF, Cornell University * +c * +c This is a subroutine to convert from vax floating * +c point format (32 bits) to ibm floating point format * +c (32 bits). * +c * +c ex: call cfv32s(vax, ibm, n) * +c * +c vax an area of storage 32*n bits long in which * +c are stored n 32 bits vax floating point * +c numbers. * +c * +c ibm an area of storage 32*n bits long which * +c on output will contain n 32 bits ibm * +c floating point numbers * +c * +c vax and ibm could be located at the same space * +c * +c n number of floating point numbers to convert * +c * +c =================================================================== * + logical btest +* + j = 1 + do while (j .le. n) +c +c check for exact 0 +c + if(vax(j) .eq. 0) then + ibm(j) = 0 + else +c +c get exponent +c + iexp = ishft(ishft(vax(j),17),-24) +c vax exp + vax bias + ibm bias +c iexp = iexp - 128 + 260 + iexp = iexp + 132 + iex16 = iexp/4 + left = 4 - mod(iexp,4) + if(left .eq. 4) then + left = 0 + iex16 = iex16 - 1 + endif + ibt = ishft(ishft(vax(j),25),-9) + ibt = ibset(ibt,23) + ibt = ior(ibt,ishft(vax(j),-16)) + ibt = ibt + 2**(left-1) + ibt = ishft(ibt,-left) + ibt = ior(ibt,ishft(iex16,24)) + if(btest(vax(j),15)) ibt = ibset(ibt,31) + ibm(j) = ibt + endif + j = j + 1 + enddo + end \ No newline at end of file diff --git a/vmworkshop-vmarcs/1995/vax2ib95/cfv64d.fortran b/vmworkshop-vmarcs/1995/vax2ib95/cfv64d.fortran new file mode 100644 index 0000000..aeb7dd6 --- /dev/null +++ b/vmworkshop-vmarcs/1995/vax2ib95/cfv64d.fortran @@ -0,0 +1,70 @@ + subroutine cfv64d(vax, ibm, n) + integer vax(*), ibm(*), n +* ------------------------------------------------------------------- * +* author: Federico Carminati, CERN, Geneva. * +* restructured by Valery Garger, CNSF, Cornell University * +* * +* This is a subroutine to convert from vax floating * +* point format (64 bits) to ibm double precision floating * +* point format (64 bits). * +* * +* ex: call cfv64d(vax, ibm, n) * +* * +* vax an area of storage 64*n bits long in which * +* are stored n 64 bits vax floating point * +* numbers. * +* * +* ibm an area of storage 64*n bits long which * +* on output will contain n 64 bits ibm * +* floating point numbers. * +* * +* ibm and vax could be located at the same space. * +* * +* n number of floating point numbers to convert * +* * +* =================================================================== * + logical btest +* + j = 2 + do while ( j .le. 2*n) +c +c check for exact 0 +c + if(vax(j) .eq. 0) then + ibm(j) = 0 + ibm(j-1) = 0 + else +c +c get exponent +c + iexp = ishft(ishft(vax(j),17),-24) +c vax exp - vax bias + ibm bias +c iexp = iexp - 128 + 260 + iexp = iexp + 132 + iex16 = iexp/4 + left = 4 - mod(iexp,4) + if (left .eq. 4) then + left = 0 + iex16 = iex16 - 1 + endif + ibt = ishft(ishft(vax(j),25),-9) + ibt = ibset(ibt,23) + ibt = ior(ibt,ishft(vax(j),-16)) + itest1 = ishft(vax(j-1),-16) + itest2 = iand(vax(j-1),65535) + itest1 = itest1 + 2 ** (left-1) + itest2 = itest2 + ishft(itest1,-16) + ibt = ibt + ishft(itest2,-16) + it = ior(ishft(ishft(itest1,16),-16),ishft(itest2,16)) + move = left + 4*ishft(ibt,-24) + it = ior(ishft(it,-move),ishft(ibt,32-move)) + ibt = ishft(ibt,-move) + iex16 = iex16 + ishft(ibt,-24) + ibt = ior(ibt,ishft(iex16,24)) + if(btest(vax(j),15)) ibt = ibset(ibt,31) + ibm(j-1) = ibt + ibm(j ) = it + endif + j = j + 2 + enddo + end \ No newline at end of file diff --git a/vmworkshop-vmarcs/1996/README.md b/vmworkshop-vmarcs/1996/README.md new file mode 100644 index 0000000..cff8afc --- /dev/null +++ b/vmworkshop-vmarcs/1996/README.md @@ -0,0 +1,3 @@ +## Source + +Code from VMARCs distributed as part of the 1996 VM Workshop. diff --git a/vmworkshop-vmarcs/1996/diag00/diag00.exec b/vmworkshop-vmarcs/1996/diag00/diag00.exec new file mode 100644 index 0000000..b7211d3 --- /dev/null +++ b/vmworkshop-vmarcs/1996/diag00/diag00.exec @@ -0,0 +1,154 @@ +/*-------------------------------------------------------------------*/ +/* Field | Characteristics | Description */ +/*-----------------|-----------------|-------------------------------*/ +/* Reserved | 8 bytes, EBCDIC | Contains the constant "VM/ESA"*/ +/* (formerly | | (for compatibility with the */ +/* "System Name") | | prior product name) */ +/*-----------------|-----------------|-------------------------------*/ +/* Environment | 2 bytes, binary | Identifies the z/VM execution */ +/* | | environment. */ +/*-----------------|-----------------|-------------------------------*/ +/* Version | 1 byte, | The version number of the */ +/* Information | hexadecimal | product identified in the */ +/* | | System Name field. It is an */ +/* | | unsigned binary number. */ +/*-----------------|-----------------|-------------------------------*/ +/* Version code | 1 byte, | The version code from the */ +/* | hexadecimal | CPUID */ +/*-----------------|-----------------|-------------------------------*/ +/* reserved | 2 bytes, | z/VM stores zeros in this */ +/* | hexadecimal | field. (VM/SP stores the */ +/* | | machine check extended logout */ +/* | | field (MCEL) length.) */ +/*-----------------|-----------------|-------------------------------*/ +/* Processor | 2 bytes, | The address of the processor */ +/* address | hexadecimal | on which z/VM is currently */ +/* | | running */ +/*-----------------|-----------------|-------------------------------*/ +/* User ID | 8 bytes, EBCDIC | The user ID of the virtual */ +/* | | machine issuing the DIAGNOSE */ +/*-----------------|-----------------|-------------------------------*/ +/* Licensed program| 8 bytes, | The level of CP that is */ +/* bit map | hexadecimal | installed. */ +/*-----------------|-----------------|-------------------------------*/ +/* Time zone | 4 bytes, | Represents the time zone */ +/* differential | hexadecimal | differential in seconds from */ +/* | | Coordinated Universal Time */ +/* | | (UTC) */ +/*-----------------|-----------------|-------------------------------*/ +/* Release | 4 bytes, | The first byte is the release */ +/* Information | hexadecimal | number, the second byte is the*/ +/* | | release modification level, */ +/* | | and the third and fourth bytes*/ +/* | | are the service level. All */ +/* | | three subfields are unsigned */ +/* | | binary numbers. */ +/*-------------------------------------------------------------------*/ + Trace "O" + Address "COMMAND" + Parse value Diagrc(0) with rc 10 . 11 cc 12 . 17 Msg + VMLevels=Length(Msg)/40 + Do level=1 to VMLevels + Parse var Msg lMsg +40 Msg + Parse value lMsg with D00SysName +8 D00Env +3 D00Ver +1 D00Res1 +2, + D00ProcAddr +2 D00UserId +8 D00LicBits +8 D00TimeZone +4, + D00RelInfo +4 D00Rest + If Bitand(D00Env,'800000'x)=='800000'x then + LPar="LPAR" + else + LPar="" + If Bitand(D00Env,'400000'x)=='400000'x then + XMode="64-bit" + else + XMode="31-bit" + CPRSU=Right(C2D(Right(D00RelInfo,2),2),4,"0") + TimeOffset=C2D(D00TimeZone,2)/3600 +/* Say c2x(D00LicBits) */ + Select + When Bitand(D00Env,"80"x)=="80"x then + VM="VM/SP, VM/SP HPO or VM/ESA (370 feature)" + When D00LicBits=='0000000000000000'x then + VM="VM/XA SF 1" + When D00LicBits=='4000000000000000'x then + VM="VM/XA SF 2" + When D00LicBits=='6000000000000000'x then + VM="VM/XA SP 1" + When D00LicBits=='7000000000000000'x then + VM="VM/XA SP 2" + When D00LicBits=='7800000000000000'x then + VM="VM/XA SP 2 with APSS" + When D00LicBits=='7C00000000000000'x then + VM="VM/XA SP 2.1" + When D00LicBits=='7E00000000000000'x then + VM="VM/XA SP 2.1 with spool file origin enhancements" + When D00LicBits=='7F00000000000000'x then + VM="VM/ESA with the ESA feature" + When D00LicBits=='7F80000000000000'x then + VM="VM/ESA 1.1.1" + When D00LicBits=='7FC0000000000000'x then + VM="VM/ESA 1.2.0" + When D00LicBits=='7FE0000000000000'x then + VM="VM/ESA 1.2.1" + When D00LicBits=='7FF0000000000000'x then + VM="VM/ESA 1.2.2" + When D00LicBits=='7FF8000000000000'x then + VM="VM/ESA 2.1.0" + When D00LicBits=='7FFE000000000000'x then + VM="VM/ESA 2.2.0" + When D00LicBits=='7FFF000000000000'x then + VM="VM/ESA 2.3.0" + When D00LicBits=='7FFF800000000000'x then + VM="VM/ESA 2.4.0" + When D00LicBits=='7FFFC00000000000'x then + VM="z/VM 3.1.0 " + When D00LicBits=='7FFFE00000000000'x then + VM="z/VM 4.1.0 " + When D00LicBits=='7FFFF00000000000'x then + VM="z/VM 4.2.0 " + When D00LicBits=='7FFFF80000000000'x then + VM="z/VM 4.3.0 " + When D00LicBits=='7FFFFC0000000000'x then + VM="z/VM 4.4.0 " + When D00LicBits=='7FFFFE0000000000'x then + VM="z/VM 5.1.0 " + When D00LicBits=='7FFFFF0000000000'x then + VM="z/VM 5.2.0 " + When D00LicBits=='7FFFFF8000000000'x then + VM="z/VM 5.3.0 " + When D00LicBits=='7FFFFFC000000000'x then + VM="z/VM 5.4.0 " + When D00LicBits=='7FFFFFE000000000'x then + VM="z/VM 6.1.0 " + When D00LicBits=='7FFFFFF000000000'x then + VM="z/VM 6.2.0 " + Otherwise + Vm="z/VM 6.2.0+" + End /* Select */ + LevelNote=Word("This -1 -2 -3 -4",Level) + Say "====" LevelNote "level of VM ====" + Say "VM:" VM CPRSU XMode LPar + Say "User:" D00UserId " Time offset:" TimeOffset + Call DumpIt lMsg + End /* VMLevels */ +Exit +DumpIt: Procedure + Parse arg String + StrLen=Length(String) + PerLine=16 + Do i=1 to Format(StrLen/PerLine,,0) + l=Min(PerLine,StrLen-((i-1)*PerLine)) + Piece=Substr(String,((i-1)*PerLine)+1,l) + /* 0...4...8...C...0...4...8...C... */ + VDump=Translate(Piece,"................................"||, + "................................"||, + " ..........¢<(+|&.........!$*);^"||, + "-/.........,%_>?..........:#@'="""||, + ".abcdefghi.......jklmnopqr......"||, + ".~stuvwxyz......................"||, + "{ABCDEFGHI......}JKLMNOPQR......"||, + "\.STUVWXYZ......0123456789......",, + XRange("00"x,"FF"x)) + Say D2x((i-1)*PerLine,4) Left(C2X(Piece),PerLine*2), + "*"Left(VDump,PerLine)"*" + End +Return diff --git a/vmworkshop-vmarcs/1996/drct-xx/README.md b/vmworkshop-vmarcs/1996/drct-xx/README.md new file mode 100644 index 0000000..f1c96e1 --- /dev/null +++ b/vmworkshop-vmarcs/1996/drct-xx/README.md @@ -0,0 +1,79 @@ +## Prerequisite: +You need to install these PTFs: +- http://www-01.ibm.com/support/docview.wss?uid=isg1VM65202 +- http://www-01.ibm.com/support/docview.wss?uid=isg1VM65257 + +The rexx are implemented to work with the new directory statements appeared +with the z/VM620 but they are not tested on this version. + +The package "should" be unpacked and used on your new VM. + +You must use VALID user withpass files. + +IBM adds commentaries on the top of the user withpass files. DRCT-01 and +DRCT-02 remove them. + +OLD and NEW parameters refer to the filenames of the user withpass files. +For example, if you migrate from a z/VM530 to a z/VM540, you can code +OLD="ZVM530" and NEW="ZVM540". ZVM530 WITHPASS A0 and ZVM540 WITHPASS A0 will +be used. Edit each file of the package to apply your own values. + +Default member names for DIRECTORY and GLOBALDEFS are DIRECT and GLOBAL. You +have to check first you do not have any directory named with these defaults. If +you meet that case, you have to modify DRCT-01, DRCT-02 and DRCT-03. Do a +ALL/*COPY / xedit command and apply the name of your choice. + +## DRCT-01 EXEC +The EXEC creates the "old" MACLIB. You can discard members you know you will +never need in your new VM. Retain the members you have discarded if you need to +regenerate this maclib later, for the day of your migration for example. It is +easy to create a small rexx with this kind of order: +"MAClib DELete libname membernames" + +## DRCT-02 EXEC +The EXEC creates the "new" MACLIB. + +## DRCT-03 EXEC +DRCT-03 creates the DRCT-04 EXEC A. +DRCT-03 creates the UNIQUE MACLIB where all unique directories from "old" and +"new" maclibs are merged. This maclib is only used to check and confirm a +normal situation. For example, if you have a user $ALLOC$ in z/VM530 and a user +$ALOC$ in z/VM540, they are unique but have the same function. You could want +to take some actions in such a case. + +## DRCT-04 EXEC, DRCT-01 XEDIT and DRCT-02 XEDIT +Don't run this exec "as is" the first time, go in... You could prefer to cut it +into several pieces. +DRCT-04 EXEC treats the duplicates. You enter in xedit mode where you can see +the two same member names from the two maclibs. The "old" and the "new" members +appear one above the other. DRCT-01 XEDIT is a default profile. Copy/paste your +modifications manually. If you "quit" or "file", you come back to a file (which +one ?) in screen set to 1. You will rapidely remark it is confusing... PF03 +avoids this: it activates the DRCT-02 xedit macro that does small controls for +you too. The macro doesn't allow you to alter the old member (you are not +supposed to). With no excessive development, it permits to control if the ALT +xedit value was changed or not. If you did, you probably thought you were +modifying the good file... To "file" your changes you have to move the cursor +in the old member and press PF03. + +## DRCT-05 EXEC +DRCT-05 only builds the "new" USER INPUT file with your system defaults. So, +you can test your changes in your new environment. Tests after tests you will +no more bring changes into it. It is time to backup the "new" maclib. +The maclib now is THE maclib you will use each time you will need to merge it +with the "old" maclib, and later, THE maclib you will use the day of the +migration. + +## DRCT-06 EXEC +DRCT-06 merges the "old" and the "new" MACLIBs to build a USER INPUT file. +For duplicate directories, the "new" one are selected. All the unique +directories are selected. + +## DRCT-07 EXEC +Dirmaint is required. Do not run this exec before you understand what it does: + - The exec sends a USER BACKUP file to your reader that can be reused if you + meet problems. + - DRCT-07 ACTIVATES the USER INPUT file. + +## DRCT-08 EXEC +The exec compacts the "new" maclib. diff --git a/vmworkshop-vmarcs/1996/drct-xx/drct-01.exec b/vmworkshop-vmarcs/1996/drct-xx/drct-01.exec new file mode 100644 index 0000000..eb0a409 --- /dev/null +++ b/vmworkshop-vmarcs/1996/drct-xx/drct-01.exec @@ -0,0 +1,56 @@ +/**/ +OLD="" +"PIPE (ENDCHAR ?)", + "01: FANINANY", + "| STRFROMLabel /*COPY/", + "| PAD 80", + "|02: MACLIB *COPY", + "|03: FANIN", + "|04: > "OLD" MACLIB A1 Fixed", + "?", + "02:", + "| BUFFER", + "|03:", + "?", + "02:", + "|04:", + "?", + "< "OLD" WITHPASS A0", + "| CHOP 72", + "|05: PICK W1 == /DIRECTORY/", + "| SPECS /*COPY DIRECT/ 1 WRITE", + " 1-* 1", + "|01:", + "?", + "05:", + "|06: PICK W1 == /GLOBALDEFS/", + "| SPECS /*COPY GLOBAL/ 1 WRITE", + " 1-* 1", + "|01:", + "?", + "06:", + "|07: PICK W1 == /IDENTITY/", + "| SPECS /*COPY/ 1 W2 NW WRITE", + " 1-* 1", + "|01:", + "?", + "07:", + "|08: PICK W1 == /PROFILE/", + "| SPECS /*COPY/ 1 W2 NW WRITE", + " 1-* 1", + "|01:", + "?", + "08:", + "|09: PICK W1 == /SUBCONFIG/", + "| SPECS /*COPY/ 1 W2 NW WRITE", + " 1-* 1", + "|01:", + "?", + "09:", + "|10: PICK W1 == /USER/", + "| SPECS /*COPY/ 1 W2 NW WRITE", + " 1-* 1", + "|01:", + "?", + "10:", + "|01:" diff --git a/vmworkshop-vmarcs/1996/drct-xx/drct-01.xedit b/vmworkshop-vmarcs/1996/drct-xx/drct-01.xedit new file mode 100644 index 0000000..01f560e --- /dev/null +++ b/vmworkshop-vmarcs/1996/drct-xx/drct-01.xedit @@ -0,0 +1,51 @@ +/**/ +"SET COLOR ARROW RED NONE" +"SET COLOR CMDLINE GREEN NONE" +"SET COLOR CURLINE WHITE NONE" +"SET COLOR FILEAREA GREEN NONE" +"SET COLOR IDLINE TURQUOISE NONE" +"SET COLOR MSGLINE PINK NONE" +"SET COLOR PENDING WHITE NONE" +"SET COLOR PREFIX YELLOW NONE" +"SET COLOR SCALE PINK NONE" +"SET COLOR SHADOW YELLOW NONE" +"SET COLOR STATAREA YELLOW REVVIDEO" +"SET COLOR TABLINE DEFAULT NONE" +"SET COLOR TOFEOF WHITE NONE" +"SET CURLINE ON 3" +"SET MSGLINE ON 2 2 OVERLAY" +"SET MSGMODE ON LONG" +"SET NULLS ON" +"SET NUMBER ON" +"SET PA1 ONLY NULLKEY" +"SET PA2 ONLY NULLKEY" +"SET PA3 ONLY NULLKEY" +"SET PF01 BEFORE TOP" +"SET PF02 BEFORE BOT" +"SET PF03 BEFORE MACRO DRCT-02" +"SET PF04 ONLY NULLKEY" +"SET PF05 BEFORE JOIN ALIGNED" +"SET PF06 BEFORE SPLTJOIN" +"SET PF07 BEFORE BACKWARD" +"SET PF08 BEFORE FORWARD" +"SET PF10 ONLY NULLKEY" +"SET PF11 ONLY NULLKEY" +"SET PF12 BEFORE =" +"SET PF13 ONLY NULLKEY" +"SET PF14 ONLY NULLKEY" +"SET PF15 ONLY NULLKEY" +"SET PF16 ONLY NULLKEY" +"SET PF17 ONLY NULLKEY" +"SET PF18 ONLY NULLKEY" +"SET PF19 ONLY NULLKEY" +"SET PF20 ONLY NULLKEY" +"SET PF21 ONLY NULLKEY" +"SET PF22 ONLY NULLKEY" +"SET PF23 ONLY NULLKEY" +"SET PF24 ONLY NULLKEY" +"SET SCALE ON 2" +"SET STAY ON" +"SET TRUNC 72" +"SET VERIFY 1 72" +"SET WRAP OFF" +"SET ZONE 1 72" diff --git a/vmworkshop-vmarcs/1996/drct-xx/drct-02.exec b/vmworkshop-vmarcs/1996/drct-xx/drct-02.exec new file mode 100644 index 0000000..ed5ea31 --- /dev/null +++ b/vmworkshop-vmarcs/1996/drct-xx/drct-02.exec @@ -0,0 +1,56 @@ +/**/ +NEW="" +"PIPE (ENDCHAR ?)", + "01: FANINANY", + "| STRFROMLabel /*COPY/", + "| PAD 80", + "|02: MACLIB *COPY", + "|03: FANIN", + "|04: > "NEW" MACLIB A1 Fixed", + "?", + "02:", + "| BUFFER", + "|03:", + "?", + "02:", + "|04:", + "?", + "< "NEW" WITHPASS A0", + "| CHOP 72", + "|05: PICK W1 == /DIRECTORY/", + "| SPECS /*COPY DIRECT/ 1 WRITE", + " 1-* 1", + "|01:", + "?", + "05:", + "|06: PICK W1 == /GLOBALDEFS/", + "| SPECS /*COPY GLOBAL/ 1 WRITE", + " 1-* 1", + "|01:", + "?", + "06:", + "|07: PICK W1 == /IDENTITY/", + "| SPECS /*COPY/ 1 W2 NW WRITE", + " 1-* 1", + "|01:", + "?", + "07:", + "|08: PICK W1 == /PROFILE/", + "| SPECS /*COPY/ 1 W2 NW WRITE", + " 1-* 1", + "|01:", + "?", + "08:", + "|09: PICK W1 == /SUBCONFIG/", + "| SPECS /*COPY/ 1 W2 NW WRITE", + " 1-* 1", + "|01:", + "?", + "09:", + "|10: PICK W1 == /USER/", + "| SPECS /*COPY/ 1 W2 NW WRITE", + " 1-* 1", + "|01:", + "?", + "10:", + "|01:" diff --git a/vmworkshop-vmarcs/1996/drct-xx/drct-02.xedit b/vmworkshop-vmarcs/1996/drct-xx/drct-02.xedit new file mode 100644 index 0000000..70d2f01 --- /dev/null +++ b/vmworkshop-vmarcs/1996/drct-xx/drct-02.xedit @@ -0,0 +1,15 @@ +/**/ +OLD="" +NEW="" +"REFRESH" +"EXTRACT /LIBNAME/" +IF SPACE(LIBNAME.1)==NEW THEN "MSG Error: You are not allowed to FILE from the "NEW" MACLIB" + ELSE DO + "EXTRACT /ALT/" + IF ALT.1>0 THEN "MSG Error: The member of the "OLD" MACLIB was ALTered" + ELSE DO + "QQUIT" + "SET SCREEN 1" + "FILE" + END +END diff --git a/vmworkshop-vmarcs/1996/drct-xx/drct-03.exec b/vmworkshop-vmarcs/1996/drct-xx/drct-03.exec new file mode 100644 index 0000000..d88ecc8 --- /dev/null +++ b/vmworkshop-vmarcs/1996/drct-xx/drct-03.exec @@ -0,0 +1,81 @@ +/**/ +OLD="" +NEW="" +"PIPE (ENDCHAR ?)", + "LITERAL /**/", + "|01: FANIN", + "|> DRCT-04 EXEC A1", + "?", + "02: FANINANY", + "| STRFROMLabel /*COPY/", + "| PAD 80", + "|03: MACLIB *COPY", + "|04: FANIN", + "|05: > UNIQUE MACLIB A1 Fixed", + "?", + "03:", + "| BUFFER", + "|04:", + "?", + "03:", + "|05:", + "?", + "06: FANINANY", + "| CHOP 72", + "|07: PICK W1 == /DIRECTORY/", + "| SPECS /*COPY DIRECT/ 1 WRITE", + " 1-* 1", + "|02:", + "?", + "07:", + "|08: PICK W1 == /GLOBALDEFS/", + "| SPECS /*COPY GLOBAL/ 1 WRITE", + " 1-* 1", + "|02:", + "?", + "08:", + "|09: PICK W1 == /IDENTITY/", + "| SPECS /*COPY/ 1 W2 NW WRITE", + " 1-* 1", + "|02:", + "?", + "09:", + "|10: PICK W1 == /PROFILE/", + "| SPECS /*COPY/ 1 W2 NW WRITE", + " 1-* 1", + "|02:", + "?", + "10:", + "|11: PICK W1 == /SUBCONFIG/", + "| SPECS /*COPY/ 1 W2 NW WRITE", + " 1-* 1", + "|02:", + "?", + "11:", + "|12: PICK W1 == /USER/", + "| SPECS /*COPY/ 1 W2 NW WRITE", + " 1-* 1", + "|02:", + "?", + "12:", + "|02:", + "?", + "LISTPDS "NEW" MACLIB A1", + "| CHOP 8", + "| SORT 1-*", + "|13: COLLATE 1-* MASTER", + "| SPECS /QUEUE "||X2C("7F")||"XEDIT "OLD" MACLIB A1 (PROFILE DRCT-01 MEMBER/ 1 W1 NW /"||X2C("7F")||"/ N WRITE", + " /QUEUE "||X2C("7F")||"SET SCREEN 2 HORIZONTAL"||X2C("7F")||"/ 1 WRITE", + " /"||X2C("7F")||"XEDIT "NEW" MACLIB A1 (PROFILE DRCT-01 MEMBER/ 1 W1 NW /"||X2C("7F")||"/ N", + "|01:", + "?", + "LISTPDS "OLD" MACLIB A1", + "| CHOP 8", + "| SORT 1-*", + "|13:", + "| MEMBERS "NEW" MACLIB A1", + "|06:", + "?", + "13:", + "| MEMBERS "OLD" MACLIB A1", + "|06:" diff --git a/vmworkshop-vmarcs/1996/drct-xx/drct-05.exec b/vmworkshop-vmarcs/1996/drct-xx/drct-05.exec new file mode 100644 index 0000000..52cc1a0 --- /dev/null +++ b/vmworkshop-vmarcs/1996/drct-xx/drct-05.exec @@ -0,0 +1,58 @@ +/**/ +NEW="" +"PIPE (ENDCHAR ?)", + "01: FANINANY", + "|02: PICK 1.10 /== /"COPIES(" ",10)"/", + "|03: JUXTAPOSe", + "| SORT 1.10", + "| SPECS 21-*", + "|> USER INPUT A0", + "?", + "02:", + "|03:", + "?", + "04: FANINANY", + "|05: PICK W1 == /DIRECTORY/", + "| SPECS /01/ 1 W2 3.8 WRITE", + " 1-* 11", + "|01:", + "?", + "05:", + "|06: PICK W1 == /GLOBALDEFS/", + "| SPECS /02/ 1 W2 3.8 WRITE", + " 1-* 11", + "|01:", + "?", + "06:", + "|07: PICK W1 == /PROFILE/", + "| SPECS /03/ 1 W2 3.8 WRITE", + " 1-* 11", + "|01:", + "?", + "07:", + "|08: PICK W1 == /IDENTITY/", + "| SPECS /04/ 1 W2 3.8 WRITE", + " 1-* 11", + "|01:", + "?", + "08:", + "|09: PICK W1 == /SUBCONFIG/", + "| SPECS /04/ 1 W2 3.8 WRITE", + " 1-* 11", + "|01:", + "?", + "09:", + "|10: PICK W1 == /USER/", + "| SPECS /04/ 1 W2 3.8 WRITE", + " 1-* 11", + "|01:", + "?", + "10:", + "| SPECS 1-* 11", + "|01:", + "?", + "LISTPDS "NEW" MACLIB A1", + "| CHOP 8", + "| SORT 1-*", + "| MEMBERs "NEW" MACLIB A1", + "|04:" diff --git a/vmworkshop-vmarcs/1996/drct-xx/drct-06.exec b/vmworkshop-vmarcs/1996/drct-xx/drct-06.exec new file mode 100644 index 0000000..1e170f9 --- /dev/null +++ b/vmworkshop-vmarcs/1996/drct-xx/drct-06.exec @@ -0,0 +1,71 @@ +/**/ +OLD="" +NEW="" +"PIPE (ENDCHAR ?)", + "01: FANINANY", + "|02: PICK 1.10 /== /"COPIES(" ",10)"/", + "|03: JUXTAPOSe", + "| SORT 1.10", + "| SPECS 21-*", + "|> USER INPUT A0", + "?", + "02:", + "|03:", + "?", + "04: FANINANY", + "|05: PICK W1 == /DIRECTORY/", + "| SPECS /01/ 1 W2 3.8 WRITE", + " 1-* 11", + "|01:", + "?", + "05:", + "|06: PICK W1 == /GLOBALDEFS/", + "| SPECS /02/ 1 W2 3.8 WRITE", + " 1-* 11", + "|01:", + "?", + "06:", + "|07: PICK W1 == /PROFILE/", + "| SPECS /03/ 1 W2 3.8 WRITE", + " 1-* 11", + "|01:", + "?", + "07:", + "|08: PICK W1 == /IDENTITY/", + "| SPECS /04/ 1 W2 3.8 WRITE", + " 1-* 11", + "|01:", + "?", + "08:", + "|09: PICK W1 == /SUBCONFIG/", + "| SPECS /04/ 1 W2 3.8 WRITE", + " 1-* 11", + "|01:", + "?", + "09:", + "|10: PICK W1 == /USER/", + "| SPECS /04/ 1 W2 3.8 WRITE", + " 1-* 11", + "|01:", + "?", + "10:", + "| SPECS 1-* 11", + "|01:", + "?", + "LISTPDS "NEW" MACLIB A1", + "| CHOP 8", + "| SORT 1-*", + "|11: COLLATE 1-* MASTER", + "| MEMBERs "NEW" MACLIB A1", + "|04:", + "?", + "LISTPDS "OLD" MACLIB A1", + "| CHOP 8", + "| SORT 1-*", + "|11:", + "| MEMBERs "NEW" MACLIB A1", + "|04:", + "?", + "11:", + "| MEMBERs "OLD" MACLIB A1", + "|04:" diff --git a/vmworkshop-vmarcs/1996/drct-xx/drct-07.exec b/vmworkshop-vmarcs/1996/drct-xx/drct-07.exec new file mode 100644 index 0000000..db15fa9 --- /dev/null +++ b/vmworkshop-vmarcs/1996/drct-xx/drct-07.exec @@ -0,0 +1,12 @@ +/**/ +"PIPE LITERAL USER BACKUP", + "| APPEND LITERAL SEND USER BACKUP G", + "|> $$TEMP$$ $$TEMP$$ A3" +"DIRMAINT BATCH $$TEMP$$ $$TEMP$$ A3" +"DIRMAINT FILE USER INPUT A0 = = E" +"PIPE LITERAL CMS ERASE USER DIRECT E", + "| APPEND LITERAL RLDDATA", + "| APPEND LITERAL ENABLE", + "| APPEND LITERAL DIRECT", + "|> $$TEMP$$ $$TEMP$$ A3" +"DIRMAINT BATCH $$TEMP$$ $$TEMP$$ A3" diff --git a/vmworkshop-vmarcs/1996/drct-xx/drct-08.exec b/vmworkshop-vmarcs/1996/drct-xx/drct-08.exec new file mode 100644 index 0000000..8103117 --- /dev/null +++ b/vmworkshop-vmarcs/1996/drct-xx/drct-08.exec @@ -0,0 +1,3 @@ +/**/ +NEW="" +"MACLIB COMP "NEW diff --git a/vmworkshop-vmarcs/1996/identd/README.md b/vmworkshop-vmarcs/1996/identd/README.md new file mode 100644 index 0000000..721a2fc --- /dev/null +++ b/vmworkshop-vmarcs/1996/identd/README.md @@ -0,0 +1,21 @@ +## ORIGINAL README +``` +Copyright 1995, Richard M. Troth, all rights reserved. + + Name: IDENTD FILELIST + package spec for the Pipelined VM/CMS IDENT/TAP Server + Author: Rick Troth, Houston, Texas + Date: 1994-Oct-14 + Version: 1.1.1, aka (V1) R1 M1, or just "1.1" + + Note: I will install this software on your system if you like. + If you have any problems, questions, or suggestions, + send e-mail to troth@ua1vm.ua.edu or rmtroth@aol.com. + +IDENTD FILELIST +IDENTD EXEC +IDENTD REXX +TCPSHELL EXEC +PIPESOCK REXX +MAKETEXT REXX +``` diff --git a/vmworkshop-vmarcs/1996/identd/identd.exec b/vmworkshop-vmarcs/1996/identd/identd.exec new file mode 100644 index 0000000..a244d09 --- /dev/null +++ b/vmworkshop-vmarcs/1996/identd/identd.exec @@ -0,0 +1,33 @@ +/* © Copyright 1995, Richard M. Troth, all rights reserved. + * + * Name: IDENTD EXEC + * IDENT/TAP (RFC 1413) server for VM/CMS + * Author: Rick Troth, Houston, Texas, USA + * Date: 1994-Oct-14 + * Version: 1.1.1, aka (V1) R1 M1, or just "1.1" + * + * Co-reqs: TCPSHELL EXEC (supplied) + * CMS Pipelines + * REXX/Sockets (RXSOCKET V2) + * VM TCP/IP V2 + */ + +vrm = "1.1.1" + +Parse Source . . arg0 . +version = arg0 || '/' || vrm +Parse Arg args + +Address "COMMAND" + +Parse Var vrm v '.' r '.' m +time = Time(); date = Date('S') +'XMITMSG 8399 ARG0 V R M "N/A" TIME DATE (ERRMSG' + +'GLOBALV SELECT' arg0 'PUT VERSION VRM' + +'EXEC TCPSHELL (NOIDENT) 113' arg0 args + +Exit rc + + diff --git a/vmworkshop-vmarcs/1996/identd/identd.filelist b/vmworkshop-vmarcs/1996/identd/identd.filelist new file mode 100644 index 0000000..fad3fa3 --- /dev/null +++ b/vmworkshop-vmarcs/1996/identd/identd.filelist @@ -0,0 +1,20 @@ +* © Copyright 1995, Richard M. Troth, all rights reserved. <plaintext> +* +* Name: IDENTD FILELIST +* package spec for the Pipelined VM/CMS IDENT/TAP Server +* Author: Rick Troth, Houston, Texas +* Date: 1994-Oct-14 +* Version: 1.1.1, aka (V1) R1 M1, or just "1.1" +* +* Note: I will install this software on your system if you like. +* If you have any problems, questions, or suggestions, +* send e-mail to troth@ua1vm.ua.edu or rmtroth@aol.com. +* + IDENTD FILELIST * + IDENTD EXEC * + IDENTD REXX * + TCPSHELL EXEC * + PIPESOCK REXX * + MAKETEXT REXX * + RFC1413 TXT * +* diff --git a/vmworkshop-vmarcs/1996/identd/identd.rexx b/vmworkshop-vmarcs/1996/identd/identd.rexx new file mode 100644 index 0000000..93e9636 --- /dev/null +++ b/vmworkshop-vmarcs/1996/identd/identd.rexx @@ -0,0 +1,60 @@ +/* © Copyright 1995, Richard M. Troth, all rights reserved. <plaintext> + * + * Name: IDENTD REXX + * IDENT/TAP (RFC 1413) server for VM/CMS pipeline stage + * Author: Rick Troth, Houston, Texas, USA + * Date: 1994-Oct-15 + * Version: 1.1.1, aka (V1) R1 M1, or just "1.1" + */ + +/* read the IDENT request */ +'PEEKTO LINE' +If rc ^= 0 Then Exit rc + +Parse Var line lsoc ',' fsoc ',' . ':' . +If ^Datatype(lsoc,'W') | ^Datatype(fsoc,'W') Then Do + Say argo "0 , 0 : ERROR : INVALID-PORT" + 'OUTPUT' "0 , 0 : ERROR : INVALID-PORT" + Exit + End /* If .. Do */ + +/* attach NETSTAT now, in case it someday runs asynch */ +'ADDPIPE COMMAND NETSTAT | NLOCATE /*/ | *.INPUT:' + +/* crunch CMS' equivalent of /etc/services */ +'CALLPIPE < ETC SERVICES | NLOCATE 1.1 /#/' , + '| XLATE UPPER | STEM SERVICES.' +Do i = 1 to services.0 + Parse Var services.i name numb . + Parse Var numb numb '/' . + service.name = numb + End + +/* read that NETSTAT output, looking for a match */ +Do Forever + + 'PEEKTO LINE' + If rc ^= 0 Then Leave + + Parse Var line user conn lsok fsok stat . + Parse Var lsok . '..' lsok + If ^Datatype(lsok,'W') Then lsok = service.lsok + Parse Var fsok . '..' fsok + If ^Datatype(fsok,'W') Then fsok = service.fsok + + If lsok = lsoc & fsok = fsoc Then Do + Say argo lsok ',' fsok ': USERID : CMS :' user + 'OUTPUT' lsok ',' fsok ': USERID : CMS :' user + Exit + End /* If .. Do */ + + 'READTO' + If rc ^= 0 Then Leave + + End /* Do Forever */ + +Say argo lsoc ',' fsoc ": ERROR : NO-USER" +'OUTPUT' lsoc ',' fsoc ": ERROR : NO-USER" + +Exit + diff --git a/vmworkshop-vmarcs/1996/identd/maketext.rexx b/vmworkshop-vmarcs/1996/identd/maketext.rexx new file mode 100644 index 0000000..6755875 --- /dev/null +++ b/vmworkshop-vmarcs/1996/identd/maketext.rexx @@ -0,0 +1,227 @@ +/* © Copyright 1994, Richard M. Troth, all rights reserved. <plaintext> + * + * Name: MAKETEXT REXX + * VM TCP/IP Network Client and Server text converter + * Inspired by GOPCLITX, DROPDOTS, and other gems. + * Renamed from WEBTEXT because it's ubiquitous. + * Author: Rick Troth, Houston, Texas, USA + * Date: 1994-Feb-27, 1994-Oct-15 + * + * Replaces: A2E, E2A, TCPA2E, TCPE2A + */ + +/* ----------------------------------------------------------------- ÆCS + * ASCII to EBCDIC and vice-versa code conversion tables. + * Tables included here are based on ASCII conforming to the ISO8859-1 + * Latin 1 character set and EBCDIC conforming to the IBM Code Page 37 + * Latin 1 character set (except for three pairs of characters in 037). + */ + +Parse Upper Arg mode code . +If mode = "" Then mode = "LOCAL" + + i = '000102030405060708090A0B0C0D0E0F'x + i = i || '101112131415161718191A1B1C1D1E1F'x + i = i || '202122232425262728292A2B2C2D2E2F'x + i = i || '303132333435363738393A3B3C3D3E3F'x + i = i || '404142434445464748494A4B4C4D4E4F'x + i = i || '505152535455565758595A5B5C5D5E5F'x + i = i || '606162636465666768696A6B6C6D6E6F'x + i = i || '707172737475767778797A7B7C7D7E7F'x + i = i || '808182838485868788898A8B8C8D8E8F'x + i = i || '909192939495969798999A9B9C9D9E9F'x + i = i || 'A0A1A2A3A4A5A6A7A8A9AAABACADAEAF'x + i = i || 'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF'x + i = i || 'C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF'x + i = i || 'D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF'x + i = i || 'E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF'x + i = i || 'F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF'x + +If code ^= "" Then Do + 'CALLPIPE DISK' code 'TCPXLBIN | STEM XLT.' + If rc ^= 0 | xlt.0 < 3 Then code = "" + End /* If .. Do */ + +Select /* mode */ + When Abbrev("LOCAL",mode,3) Then Call LOCAL + When Abbrev("LCL",mode,3) Then Call LOCAL + When Abbrev("EBCDIC",mode,1) Then Call LOCAL + When Abbrev("NETWORK",mode,3) Then Call NETWORK + When Abbrev("ASCII",mode,1) Then Call NETWORK + When Abbrev("DOTTED",mode,3) Then Call DOTTED + When Abbrev("UNIX",mode,1) Then Call UNIX + Otherwise Do + Address "COMMAND" 'XMITMSG 3 MODE (ERRMSG' + rc = 24 + End /* Otherwise Do */ + End /* Select mode */ + +Exit rc * (rc ^= 12) + + +/* --------------------------------------------------------------- LOCAL + * Input: raw ASCII text + * Output: plain (EBCDIC) text + */ +LOCAL: + +'ADDPIPE *.OUTPUT: | STRIP TRAILING 0D | PAD 1 | *.OUTPUT:' +If rc ^= 0 Then Return + +If code = "" Then Do /* use the standard table */ + e = '00010203372D2E2F1605250B0C0D0E0F'x + e = e || '101112133C3D322618193F271C1D1E1F'x + e = e || '405A7F7B5B6C507D4D5D5C4E6B604B61'x + e = e || 'F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F'x + e = e || '7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6'x + e = e || 'D7D8D9E2E3E4E5E6E7E8E9ADE0BD5F6D'x + e = e || '79818283848586878889919293949596'x + e = e || '979899A2A3A4A5A6A7A8A9C04FD0A107'x + e = e || '202122232415061728292A2B2C090A1B'x + e = e || '30311A333435360838393A3B04143EFF'x + e = e || '41AA4AB19FB26AB5BBB49A8AB0CAAFBC'x + e = e || '908FEAFABEA0B6B39DDA9B8BB7B8B9AB'x + e = e || '6465626663679E687471727378757677'x + e = e || 'AC69EDEEEBEFECBF80FDFEFBFCBAAE59'x + e = e || '4445424643479C485451525358555657'x + e = e || '8C49CDCECBCFCCE170DDDEDBDC8D8EDF'x + End /* If .. Do */ +Else e = xlt.2 + +buff = "" +Do Forever + + 'PEEKTO DATA' + If rc ^= 0 Then Leave + + buff = buff || data + Do While Index(buff,'0A'x) > 0 + Parse Var buff line '0A'x buff + 'OUTPUT' Translate(line,e,i) + If rc ^= 0 Then Leave + End /* Do While */ + If rc ^= 0 Then Leave + + 'READTO' + If rc ^= 0 Then Leave + + End /* Do Forever */ + +If buff ^= "" Then 'OUTPUT' Translate(buff,e,i) + +Return + + +/* ------------------------------------------------------------- NETWORK + * Input: plain (EBCDIC) text + * Output: raw ASCII byte stream + */ +NETWORK: + +'ADDPIPE *.OUTPUT: | SPEC 1-* 1 x0D0A NEXT | *.OUTPUT:' +If rc ^= 0 Then Return + +If code = "" Then Do /* use the standard table */ + a = '000102039C09867F978D8E0B0C0D0E0F'x + a = a || '101112139D8508871819928F1C1D1E1F'x + a = a || '80818283840A171B88898A8B8C050607'x + a = a || '909116939495960498999A9B14159E1A'x + a = a || '20A0E2E4E0E1E3E5E7F1A22E3C282B7C'x + a = a || '26E9EAEBE8EDEEEFECDF21242A293B5E'x + a = a || '2D2FC2C4C0C1C3C5C7D1A62C255F3E3F'x + a = a || 'F8C9CACBC8CDCECFCC603A2340273D22'x + a = a || 'D8616263646566676869ABBBF0FDFEB1'x + a = a || 'B06A6B6C6D6E6F707172AABAE6B8C6A4'x + a = a || 'B57E737475767778797AA1BFD05BDEAE'x + a = a || 'ACA3A5B7A9A7B6BCBDBEDDA8AF5DB4D7'x + a = a || '7B414243444546474849ADF4F6F2F3F5'x + a = a || '7D4A4B4C4D4E4F505152B9FBFCF9FAFF'x + a = a || '5CF7535455565758595AB2D4D6D2D3D5'x + a = a || '30313233343536373839B3DBDCD9DA9F'x + End /* If .. Do */ +Else a = xlt.3 + +Do Forever + + 'PEEKTO LINE' + If rc ^= 0 Then Leave + + 'OUTPUT' Translate(line,a,i) + If rc ^= 0 Then Leave + + 'READTO' + If rc ^= 0 Then Leave + + End /* Do Forever */ + +Return + + +/* -------------------------------------------------------------- DOTTED + * Input: plain (EBCDIC) text + * Output: ASCII byte stream terminated by CR/LF/./CR/LF + */ +DOTTED: + +Call NETWORK + +'OUTPUT' Translate('.',a,i) + +Return + + +/* + * variables: + * xlt.0 should be "3", meaning three records read + * xlt.1 should be a comment + * xlt.2 should be our ASCII ---> EBCDIC table + * xlt.3 should be our EBCDIC ---> ASCII table + * i is set to the dummy input table + */ + + +/* ---------------------------------------------------------------- UNIX + * Input: plain (EBCDIC) text + * Output: ASCII byte stream with UNIX line convention (NL) + */ +UNIX: + +'ADDPIPE *.OUTPUT: | SPEC 1-* 1 x0A NEXT | *.OUTPUT:' +If rc ^= 0 Then Return + +If code = "" Then Do /* use the standard table */ + a = '000102039C09867F978D8E0B0C0D0E0F'x + a = a || '101112139D8508871819928F1C1D1E1F'x + a = a || '80818283840A171B88898A8B8C050607'x + a = a || '909116939495960498999A9B14159E1A'x + a = a || '20A0E2E4E0E1E3E5E7F1A22E3C282B7C'x + a = a || '26E9EAEBE8EDEEEFECDF21242A293B5E'x + a = a || '2D2FC2C4C0C1C3C5C7D1A62C255F3E3F'x + a = a || 'F8C9CACBC8CDCECFCC603A2340273D22'x + a = a || 'D8616263646566676869ABBBF0FDFEB1'x + a = a || 'B06A6B6C6D6E6F707172AABAE6B8C6A4'x + a = a || 'B57E737475767778797AA1BFD05BDEAE'x + a = a || 'ACA3A5B7A9A7B6BCBDBEDDA8AF5DB4D7'x + a = a || '7B414243444546474849ADF4F6F2F3F5'x + a = a || '7D4A4B4C4D4E4F505152B9FBFCF9FAFF'x + a = a || '5CF7535455565758595AB2D4D6D2D3D5'x + a = a || '30313233343536373839B3DBDCD9DA9F'x + End /* If .. Do */ +Else a = xlt.3 + +Do Forever + + 'PEEKTO LINE' + If rc ^= 0 Then Leave + If line = " " Then line = "" + + 'OUTPUT' Translate(line,a,i) + If rc ^= 0 Then Leave + + 'READTO' + If rc ^= 0 Then Leave + + End /* Do Forever */ + +Return + diff --git a/vmworkshop-vmarcs/1996/identd/pipesock.rexx b/vmworkshop-vmarcs/1996/identd/pipesock.rexx new file mode 100644 index 0000000..5c9c7a8 --- /dev/null +++ b/vmworkshop-vmarcs/1996/identd/pipesock.rexx @@ -0,0 +1,83 @@ +/* © Copyright 1994, Richard M. Troth, all rights reserved. <plaintext> + * + * Name: PIPESOCKET REXX + * until the day when there's a true asynch SOCKET stage + * Author: Rick Troth, Rice University, Information Systems + * Date: 1993-Feb-23, Aug-25 + */ + +Parse Source . . . . . arg0 . +argo = arg0 || ':' + +'ADDSTREAM OUTPUT STAT' +'ADDPIPE *.OUTPUT.STAT: | SPEC /' || argo || ' / 1 1-* NEXT | CONSOLE' + +Parse Upper Arg func sock opts + +Select /* func */ + When Abbrev("READ",func,1) Then Signal READ + When Abbrev("WRITE",func,1) Then Signal WRITE + Otherwise Do + Address "COMMAND" 'XMITMSG 3 FUNC (CALLER SOX ERRMSG' + Exit 24 + End /* Otherwise Do */ + End /* Select func */ + +/* ---------------------------------------------------------------- READ + * Send packets from the socket to the output stream. + */ +READ: + +If Index(opts,"WAIT") > 0 Then Do + Say Socket('Ioctl', sock, 'FIONBIO') + End /* If .. Do */ + +'CALLPIPE *: | *:' /* allow follow-through */ + +'OUTPUT' /* this is e-ssential to binary mode! */ + +Do Forever + + Parse Value Socket("READ", sock, 61440) With rc bc data + If rc ^= 0 Then If bc ^= "EWOULDBLOCK" Then Do + tcprc = rc + 'CALLPIPE LITERAL' tcperror() '| *.OUTPUT.STAT:' + If rc ^= 0 Then Say argo tcperror() + rc = tcprc + Leave + End /* If .. Do */ + If bc < 1 Then Leave + + 'OUTPUT' data + If rc ^= 0 Then Leave + + End /* Do Forever */ + +Exit rc * (rc ^= 12) + + +/* --------------------------------------------------------------- WRITE + * Send records from the input stream to the socket. + */ +WRITE: + +Do Forever + + 'PEEKTO DATA' + If rc ^= 0 Then Leave + + Parse Value Socket("WRITE", sock, data) With rc bc . + If rc ^= 0 Then Do + tcprc = rc + 'CALLPIPE LITERAL' tcperror() '| *.OUTPUT.STAT:' + If rc ^= 0 Then Say argo tcperror() + Exit tcprc + End /* If .. Do */ + + 'OUTPUT' data /* allow follow-through */ + 'READTO' + + End /* Do Forever */ + +Exit rc * (rc ^= 12) + diff --git a/vmworkshop-vmarcs/1996/identd/tcpshell.exec b/vmworkshop-vmarcs/1996/identd/tcpshell.exec new file mode 100644 index 0000000..0011004 --- /dev/null +++ b/vmworkshop-vmarcs/1996/identd/tcpshell.exec @@ -0,0 +1,450 @@ +/* © Copyright 1995, Richard M. Troth, all rights reserved. <plaintext> + * + * THIS IS A NEW VERSION OF TCPSHELL WITH IMPROVED INVOKATION SYNTAX + * (TCPSHELL doesn't have a version number because it is + * included with other software which do have version numbers) + * + * Name: TCPSHELL EXEC + * General purpose TCP/IP socket-to-pipeline interface + * Author: Rick Troth, Rice University, Information Systems + * Date: 1993-Feb-29, 1994-Feb-17 + * Author: Rick Troth, Houston, Texas, USA + * Date: 1994-Feb-27, 1994-Oct-15, 1994-Jan-15, 1995-Apr-09 + * + * Co-reqs: PIPESOCKET REXX + * CMS Pipelines + * REXX/Sockets (RXSOCKET V2) + * VM TCP/IP V2 + * + * GlobalVs: ARG0 (group TCPSHELL) names the group + * LOCALHOST - FQDN of this server's host system + * LOCALPORT - TCP port at which this server listens + * SOCKET - new socket for new connection + * CLIENT - remote host (and maybe user) + * ... and some of the CGI variables ... + * QUIT - set by server pipe to terminate + */ + +Trace "OFF" +Address "COMMAND" + +Parse Source . . arg0 . +argo = arg0 || ':' /* arg0 is about to change! */ +argp = arg0 + +verbose = 1; binary = 0; ident = 1; dns = 1 + +/* we need a name and a port */ +Parse Arg test +If Left(Strip(test),1) = '(' Then Do + Parse Arg '(' opts ')' localport arg0 args + opt0 = "" + End /* If .. Do */ +/* still have to support old syntax */ +Else Do + Parse Upper Arg localport arg0 args '(' opt0 ')' . + opts = "" + End /* Else Do */ + +If localport = "" Then Do + 'XMITMSG 386 (ERRMSG' + Exit 24 + End /* If .. Do */ + +If ^Datatype(localport,'N') Then Do + 'XMITMSG 70 LOCALPORT (ERRMSG' + 'XMITMSG 8205 (ERRMSG' + Exit 24 + End /* If .. Do */ + +If arg0 = "" Then Do + 'XMITMSG 386 (ERRMSG' + Exit 24 + End /* If .. Do */ + +/* deprecated options processing */ +If opts = "" Then Do + If opt0 ^= "" Then args = args '(' + Do While opt0 ^= "" + Parse Var opt0 op opt0 + Select /* op */ + When Abbrev("BINARY",op,3) Then binary = 1 + Otherwise args = args op + End /* Select op */ + End /* Do While */ + End /* If .. Do */ + +/* preferred options processing */ +Do While opts ^= "" + Parse Var opts op opts + Select /* op */ + When Abbrev("BINARY",op,3) Then binary = 1 + When Abbrev("NOBINARY",op,3) Then binary = 0 + When Abbrev("TEXT",op,1) Then binary = 0 + When Abbrev("ASCII",op,1) Then binary = 0 + When Abbrev("IDENT",op,2) Then ident = 1 + When Abbrev("NOIDENT",op,3) Then ident = 0 + When Abbrev("VERBOSE",op,1) Then verbose = 1 + When Abbrev("NOVERBOSE",op,3) Then verbose = 0 + When Abbrev("TERSE",op,5) Then verbose = 0 + When Abbrev("DNS",op,3) Then dns = 1 + When Abbrev("NODNS",op,3) Then dns = 0 + Otherwise Address "COMMAND" 'XMITMSG 3 OP (ERRMSG' + End /* Select op */ + End /* Do While */ + +If verbose Then Do + time = Date('S') Time() + 'XMITMSG 2323 ARG0 TIME (ERRMSG' + End /* If .. Do */ + +'GLOBALV SELECT TCPSHELL PUT ARG0' +'GLOBALV SELECT' arg0 + +Parse Value Socket("VERSION") With rc . ver . +If ver < 2 Then Do + Say argo arg0 "server requires REXX/Sockets (RXSOCKET version 2)" + Exit -1 + End /* If .. Do */ + +Parse Value Socket("INITIALIZE",arg0) With rc rs +If rc ^= 0 Then Do + Say argo rs + Exit rc + End /* If .. Do */ +Parse Var rs . maxdesc svm . +If verbose Then Say argo "MAXDESC" maxdesc +If verbose Then Say argo "SVM" svm + +Parse Value Socket("GETDOMAINNAME") With rc rs +If rc ^= 0 Then Do + Say argo rs + Call Socket "TERMINATE", arg0 + Exit rc + End /* If .. Do */ +Parse Var rs dn . +Parse Value Socket("GETHOSTNAME") With rc rs +If rc ^= 0 Then Do + Say argo rs + Call Socket "TERMINATE", arg0 + Exit rc + End /* If .. Do */ +Parse Var rs hn . +localhost = hn || '.' || dn +'PIPE VAR LOCALHOST | XLATE LOWER | VAR LOCALHOST' +If verbose Then Say argo "LOCALHOST" localhost + +Parse Value Socket("SOCKET","AF_INET","SOCK_STREAM") With rc rs +If rc ^= 0 Then Do + Say argo rs + Call Socket "TERMINATE", arg0 + Exit rc + End /* If .. Do */ +Parse Var rs socket . +If verbose Then Say argo "SOCKET" socket + +/* make this address reusable */ +Parse Value Socket("SETSOCKOPT",socket,"SOL_SOCKET",, + "SO_REUSEADDR", "ON") With rc rs +If rc ^= 0 Then Do + Say argo rs + Call Socket "CLOSE", socket + Call Socket "TERMINATE", arg0 + Exit rc + End /* If .. Do */ +/* +If verbose Then Say argo "Socket" socket "set to reusable address." + */ + +/* +If ^binary Then Do + Parse Value , + Socket("SETSOCKOPT",socket,"SOL_SOCKET","SO_ASCII","ON") , + With rc rs + If rc ^= 0 Then Do + Say argo rs + Call Socket "CLOSE", socket + Call Socket "TERMINATE", arg0 + Exit rc + End + If verbose Then Say argo "Set socket" socket "to ASCII mode" + End + */ + +/* make this socket non-blocking */ +Parse Value Socket("IOCTL",socket,"FIONBIO","ON") With rc rs +If rc ^= 0 Then Do + Say argo rs + Call Socket "CLOSE", socket + Call Socket "TERMINATE", arg0 + Exit rc + End /* If .. Do */ +/* +If verbose Then Say argo "Set socket" socket "to FIONBIO mode" + */ + +/* If verbose Then */ Say argo "PORT" localport +Parse Value Socket("BIND",socket,"AF_INET" localport) With rc rs +If rc ^= 0 Then Do + Say argo rs + Call Socket "CLOSE", socket + Call Socket "TERMINATE", arg0 + Exit rc + End /* If .. Do */ + +Parse Value Socket("LISTEN",socket,maxdesc) With rc rs +If rc ^= 0 Then Do + Say argo rs + Call Socket "CLOSE", socket + Call Socket "TERMINATE", arg0 + Exit rc + End /* If .. Do */ +/* +If verbose Then Say argo "Listening ..." + */ + +'GLOBALV SELECT' arg0 'PUT LOCALHOST LOCALPORT' + +/* CGI ** CGI ** CGI ** CGI ** CGI ** CGI ** CGI ** CGI ** CGI ** CGI */ + 'PIPE VAR LOCALHOST | XLATE LOWER | VAR SERVER_NAME' + server_port = localport + 'GLOBALV SELECT' arg0 'PUT SERVER_NAME SERVER_PORT' +/* CGI ** CGI ** CGI ** CGI ** CGI ** CGI ** CGI ** CGI ** CGI ** CGI */ + +If verbose Then +If verbose Then Do + 'XMITMSG 8201 ARG0 (ERRMSG' + 'XMITMSG 740 (ERRMSG' + End /* If .. Do */ + +argp = argp || '/' || arg0 +Say argp "Ready;" + +Do Forever + +/* If verbose Then Say "*" */ + + Parse Value Socket("SELECT","READ" socket 0) With rc rs + If rc ^= 0 Then Do + Say argo rs + Leave + End /* If .. Do */ + Parse Var rs ec el + If verbose Then Say argo "EL:" el + + Parse Var el . "READ" es "WRITE" . + If verbose Then Say argo "ES:" es + If ^Datatype(es,'W') Then Leave + + If es = 0 Then Do + Parse Pull line + Parse Upper Var line verb . + If Abbrev("STOP",verb,4) Then Leave + If Abbrev("QUIT",verb,4) Then Leave + Address "CMS" line + Select /* rc */ + When rc = 0 Then Say argp "Ready;" + When rc = -3 Then , + Address "COMMAND" 'XMITMSG 15 ARG0 (ERRMSG' + Otherwise Say argp "Ready(" || rc || ");" + End /* Select rc */ + Iterate + End /* If .. Do */ + + Parse Value Socket("ACCEPT",socket) With rc rs + If rc ^= 0 Then Do + Say argo rs + Leave + End /* If .. Do */ + Parse Var rs ns client + + /* refresh disk access (same procedure as used by GONE EXEC) */ + 'PIPE COMMAND QUERY DISK | DROP | STEM STEM.' + Do i = 1 to stem.0 + Parse Var stem.i . 8 va 12 fm . + If Left(va,3) = "DIR" Then Iterate + 'DISKWRIT' Left(fm,1) + If rc = 1 Then 'ACCESS' va fm + End /* Do For */ + + /* Identify the remote in the environment */ + hostname = ""; hostaddr = "" + Parse Var client . . host . + If dns Then Do + Parse Value Socket("RESOLVE",host) With rc rs + If rc = 0 Then Parse Var rs hostaddr hostname . + End /* If .. Do */ + Else Do; hostname = host; hostaddr = host; End + 'GLOBALV SELECT' arg0 'PUT HOSTNAME HOSTADDR' + /* lower case for aesthetics */ + 'PIPE VAR HOSTNAME | XLATE LOWER | VAR HOSTNAME' + + /* Per RFC 1413, try to identify the user on the other end. */ + system = ""; userid = "" + If ident Then Do + Parse Value TAPIDENT(ns) With rc rs + If rc = 0 Then Do + Parse Var rs ':' code ':' user + Upper code + If code = "USERID" Then Do + Parse Var user system ':' userid + system = Strip(system); userid = Strip(userid) + End /* If .. Do */ + End /* If .. Do */ + End /* If .. Do */ + If hostname = "" Then client = userid || '@' || host + Else client = userid || '@' || hostname + 'GLOBALV SELECT' arg0 'PUT CLIENT' + + If verbose Then Say argo "Accepted" ns "at" Time() "client" client + +/* CGI ** CGI ** CGI ** CGI ** CGI ** CGI ** CGI ** CGI ** CGI ** CGI */ + REMOTE_ADDR = hostaddr + 'PIPE VAR HOSTNAME | XLATE LOWER | VAR REMOTE_HOST' + REMOTE_IDENT = userid + REMOTE_USER = "" + REMOTE_SYSTEM = system + 'GLOBALV SELECT' arg0 'PUT REMOTE_ADDR REMOTE_HOST' , + 'REMOTE_IDENT REMOTE_SYSTEM REMOTE_USER' +/* CGI ** CGI ** CGI ** CGI ** CGI ** CGI ** CGI ** CGI ** CGI ** CGI */ + + 'GLOBALV SELECT' arg0 'SET QUIT' /* clear this, just in case */ + + 'GLOBALV SELECT' arg0 'SET SOCKET' ns + 'GLOBALV SELECT' arg0 + /* Now here is where we do all of the real work. * + * When the gem goes to end-of-file, then the pipeline * + * terminates and the socket is closed for another iteration. */ + If binary Then , + 'PIPE PIPESOCKET READ' ns , + '|' arg0 args '(' opto , + '| PIPESOCKET WRITE' ns + Else , + 'PIPE PIPESOCKET READ' ns '| MAKETEXT LOCAL' , + '| UNTAB -8 |' arg0 args '(' opto , + '| MAKETEXT NETWORK | PIPESOCKET WRITE' ns + + Parse Value Socket("CLOSE",ns) With rc rs + If rc ^= 0 Then Do + Say argo rs + Leave + End /* If .. Do */ + If verbose Then Say argo "Closed" ns "at" Time() + + /* QUIT is a "die" signal from the application; * + * not necessarily a protocol "quit" command */ + 'GLOBALV SELECT' arg0 'GET QUIT' + If quit = 1 | quit = "YES" Then Leave + + End /* Do Forever */ + +Parse Value Socket("CLOSE",socket) With rc rs +If rc ^= 0 Then Say argo rs + +Parse Value Socket("TERMINATE",arg0) With rc rs +If rc ^= 0 Then Say argo rs + +If verbose Then Do + time = Date('S') Time() + 'XMITMSG 2324 ARG0 TIME (ERRMSG' + End /* If .. Do */ + +Exit + + +/* ------------------------------------------------------------ TAPIDENT + * + * Name: TAPIDENT (REXX function) + * Return "ownership" information about a socket. + * Requires: REXX/Sockets + * Date: 1994-Feb-01, 03 + */ +TAPIDENT: Procedure +iport = 113 +Parse Arg s + +/* + * Presume that RXSOCKET version 1 doesn't exist anymore. + */ +Parse Value Socket('Version') With rc rs +Parse Var rs name version date . +If version < 2 Then Return -1 rs + +Parse Value Socket('GetPeerName',s) With rc rs +If rc ^= 0 Then Return rc rs +Parse Var rs faf fport fhost . + +Parse Value Socket('GetSockName',s) With rc rs +If rc ^= 0 Then Return rc rs +Parse Var rs laf lport lhost . + +/* + * Safe bet that REXX/Sockets has already been initialized. + */ + +/* + * Request a new socket descriptor (TCP protocol) + */ +Parse Value Socket('Socket','AF_INET','Sock_Stream') With rc rs +If rc ^= 0 Then Return rc rs +Parse Var rs t . + +/* + * Set this socket to translate ASCII <---> EBCDIC. + */ +Parse Value Socket("SETSOCKOPT",t,"SOL_SOCKET","SO_ASCII","ON") , + With rc rs +If rc ^= 0 Then Do + Call Socket 'Close', t + Return rc rs + End /* If .. Do */ + +/* And build a "name" structure. */ +name = 'AF_INET' iport fhost + +/* + * Set this socket to non-blocking mode + */ +/* +Parse Value Socket('Ioctl',t,'FIONBIO','On') With rc errno errtx + */ + +/* + * Connect to the TAP/IDENT server there. + */ +Parse Value Socket('Connect',t,name) With rc rs +If rc ^= 0 Then Do + Call Socket 'Close', t + Return rc rs + End /* If .. Do */ + +/* + send: + LPORT , FPORT <CR><LF> + */ +data = fport ',' lport '0D25'x +Parse Value Socket("WRITE",t,data) With rc rs +If rc ^= 0 Then Do + Call Socket 'Close', t + Return rc rs + End /* If .. Do */ + +/* + * Read the response from the TAP/IDENT server. + */ +Parse Value Socket("READ",t,61440) With rc rs +If rc ^= 0 Then Do + Call Socket 'Close', t + Return rc rs + End /* If .. Do */ +Parse Var rs bc data +Parse Var data data '25'x . +Parse Var data data '0D'x . + +/* + * All done, relinquish our socket descriptor. + */ +Call Socket 'Close', t + +Return 0 data + diff --git a/vmworkshop-vmarcs/1996/mailconv/README.md b/vmworkshop-vmarcs/1996/mailconv/README.md new file mode 100644 index 0000000..a103b62 --- /dev/null +++ b/vmworkshop-vmarcs/1996/mailconv/README.md @@ -0,0 +1,20 @@ +## ORIGINAL README +``` +Copyright 1993, 1996, Richard M. Troth, all rights reserved. + +This is the README file for MAILCONVERT. +See the supplied HELP file for command syntax. + +TRANSFER YOUR UNIX MAILBOX/NOTEBOOK FILES IN BINARY. + +Strict interpretation of RFC 822 defines the break between the header +and the body of each mail message as CRLFCRLF, *not* a blank line. +This means that that blank line between header and body must not have +any TABs or SPACEs in it. The CMS minidisk filesystem does not provide +for truly empty lines; empty lines in CMS (on minidisks) have at least +a space character. (Pipelines and SFS, however, do allow null records) + +Pine is not happy with UNIX mbox output from MAILCONVERT. +If someone can figure out exactly what Pine is displeased about, +please send mail to troth@compassnet.com. +``` diff --git a/vmworkshop-vmarcs/1996/mailconv/a2e.rexx b/vmworkshop-vmarcs/1996/mailconv/a2e.rexx new file mode 100644 index 0000000..33a6fd8 --- /dev/null +++ b/vmworkshop-vmarcs/1996/mailconv/a2e.rexx @@ -0,0 +1,71 @@ +/* ----------------------------------------------------------------- ÆCS + * ASCII to EBCDIC and vice-versa code conversion tables. + * Tables included here are based on ASCII conforming to the ISO8859-1 + * Latin 1 character set and EBCDIC conforming to the IBM Code Page 37 + * Latin 1 character set (except for three pairs of characters in 037). + * + * Name: A2E REXX + * CMS Pipelines filter to translate ASCII to EBCDIC + * Author: Rick Troth, Houston, Texas, USA + * Date: 1992-Feb-27 for the filter, earlier for the table + * + * 1993-Aug-28: Thanks to Melinda Varian for helping me to + * correct some pipelining errors in this gem. + * + * Note: These tables are provided in source form so that you + * may modify them locally. I recommend that you not + * modify them just to make things look right on your + * screen. If you have an older terminal and there are + * not more than a dozen code-points that are wrong, + * then you're better off using CODEPAGE EXEC to set the + * CMS INPUT/OUTPUT translate tables. GOPHER EXEC + * *does respect* CMS' translate tables. + */ + + i = '000102030405060708090A0B0C0D0E0F'x + i = i || '101112131415161718191A1B1C1D1E1F'x + i = i || '202122232425262728292A2B2C2D2E2F'x + i = i || '303132333435363738393A3B3C3D3E3F'x + i = i || '404142434445464748494A4B4C4D4E4F'x + i = i || '505152535455565758595A5B5C5D5E5F'x + i = i || '606162636465666768696A6B6C6D6E6F'x + i = i || '707172737475767778797A7B7C7D7E7F'x + i = i || '808182838485868788898A8B8C8D8E8F'x + i = i || '909192939495969798999A9B9C9D9E9F'x + i = i || 'A0A1A2A3A4A5A6A7A8A9AAABACADAEAF'x + i = i || 'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF'x + i = i || 'C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF'x + i = i || 'D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF'x + i = i || 'E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF'x + i = i || 'F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF'x + + e = '00010203372D2E2F1605250B0C0D0E0F'x + e = e || '101112133C3D322618193F271C1D1E1F'x + e = e || '405A7F7B5B6C507D4D5D5C4E6B604B61'x + e = e || 'F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F'x + e = e || '7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6'x + e = e || 'D7D8D9E2E3E4E5E6E7E8E9ADE0BD5F6D'x + e = e || '79818283848586878889919293949596'x + e = e || '979899A2A3A4A5A6A7A8A9C04FD0A107'x + e = e || '202122232415061728292A2B2C090A1B'x + e = e || '30311A333435360838393A3B04143EFF'x + e = e || '41AA4AB19FB26AB5BBB49A8AB0CAAFBC'x + e = e || '908FEAFABEA0B6B39DDA9B8BB7B8B9AB'x + e = e || '6465626663679E687471727378757677'x + e = e || 'AC69EDEEEBEFECBF80FDFEFBFCBAAE59'x + e = e || '4445424643479C485451525358555657'x + e = e || '8C49CDCECBCFCCE170DDDEDBDC8D8EDF'x + +/* ----------------------------------------------------------------- A2E + * Translate ASCII to EBCDIC. + */ +Do Forever + 'PEEKTO LINE' + If rc ^= 0 Then Leave + 'OUTPUT' Translate(line,e,i) + If rc ^= 0 Then Leave + 'READTO' + End /* Do While */ + +Exit rc * (rc ^= 12) + diff --git a/vmworkshop-vmarcs/1996/mailconv/e2a.rexx b/vmworkshop-vmarcs/1996/mailconv/e2a.rexx new file mode 100644 index 0000000..7dd2120 --- /dev/null +++ b/vmworkshop-vmarcs/1996/mailconv/e2a.rexx @@ -0,0 +1,71 @@ +/* ----------------------------------------------------------------- ÆCS + * ASCII to EBCDIC and vice-versa code conversion tables. + * Tables included here are based on ASCII conforming to the ISO8859-1 + * Latin 1 character set and EBCDIC conforming to the IBM Code Page 37 + * Latin 1 character set (except for three pairs of characters in 037). + * + * Name: E2A REXX + * CMS Pipelines filter to translate EBCDIC to ASCII + * Author: Rick Troth, Houston, Texas, USA + * Date: 1992-Feb-27 for the filter, earlier for the table + * + * 1993-Aug-28: Thanks to Melinda Varian for helping me to + * correct some pipelining errors in this gem. + * + * Note: These tables are provided in source form so that you + * may modify them locally. I recommend that you not + * modify them just to make things look right on your + * screen. If you have an older terminal and there are + * not more than a dozen code-points that are wrong, + * then you're better off using CODEPAGE EXEC to set the + * CMS INPUT/OUTPUT translate tables. GOPHER EXEC + * *does respect* CMS' translate tables. + */ + + i = '000102030405060708090A0B0C0D0E0F'x + i = i || '101112131415161718191A1B1C1D1E1F'x + i = i || '202122232425262728292A2B2C2D2E2F'x + i = i || '303132333435363738393A3B3C3D3E3F'x + i = i || '404142434445464748494A4B4C4D4E4F'x + i = i || '505152535455565758595A5B5C5D5E5F'x + i = i || '606162636465666768696A6B6C6D6E6F'x + i = i || '707172737475767778797A7B7C7D7E7F'x + i = i || '808182838485868788898A8B8C8D8E8F'x + i = i || '909192939495969798999A9B9C9D9E9F'x + i = i || 'A0A1A2A3A4A5A6A7A8A9AAABACADAEAF'x + i = i || 'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF'x + i = i || 'C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF'x + i = i || 'D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF'x + i = i || 'E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF'x + i = i || 'F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF'x + + a = '000102039C09867F978D8E0B0C0D0E0F'x + a = a || '101112139D8508871819928F1C1D1E1F'x + a = a || '80818283840A171B88898A8B8C050607'x + a = a || '909116939495960498999A9B14159E1A'x + a = a || '20A0E2E4E0E1E3E5E7F1A22E3C282B7C'x + a = a || '26E9EAEBE8EDEEEFECDF21242A293B5E'x + a = a || '2D2FC2C4C0C1C3C5C7D1A62C255F3E3F'x + a = a || 'F8C9CACBC8CDCECFCC603A2340273D22'x + a = a || 'D8616263646566676869ABBBF0FDFEB1'x + a = a || 'B06A6B6C6D6E6F707172AABAE6B8C6A4'x + a = a || 'B57E737475767778797AA1BFD05BDEAE'x + a = a || 'ACA3A5B7A9A7B6BCBDBEDDA8AF5DB4D7'x + a = a || '7B414243444546474849ADF4F6F2F3F5'x + a = a || '7D4A4B4C4D4E4F505152B9FBFCF9FAFF'x + a = a || '5CF7535455565758595AB2D4D6D2D3D5'x + a = a || '30313233343536373839B3DBDCD9DA9F'x + +/* ----------------------------------------------------------------- E2A + * Translate EBCDIC to ASCII. + */ +Do Forever + 'PEEKTO LINE' + If rc ^= 0 Then Leave + 'OUTPUT' Translate(line,a,i) + If rc ^= 0 Then Leave + 'READTO' + End /* Do While */ + +Exit rc * (rc ^= 12) + diff --git a/vmworkshop-vmarcs/1996/mailconv/mailconv.exec b/vmworkshop-vmarcs/1996/mailconv/mailconv.exec new file mode 100644 index 0000000..ba27e1b --- /dev/null +++ b/vmworkshop-vmarcs/1996/mailconv/mailconv.exec @@ -0,0 +1,55 @@ +/* + * Name: MAILCONVERT EXEC + * tool to convert CMS NOTEBOOKs to/from UNIX "mbox" files + * Author: Rick Troth, Houston, Texas, USA + * Date: 1993-May-21 + */ + +Address "COMMAND" + +Parse Upper Arg fn cvd + +If fn = "" Then Do + 'XMITMSG 54 (ERRMSG CALLER MCV' + Exit 24 + End /* If .. Do */ + +If cvd = "" Then Do + + 'PIPE COMMAND LISTFILE' fn 'NOTEBOOK * (DATE | DROP | VAR NB' + nbrc = rc + 'PIPE COMMAND LISTFILE' fn 'MBOX * (DATE | DROP | VAR MB' + mbrc = rc + + Select + + When nbrc = 28 & mbrc = 28 Then Do + 'XMITMSG 2 FN (ERRMSG CALLER MCV' + Exit 28 + End /* If .. Do */ + + When nbrc = 28 Then cvd = "TO CMS" + When mbrc = 28 Then cvd = "TO UNIX" + + Otherwise Do + Parse Var nb . . . . . . . nbd nbt . + Parse Var nbd nbm '/' nbd '/' nby + Parse Var nbt nbh ':' nbn ':' nbs + nbx = (nby * 384 + nbm * 32 + nbd) * 43200 , + + nbh * 3600 + nbn * 60 + nbs + Parse Var mb . . . . . . . mbd mbt . + Parse Var mbd mbm '/' mbd '/' mby + Parse Var mbt mbh ':' mbn ':' mbs + mbx = (mby * 384 + mbm * 32 + mbd) * 43200 , + + mbh * 3600 + mbn * 60 + mbs + If mbx > nbx Then cvd = "TO CMS" + Else cvd = "TO UNIX" + End /* If .. Do */ + + End /* Select */ + + End /* If .. Do */ + +'PIPE MAILCONVERT' fn cvd +Exit rc + diff --git a/vmworkshop-vmarcs/1996/mailconv/mailconv.filelist b/vmworkshop-vmarcs/1996/mailconv/mailconv.filelist new file mode 100644 index 0000000..322fba0 --- /dev/null +++ b/vmworkshop-vmarcs/1996/mailconv/mailconv.filelist @@ -0,0 +1,16 @@ +* +* Name: MAILCONVERT FILELIST +* list of files in the MAILCONVERT package +* Author: Rick Troth, Houston, Texas, USA +* Date: 1993-May-20 +* + MAILCONVERT FILELIST * "README" 0 + MAILCONVERT README * "README2" +* + MAILCONVERT EXEC * + MAILCONVERT REXX * + MAILCONVERT HELPCMS * +* + A2E REXX * + E2A REXX * +* diff --git a/vmworkshop-vmarcs/1996/mailconv/mailconv.helpcms b/vmworkshop-vmarcs/1996/mailconv/mailconv.helpcms new file mode 100644 index 0000000..d8720ac --- /dev/null +++ b/vmworkshop-vmarcs/1996/mailconv/mailconv.helpcms @@ -0,0 +1,60 @@ +.cm +.cm Name: MAILCONVERT HELPCMS +.cm Author: Rick Troth, Houston, Texas, USA +.cm Date: 1993-May-23 +.cm + + MAILCONVERT EXEC + + NOTE: BE SURE TO TRANSFER UNIX MBOX FILES AS BINARY + + Use the MAILCONVERT EXEC/Pipeline to convert CMS NOTEBOOKS to/from + UNIX 'mbox' files. EBCDIC to/from ASCII translation is performed. + + The format of the MAILCONVERT command is: + +-----------------+--------------------------------------------------+ + | | | + | MAILCONVERT | notebook [TO CMS] | + | MCV | [TO UNIX] | + | | | + +-----------------+--------------------------------------------------+ + + The format of the MAILCONVERT pipeline call is: + +--------------------------------------------------------------------+ + | | + | PIPE ... | MAILCONVERT - TO CMS | ... | + | TO UNIX | + | | + +--------------------------------------------------------------------+ + + where: + + notebook is the name of the CMS NOTEBOOK or UNIX mbox file to convert, + + - tells the MAILCONVERT stage to read from its input and + write to its output without attaching any disk files, + + TO CMS means convert this UNIX mbox file into a CMS NOTEBOOK file, + + TO UNIX means convert this CMS NOTEBOOK file into a UNIX mbox file. + + Notes: + + 1. CMS NOTEBOOKs which are in MAILBOOK format have additional + information in them which makes conversion to UNIX more reliable. + + 2. MAILCONVERT does not create MAILBOOK format notebooks, + nor the NOTEINDX files associated with them. + MAILBOOK can [re]construct the NOTEINDX file and modify the + NOTEBOOK file as needed automatically after you run MAILCONVERT. + + 3. UNIX mbox files must have the header terminated by LF/LF with + NO intervening text, not even whitespace, which is impossible + to represent as a CMS disk resident plain text file. + + Pine does not like the UNIX mbox output from MAILCONVERT. + + 4. MAILBOOK may be obtained from Richard A. Schafer + <schafer@mailbook.houston.tx.us> + + diff --git a/vmworkshop-vmarcs/1996/mailconv/mailconv.rexx b/vmworkshop-vmarcs/1996/mailconv/mailconv.rexx new file mode 100644 index 0000000..51da06d --- /dev/null +++ b/vmworkshop-vmarcs/1996/mailconv/mailconv.rexx @@ -0,0 +1,127 @@ +/* + * Name: MAILCONVERT REXX + * tool to convert CMS NOTEBOOKs to/from UNIX "mbox" files + * Author: Rick Troth, Houston, Texas, USA + * Date: 1993-May-21 + */ + +Parse Upper Arg fn to sy . '(' . ')' . +If fn = "" Then Do + Address "COMMAND" 'XMITMSG 386 (ERRMSG CALLER MCV' + Exit 24 + End /* If .. Do */ +If to ^= "TO" & to ^= "FROM" Then Do + Address "COMMAND" 'XMITMSG 29 TO (ERRMSG CALLER MCV' + Exit 24 + End /* If .. Do */ +If sy ^= "CMS" & sy ^= "UNIX" & sy ^= "VM" Then Do + Address "COMMAND" 'XMITMSG 29 SY (ERRMSG CALLER MCV' + Exit 24 + End /* If .. Do */ + +If to = "TO" & sy = "CMS" Then Signal TO_CMS +If to = "FROM" & sy = "CMS" Then Signal TO_UNIX +If to = "TO" & sy = "UNIX" Then Signal TO_UNIX +If to = "FROM" & sy = "UNIX" Then Signal TO_CMS +If to = "TO" & sy = "VM" Then Signal TO_CMS +If to = "FROM" & sy = "VM" Then Signal TO_UNIX + +Exit 24 + +/* -------------------------------------------------------------- TO_CMS + */ +TO_CMS: + +If fn ^= '-' Then Do + 'ADDPIPE <' fn 'MBOX | *.INPUT:' + If rc ^= 0 Then Exit rc + 'ADDPIPE *.OUTPUT: | >' fn 'NOTEBOOK A' + If rc ^= 0 Then Exit rc + End /* If .. Do */ + +'ADDPIPE *.INPUT: | DEBLOCK LINEND 0A | A2E | PAD 1 | *.INPUT:' +If rc ^= 0 Then Exit rc + +Do Forever + + 'PEEKTO LINE' + If rc ^= 0 Then Leave + +/* Parse Upper Var line from orig day mon dd time year . */ + If Left(line,5) = "From " Then 'OUTPUT' Copies('=',72) + Else Do + Do While Length(line) > 80 + 'OUTPUT' Left(line,80) + line = " " || Substr(line,81) + End /* Do While */ + 'OUTPUT' line + End /* Else Do */ + If rc ^= 0 Then Leave + + 'READTO' + + End /* Do Forever */ + +Exit rc * (rc ^= 12) + +/* ------------------------------------------------------------- TO_UNIX + */ +TO_UNIX: + +If fn ^= '-' Then Do + 'ADDPIPE <' fn 'NOTEBOOK | *.INPUT:' + If rc ^= 0 Then Exit rc + 'ADDPIPE *.OUTPUT: | >' fn 'MBOX A' + If rc ^= 0 Then Exit rc + End /* If .. Do */ + +'ADDPIPE *.OUTPUT: | E2A | FBLOCK 4094 | *.OUTPUT:' +If rc ^= 0 Then Exit rc + +Do Forever + + 'READTO RECORD' + If rc ^= 0 Then Leave + Parse Var record . i . + If Datatype(i,'N') Then i = Trunc(i) + Else i = 0 + + user = Userid() + day = Left(Date('W'),3) + mon = Left(Date('M'),3) +/* dd = Word(Date('N'),1) */ + time = Time() + Parse Value Date('N') With dd . year . + + j = 0 + Do Forever + 'READTO RECORD' + If rc ^= 0 Then Leave + If Strip(Translate(record,,'05'x)) = "" Then Leave + j = j + 1 + head.j = record + Parse Var record tag val + /* ----------------------------------- */ + /* crunch header to modify FROM line */ + /* ----------------------------------- */ + End + head.0 = j + + 'OUTPUT' "From" user day mon dd time year || '25'x + 'CALLPIPE STEM HEAD. | SPEC 1-* 1 x25 NEXT | *:' + 'OUTPUT' '25'x /* and NO spaces! */ + /* because some UNIX MUAs are picky */ + + i = i - j - 1 + If i > 0 Then 'CALLPIPE *: | TAKE' i , + '| SPEC 1-* 1 x25 NEXT | *:' + 'CALLPIPE *: | TOLABEL' Copies('=',72) || , + '| SPEC 1-* 1 x25 NEXT | *:' + + 'PEEKTO' + If rc ^= 0 Then Leave + + End + +Exit rc * (rc ^= 12) + diff --git a/vmworkshop-vmarcs/1996/mime/README.md b/vmworkshop-vmarcs/1996/mime/README.md new file mode 100644 index 0000000..aea5d83 --- /dev/null +++ b/vmworkshop-vmarcs/1996/mime/README.md @@ -0,0 +1,161 @@ +## ORIGINAL README +``` +Note that this accessory to RiceMAIL often uses your plain XEDIT +environment to display mail. Some users will find this distasteful +because they haven't changed XEDIT defaults with a PROFILE XEDIT. + +You'll probably want to fix your PROFILE XEDIT. XEDIT leaves some +synonyms in place when you open other files. Thus PF3 (QUIT) when +editing another file from viewing or composing MIME mail does strange +things. Set PF3 to COMMAND QUIT instead of just plain QUIT in your +PROFILE XEDIT. This symptom also affects PF8 (FORWARD). If you viewa MIME item, +then X fn ft to get another file into the XEDIT ring, and then use +PF8 to scroll down, you'll likely wind up in RiceMAIL's FORWARD screen. + +Please read MIME NOTE about CHARSET issues from John Klensin. +SMTP and MIME (RFC822 and RFC1341 and friends) do not have a concept +of "plain text". On VM (specifically on BITNET and with VM TCP/IP) +we've cheated and treated mail as "plain text". + +From SYSJJH%NMSUVM1.BITNET@pucc.princeton.edu Fri Mar 25 13:33:36 1994 +Date: Thu, 24 Mar 1994 13:04:22 EST +From: Jeff Hoover <SYSJJH%NMSUVM1.BITNET@pucc.princeton.edu> +Reply to: VM GOPHER discussion list <VMGOPHER@pucc.princeton.edu> +To: Multiple recipients of list VMGOPHER <VMGOPHER@pucc.princeton.edu> +Subject: Re: Read MIME files from mail + +On Thu, 24 Mar 1994 14:51:56 EST Jean Bedard said: + +Jean, after several days I finally found out how to make the mailer read +MIME files. You have to get the MIMEREAD code like Rick said. But in +addition, in your mail options you need to set POSTREAD YES. If you don't +do this then the mail code will never enter into the MIME code. + +I think it would have been a lot easier if in the header to some of these +programs if that had been stated. Other than that, it works real good. + +If anyone is having any problems getting the mime/mail programs to work +just drop me a line. I will be more than happy to help you out. + + +Jeff Hoover + + +>> Look on the gopher server at vm.rice.edu +>>under "Other freely distributable CMS software" +>>for "MIME decoder for CMS Gopher and RiceMAIL". +>> +>I did that. MIMEREAD EXEC can't be accessed. There is no documentation +>as how to implement it all (or is it in the MIMEREAD EXEC?) +> +> +>Jean Bedard, C.T.I., Universite Laval, Quebec, Canada +>Resp. VM/CMS, NetNorth, Listserv Bitnet: ADMIN AT LAVALVM1 +>(418) 656-3632 From SYSJJH%NMSUVM1.BITNET@pucc.princeton.edu Fri Mar 25 13:33:36 1994 +Date: Thu, 24 Mar 1994 13:04:22 EST +From: Jeff Hoover <SYSJJH%NMSUVM1.BITNET@pucc.princeton.edu> +Reply to: VM GOPHER discussion list <VMGOPHER@pucc.princeton.edu> +To: Multiple recipients of list VMGOPHER <VMGOPHER@pucc.princeton.edu> +Subject: Re: Read MIME files from mail + +On Thu, 24 Mar 1994 14:51:56 EST Jean Bedard said: + +Jean, after several days I finally found out how to make the mailer read +MIME files. You have to get the MIMEREAD code like Rick said. But in +addition, in your mail options you need to set POSTREAD YES. If you don't +do this then the mail code will never enter into the MIME code. + +I think it would have been a lot easier if in the header to some of these +programs if that had been stated. Other than that, it works real good. + +If anyone is having any problems getting the mime/mail programs to work +just drop me a line. I will be more than happy to help you out. + + +Jeff Hoover + + +>> Look on the gopher server at vm.rice.edu +>>under "Other freely distributable CMS software" +>>for "MIME decoder for CMS Gopher and RiceMAIL". +>> +>I did that. MIMEREAD EXEC can't be accessed. There is no documentation +>as how to implement it all (or is it in the MIMEREAD EXEC?) +> +> +>Jean Bedard, C.T.I., Universite Laval, Quebec, Canada +>Resp. VM/CMS, NetNorth, Listserv Bitnet: ADMIN AT LAVALVM1 +>(418) 656-3632 Internet: admin@vm1.ulaval.ca + +------------------------------------------------------------------------ + +From SYSJJH%NMSUVM1.BITNET@pucc.princeton.edu Fri Mar 25 13:33:36 1994 +Date: Thu, 24 Mar 1994 13:04:22 EST +From: Jeff Hoover <SYSJJH%NMSUVM1.BITNET@pucc.princeton.edu> +Reply to: VM GOPHER discussion list <VMGOPHER@pucc.princeton.edu> +To: Multiple recipients of list VMGOPHER <VMGOPHER@pucc.princeton.edu> +Subject: Re: Read MIME files from mail + +On Thu, 24 Mar 1994 14:51:56 EST Jean Bedard said: + +Jean, after several days I finally found out how to make the mailer read +MIME files. You have to get the MIMEREAD code like Rick said. But in +addition, in your mail options you need to set POSTREAD YES. If you don't +do this then the mail code will never enter into the MIME code. + +I think it would have been a lot easier if in the header to some of these +programs if that had been stated. Other than that, it works real good. + +If anyone is having any problems getting the mime/mail programs to work +just drop me a line. I will be more than happy to help you out. + + +Jeff Hoover + + +>> Look on the gopher server at vm.rice.edu +>>under "Other freely distributable CMS software" +>>for "MIME decoder for CMS Gopher and RiceMAIL". +>> +>I did that. MIMEREAD EXEC can't be accessed. There is no documentation +>as how to implement it all (or is it in the MIMEREAD EXEC?) +> +> +>Jean Bedard, C.T.I., Universite Laval, Quebec, Canada +>Resp. VM/CMS, NetNorth, Listserv Bitnet: ADMIN AT LAVALVM1 +>(418) 656-3632 From SYSJJH%NMSUVM1.BITNET@pucc.princeton.edu Fri Mar 25 13:33:36 1994 +Date: Thu, 24 Mar 1994 13:04:22 EST +From: Jeff Hoover <SYSJJH%NMSUVM1.BITNET@pucc.princeton.edu> +Reply to: VM GOPHER discussion list <VMGOPHER@pucc.princeton.edu> +To: Multiple recipients of list VMGOPHER <VMGOPHER@pucc.princeton.edu> +Subject: Re: Read MIME files from mail + +On Thu, 24 Mar 1994 14:51:56 EST Jean Bedard said: + +Jean, after several days I finally found out how to make the mailer read +MIME files. You have to get the MIMEREAD code like Rick said. But in +addition, in your mail options you need to set POSTREAD YES. If you don't +do this then the mail code will never enter into the MIME code. + +I think it would have been a lot easier if in the header to some of these +programs if that had been stated. Other than that, it works real good. + +If anyone is having any problems getting the mime/mail programs to work +just drop me a line. I will be more than happy to help you out. + + +Jeff Hoover + + +>> Look on the gopher server at vm.rice.edu +>>under "Other freely distributable CMS software" +>>for "MIME decoder for CMS Gopher and RiceMAIL". +>> +>I did that. MIMEREAD EXEC can't be accessed. There is no documentation +>as how to implement it all (or is it in the MIMEREAD EXEC?) +> +> +>Jean Bedard, C.T.I., Universite Laval, Quebec, Canada +>Resp. VM/CMS, NetNorth, Listserv Bitnet: ADMIN AT LAVALVM1 +>(418) 656-3632 Internet: admin@vm1.ulaval.ca +``` diff --git a/vmworkshop-vmarcs/1996/mime/attach.helpmail b/vmworkshop-vmarcs/1996/mime/attach.helpmail new file mode 100644 index 0000000..b787740 --- /dev/null +++ b/vmworkshop-vmarcs/1996/mime/attach.helpmail @@ -0,0 +1,29 @@ +.cm +.cm Name: ATTACH HELPMAIL +.cm Author: Rick Troth, Rice University, Information Systems +.cm Date: 1993-Nov-28 +.cm This file was created by hand. +.cm +.cs 1 on + +¢|ATTACH¢% + + Use the ATTACH command to include other files in your outbound note. + ATTACH uses MIME (Multi-purpose Internet Mail Extensions) to encode + the attached file (if needed) and indicate that this mail now has + now has multiple parts. + +.cs 1 off +.cs 2 on + The format of the ATTACH subcommand is: + +------------+-------------------------------------------------------------+ + | | | + | ATTACH | fn ft [fm] | + | | | + +------------+-------------------------------------------------------------+ + +.cs 2 off +.cs 3 on +.cs 3 off +.cs 4 on +.cs 4 off diff --git a/vmworkshop-vmarcs/1996/mime/debase64.rexx b/vmworkshop-vmarcs/1996/mime/debase64.rexx new file mode 100644 index 0000000..cf0c8bf --- /dev/null +++ b/vmworkshop-vmarcs/1996/mime/debase64.rexx @@ -0,0 +1,36 @@ +/* + * Name: DEBASE64 REXX + * a CMS Pipelines stage to convert Base 64 + * encoding into the original binary stream + * Author: Rick Troth, Rice University, Information Systems + * Date: 1992-Jul-31, 1993-Apr-09 + */ + +/* b64 = ""; Do i = 0 to 63; b64 = b64 || d2c(i); End */ +e64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" +table = "" +Do i = 1 to 64 + table = table c2x(Substr(e64,i,1)) d2x(i-1,2) + End + +xlate = 'XLATE *-*' table , /* translate */ + '| SPEC 1-4 C2B' , /* convert to binary */ + '| SPEC 3.6 1' , /* combine 8 bits from 6 */ + '11.6 7' , + '19.6 13' , + '27.6 19' , + '| SPEC 1.8 B2C 1' , /* convert to character */ + '9.8 B2C 2' , + '17.8 B2C 3' + +'CALLPIPE (END !) *: | SPLIT |' , /* remove blanks */ + 'SPLIT AT * | OUTSIDE /*/ /*/ |' , /* ignore OOB data */ + 'FBLOCK 4 = |' , /* pad, just in case */ + 'E: NLOCATE /=/ |' xlate '|' , /* watch for padding */ + 'F: FANINANY | FBLOCK 4094 | *:' , /* recombine streams */ + '! E: | D: NLOCATE /==/ |' , /* watch for double padding */ + xlate '| SPEC 1.2 1 | F:' , /* take two bytes */ + '! D: |' xlate '| SPEC 1.1 1 | F:' /* take one byte */ + +Exit rc + diff --git a/vmworkshop-vmarcs/1996/mime/decodeqp.rexx b/vmworkshop-vmarcs/1996/mime/decodeqp.rexx new file mode 100644 index 0000000..3bba2f5 --- /dev/null +++ b/vmworkshop-vmarcs/1996/mime/decodeqp.rexx @@ -0,0 +1,46 @@ +/* + * Name: DECODEQP REXX + * Quoted printable decoder stage. + * Author: Rick Troth, Rice University, Information Systems + * Date: 1993-Jul-10, and prior + */ + +/* Quoted printable encoding presumes ASCII. */ +'ADDPIPE *: | E2A | SPEC 1-* 1 x0D0A NEXT' , + '| SPLIT BEFORE' '003D00'x '| *.INPUT:' + +/* ASCII hexadecimal digits */ +xa = '30313233343536373839414243444546'x +/* EBCDIC hexadecimal digits */ +xe = 'F0F1F2F3F4F5F6F7F8F9C1C2C3C4C5C6'x + +Do Forever + + 'PEEKTO RECORD' + If rc ^= 0 Then Leave + + If Left(record,1) = '3D'x Then Select + When Length(record) = 1 Then Do + 'READTO' + 'PEEKTO RECORD' + If rc = 0 Then 'OUTPUT' record + End /* When .. Do */ + When Length(record) = 2 Then /* skip the quote char */ + 'OUTPUT' Substr(record,2) + When Substr(record,2,2) = '0D0A'x Then /* skip the NL */ + 'OUTPUT' Substr(record,4) + When Verify(Substr(record,2,2),xa) = 0 Then Do + 'OUTPUT' x2c(Translate(Substr(record,2,2),xe,xa)) + 'OUTPUT' Substr(record,4) + End /* When .. Do */ + Otherwise + 'OUTPUT' Substr(record,2) + End /* Select */ + Else 'OUTPUT' record + + 'READTO' + + End /* Do Forever */ + +Exit rc * (rc ^= 12) + diff --git a/vmworkshop-vmarcs/1996/mime/enbase64.rexx b/vmworkshop-vmarcs/1996/mime/enbase64.rexx new file mode 100644 index 0000000..c3678e1 --- /dev/null +++ b/vmworkshop-vmarcs/1996/mime/enbase64.rexx @@ -0,0 +1,34 @@ +/* + * Name: ENBASE64 REXX + * a CMS Pipelines stage to convert the binary + * input stream into Base 64 encoding (see MIME) + * Author: Rick Troth, Rice University, I/S VM Systems Support + * Date: 1992-Jul-31 + */ + +'ADDPIPE *: | FBLOCK 3 00' , /* pad with NULLs */ + '| SPEC 1-3 C2B' , /* convert to binary */ + '| SPEC "00" 1 1.6 3' , /* select 6 bits from 8 */ + '"00" 9 7.6 11' , + '"00" 17 13.6 19' , + '"00" 25 19.6 27' , + '| SPEC 1.8 B2C 1' , /* convert to character */ + '9.8 B2C 2' , + '17.8 B2C 3' , + '25.8 B2C 4' , + '| FBLOCK 64' , /* reblock nicely */ + '| *.INPUT:' + +b64 = ""; Do i = 0 to 63; b64 = b64 || d2c(i); End +e64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" + +'PEEKTO LINE' +Do While rc = 0 + /* translate binary 6-bit into plain text B64 set */ + 'OUTPUT' Translate(line,e64,b64) + 'READTO' + 'PEEKTO LINE' + End + +Return + diff --git a/vmworkshop-vmarcs/1996/mime/maketext.rexx b/vmworkshop-vmarcs/1996/mime/maketext.rexx new file mode 100644 index 0000000..6755875 --- /dev/null +++ b/vmworkshop-vmarcs/1996/mime/maketext.rexx @@ -0,0 +1,227 @@ +/* © Copyright 1994, Richard M. Troth, all rights reserved. <plaintext> + * + * Name: MAKETEXT REXX + * VM TCP/IP Network Client and Server text converter + * Inspired by GOPCLITX, DROPDOTS, and other gems. + * Renamed from WEBTEXT because it's ubiquitous. + * Author: Rick Troth, Houston, Texas, USA + * Date: 1994-Feb-27, 1994-Oct-15 + * + * Replaces: A2E, E2A, TCPA2E, TCPE2A + */ + +/* ----------------------------------------------------------------- ÆCS + * ASCII to EBCDIC and vice-versa code conversion tables. + * Tables included here are based on ASCII conforming to the ISO8859-1 + * Latin 1 character set and EBCDIC conforming to the IBM Code Page 37 + * Latin 1 character set (except for three pairs of characters in 037). + */ + +Parse Upper Arg mode code . +If mode = "" Then mode = "LOCAL" + + i = '000102030405060708090A0B0C0D0E0F'x + i = i || '101112131415161718191A1B1C1D1E1F'x + i = i || '202122232425262728292A2B2C2D2E2F'x + i = i || '303132333435363738393A3B3C3D3E3F'x + i = i || '404142434445464748494A4B4C4D4E4F'x + i = i || '505152535455565758595A5B5C5D5E5F'x + i = i || '606162636465666768696A6B6C6D6E6F'x + i = i || '707172737475767778797A7B7C7D7E7F'x + i = i || '808182838485868788898A8B8C8D8E8F'x + i = i || '909192939495969798999A9B9C9D9E9F'x + i = i || 'A0A1A2A3A4A5A6A7A8A9AAABACADAEAF'x + i = i || 'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF'x + i = i || 'C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF'x + i = i || 'D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF'x + i = i || 'E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF'x + i = i || 'F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF'x + +If code ^= "" Then Do + 'CALLPIPE DISK' code 'TCPXLBIN | STEM XLT.' + If rc ^= 0 | xlt.0 < 3 Then code = "" + End /* If .. Do */ + +Select /* mode */ + When Abbrev("LOCAL",mode,3) Then Call LOCAL + When Abbrev("LCL",mode,3) Then Call LOCAL + When Abbrev("EBCDIC",mode,1) Then Call LOCAL + When Abbrev("NETWORK",mode,3) Then Call NETWORK + When Abbrev("ASCII",mode,1) Then Call NETWORK + When Abbrev("DOTTED",mode,3) Then Call DOTTED + When Abbrev("UNIX",mode,1) Then Call UNIX + Otherwise Do + Address "COMMAND" 'XMITMSG 3 MODE (ERRMSG' + rc = 24 + End /* Otherwise Do */ + End /* Select mode */ + +Exit rc * (rc ^= 12) + + +/* --------------------------------------------------------------- LOCAL + * Input: raw ASCII text + * Output: plain (EBCDIC) text + */ +LOCAL: + +'ADDPIPE *.OUTPUT: | STRIP TRAILING 0D | PAD 1 | *.OUTPUT:' +If rc ^= 0 Then Return + +If code = "" Then Do /* use the standard table */ + e = '00010203372D2E2F1605250B0C0D0E0F'x + e = e || '101112133C3D322618193F271C1D1E1F'x + e = e || '405A7F7B5B6C507D4D5D5C4E6B604B61'x + e = e || 'F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F'x + e = e || '7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6'x + e = e || 'D7D8D9E2E3E4E5E6E7E8E9ADE0BD5F6D'x + e = e || '79818283848586878889919293949596'x + e = e || '979899A2A3A4A5A6A7A8A9C04FD0A107'x + e = e || '202122232415061728292A2B2C090A1B'x + e = e || '30311A333435360838393A3B04143EFF'x + e = e || '41AA4AB19FB26AB5BBB49A8AB0CAAFBC'x + e = e || '908FEAFABEA0B6B39DDA9B8BB7B8B9AB'x + e = e || '6465626663679E687471727378757677'x + e = e || 'AC69EDEEEBEFECBF80FDFEFBFCBAAE59'x + e = e || '4445424643479C485451525358555657'x + e = e || '8C49CDCECBCFCCE170DDDEDBDC8D8EDF'x + End /* If .. Do */ +Else e = xlt.2 + +buff = "" +Do Forever + + 'PEEKTO DATA' + If rc ^= 0 Then Leave + + buff = buff || data + Do While Index(buff,'0A'x) > 0 + Parse Var buff line '0A'x buff + 'OUTPUT' Translate(line,e,i) + If rc ^= 0 Then Leave + End /* Do While */ + If rc ^= 0 Then Leave + + 'READTO' + If rc ^= 0 Then Leave + + End /* Do Forever */ + +If buff ^= "" Then 'OUTPUT' Translate(buff,e,i) + +Return + + +/* ------------------------------------------------------------- NETWORK + * Input: plain (EBCDIC) text + * Output: raw ASCII byte stream + */ +NETWORK: + +'ADDPIPE *.OUTPUT: | SPEC 1-* 1 x0D0A NEXT | *.OUTPUT:' +If rc ^= 0 Then Return + +If code = "" Then Do /* use the standard table */ + a = '000102039C09867F978D8E0B0C0D0E0F'x + a = a || '101112139D8508871819928F1C1D1E1F'x + a = a || '80818283840A171B88898A8B8C050607'x + a = a || '909116939495960498999A9B14159E1A'x + a = a || '20A0E2E4E0E1E3E5E7F1A22E3C282B7C'x + a = a || '26E9EAEBE8EDEEEFECDF21242A293B5E'x + a = a || '2D2FC2C4C0C1C3C5C7D1A62C255F3E3F'x + a = a || 'F8C9CACBC8CDCECFCC603A2340273D22'x + a = a || 'D8616263646566676869ABBBF0FDFEB1'x + a = a || 'B06A6B6C6D6E6F707172AABAE6B8C6A4'x + a = a || 'B57E737475767778797AA1BFD05BDEAE'x + a = a || 'ACA3A5B7A9A7B6BCBDBEDDA8AF5DB4D7'x + a = a || '7B414243444546474849ADF4F6F2F3F5'x + a = a || '7D4A4B4C4D4E4F505152B9FBFCF9FAFF'x + a = a || '5CF7535455565758595AB2D4D6D2D3D5'x + a = a || '30313233343536373839B3DBDCD9DA9F'x + End /* If .. Do */ +Else a = xlt.3 + +Do Forever + + 'PEEKTO LINE' + If rc ^= 0 Then Leave + + 'OUTPUT' Translate(line,a,i) + If rc ^= 0 Then Leave + + 'READTO' + If rc ^= 0 Then Leave + + End /* Do Forever */ + +Return + + +/* -------------------------------------------------------------- DOTTED + * Input: plain (EBCDIC) text + * Output: ASCII byte stream terminated by CR/LF/./CR/LF + */ +DOTTED: + +Call NETWORK + +'OUTPUT' Translate('.',a,i) + +Return + + +/* + * variables: + * xlt.0 should be "3", meaning three records read + * xlt.1 should be a comment + * xlt.2 should be our ASCII ---> EBCDIC table + * xlt.3 should be our EBCDIC ---> ASCII table + * i is set to the dummy input table + */ + + +/* ---------------------------------------------------------------- UNIX + * Input: plain (EBCDIC) text + * Output: ASCII byte stream with UNIX line convention (NL) + */ +UNIX: + +'ADDPIPE *.OUTPUT: | SPEC 1-* 1 x0A NEXT | *.OUTPUT:' +If rc ^= 0 Then Return + +If code = "" Then Do /* use the standard table */ + a = '000102039C09867F978D8E0B0C0D0E0F'x + a = a || '101112139D8508871819928F1C1D1E1F'x + a = a || '80818283840A171B88898A8B8C050607'x + a = a || '909116939495960498999A9B14159E1A'x + a = a || '20A0E2E4E0E1E3E5E7F1A22E3C282B7C'x + a = a || '26E9EAEBE8EDEEEFECDF21242A293B5E'x + a = a || '2D2FC2C4C0C1C3C5C7D1A62C255F3E3F'x + a = a || 'F8C9CACBC8CDCECFCC603A2340273D22'x + a = a || 'D8616263646566676869ABBBF0FDFEB1'x + a = a || 'B06A6B6C6D6E6F707172AABAE6B8C6A4'x + a = a || 'B57E737475767778797AA1BFD05BDEAE'x + a = a || 'ACA3A5B7A9A7B6BCBDBEDDA8AF5DB4D7'x + a = a || '7B414243444546474849ADF4F6F2F3F5'x + a = a || '7D4A4B4C4D4E4F505152B9FBFCF9FAFF'x + a = a || '5CF7535455565758595AB2D4D6D2D3D5'x + a = a || '30313233343536373839B3DBDCD9DA9F'x + End /* If .. Do */ +Else a = xlt.3 + +Do Forever + + 'PEEKTO LINE' + If rc ^= 0 Then Leave + If line = " " Then line = "" + + 'OUTPUT' Translate(line,a,i) + If rc ^= 0 Then Leave + + 'READTO' + If rc ^= 0 Then Leave + + End /* Do Forever */ + +Return + diff --git a/vmworkshop-vmarcs/1996/mime/mime.filelist b/vmworkshop-vmarcs/1996/mime/mime.filelist new file mode 100644 index 0000000..6a2fa82 --- /dev/null +++ b/vmworkshop-vmarcs/1996/mime/mime.filelist @@ -0,0 +1,38 @@ +* +* Name: MIME FILELIST +* a list of files for doing MIME with MAILBOOK or Gopher +* Author: Rick Troth, Rice University, Information Systems +* Date: 1993-May-20 +* +* These files comprise a MIME decoder that can be +* that can be "hooked in" to MAILBOOK and is +* automatically used (if available) by CMS Gopher. +* + MIME FILELIST * "README" 0 +* + MIME README * + MIME NOTE * + MIME XEDIT * + MIMEPROF XEDIT * + MIMEMAIN XEDIT * + MIMEREAD XEDIT * + MIMEREAD REXX * + MIMEREAD EXEC * + MIMEPART REXX * + MIMESEND XEDIT * +* + DEBASE64 REXX * + DECODEQP REXX * + RICHTEXT REXX * + UNTAB REXX * + PRINT XEDIT * + PRINT REXX * + UFTXREAD REXX * + WEBTEXT REXX * + MAKETEXT REXX * +* + ATTACH HELPMAIL * + ENBASE64 REXX * +* + WEBUME TEXT * +* diff --git a/vmworkshop-vmarcs/1996/mime/mime.note b/vmworkshop-vmarcs/1996/mime/mime.note new file mode 100644 index 0000000..0ccb4c7 --- /dev/null +++ b/vmworkshop-vmarcs/1996/mime/mime.note @@ -0,0 +1,233 @@ +Return-Path: <@RICEVM1.RICE.EDU:KLENSIN@INFOODS.MIT.EDU> +Received: from RICEVM1 (NJE origin SMTP@RICEVM1) by RICEVM1.RICE.EDU (LMail + V1.1d/1.7f) with BSMTP id 2482; Wed, 19 May 1993 11:04:49 -0500 +Received: from INFOODS.MIT.EDU by ricevm1.rice.edu (IBM VM SMTP V2R2) with TCP; + Wed, 19 May 93 11:04:45 CDT +Received: from INFOODS.UNU.EDU by INFOODS.UNU.EDU (PMDF V4.2-11 #042B2) id + <01GYCM53EGKG0009OB@INFOODS.UNU.EDU>; Wed, 19 May 1993 12:04:12 EDT +Date: Wed, 19 May 1993 12:04:11 -0400 (EDT) +From: John C Klensin <KLENSIN@INFOODS.UNU.EDU> +Subject: RE: CHARSET considerations +In-reply-to: <01GYBXHRZVEA8Y5JAE@INNOSOFT.COM> +To: TROTH@RICEVM1.RICE.EDU +Cc: ietf-charsets@INNOSOFT.COM, ietf-822@DIMACS.RUTGERS.EDU +Message-id: <737827451.851103.KLENSIN@INFOODS.UNU.EDU> +X-Envelope-to: TROTH@RICEVM1.RICE.EDU +Content-type: TEXT/PLAIN; CHARSET=US-ASCII +Content-transfer-encoding: 7BIT +Mail-System-Version: <MultiNet-MM(330)+TOPSLIB(156)+PMDF(4.2)@INFOODS.UNU.EDU> + +Rick, et al., + +I've been pretty quiet on this one. Frankly, I've been hoping that it +would burn itself out. But it doesn't seem to be doing that. So let's +go back and review a couple of things. I'm posting this to the 822 +list, since most of the issues are really MIME ones, not character set +ones, and to the charset list because that is where you posted your +note. Everyone else has been removed. People who are already throughly +sick of this discussion should stop reading here. + +(1) MIME, like every single other Internet protocol at or near the +applications layer, describes "on the wire" behavior. Neither it, nor +any of the others, describes what should be one on a particular machine +once things arrive there beyond hints about what other systems might +expect vis-a-vis things that are going back out on the wire. The way +you _represent_ a MIME message on your host and in your UA <->user and +UA <-> MTA communications is not the subject of Internet protocols, even +though ease of use with those protocols may influence whether some +decisions are as smart, or smarter, than others. + In particular, once something gets to your machine, you can dissect +the headers and store them separately in some unique-to-you canonical +form and report whatever you please to your users. You can also store +the characters in 17-bit reverse-slobbovian notation for all anyone +cares. The only requirement--of MIME or anything else--is that you be +able to reconstruct network-canonical form (e.g., MIME) if you send the +stuff back out. + +(2) MIME defines text/plain in the absense of an explicit charset +indicator to be identical to "text/plain; charset=ascii". This didn't +happen by accident: it was discussed at tedious and exhaustive length. +It turned out to be the only option: any other model would have caused a +violation of RFC822 with potential information-loss. There was fairly +general agreement in the WG that breaking RFC822-conforming +implementations was a terrible idea. + To claim that it is better to write text/plain without a charset +parameter than with one is justified under only two circumstances that I +can think of: + -- you intend to violate the protocols and hope that, if the charset +parameter isn't listed, no one will notice. + -- you have gotten confused, not about a "charset" versus +"character_set" issue, but about the difference between an on-the-wire +mail format protocol specification and a user-level notion of reality on +a particular terminal at a particular time. + +If looking at "charset=us-ascii" is offensive to you, take it out at +display time in your UA, just as many of us hide Received lines unless/ +until we need them for something. Whether you just hide that string, or +replace it with "charset=Plutoian-666" is really not an issue for the +network. + +(3) For similar reasons, ISO-8859-1 can't be unqualified text/plain on +the wire; it would violate RFC822 and unextended RFC821. And, just +incidentally, it would trade an "English exclusive" mail environment for +a "Western European Latin-based language" primary mail environment. +That wasn't considered to be enough gain to be worth the trouble. Maybe +that was a wrong decision, but I don't think so. Note that trading +"ISO-8859-1" (an assertion about coding of characters on the wire) for +"Latin-1" (an abstraction about a particular character repertoire) +doesn't help with this problem--one is as Western European as the +other-- it just costs you knowledge of the coding on the wire. + +(4) There is another major piece of confusion associated with the +assumption that BITNET MAIL is RFC822-conforming. It isn't now. It +never has been. RFC822-Mail over NJE is an oxymoron. RFC822 messages +are in ASCII. It is useful sometimes to pretend that there is a virtual +document, let's call it B-822, that defines the format of BITNET mail. +It contains two lines. One says "On BITNET, we use EBCDIC where RFC822 +uses ASCII" and the second one says "except for the changes implied by +line 1, RFC822 is incorporated here by reference". Now BITNET seems to +be (gradually and without complete agreement) issuing B-822bis, which +changes "EBCDIC" in that first line to "EBCDIC CodePage 1047". B-822bis +still isn't RFC822. + +And, since the MIME of RFC1341bis/RFC1342bis requires RFC822, BITNET +isn't using it unless all of the headers (822 and body-part) are in +ASCII. That is a firm requirement, no amount of fussing with "charset" +changes it. + +So, there is a very interesting question about what the gateways should +do and what near-MIME should look like in a near-RFC822 environment. +But it isn't really a MIME question, much less a charset question. See +item 6, below. + +(5) Now, there is something that could have been done back when the WG +was making its decisions that would have made the work of the gateways +between RFC822-based mail and B-822-based mail much easier, although it +would have required changes in those gateways. We could have decided +that this was a transport problem, that we should extend SMTP to +announce, in some fashion, "here comes the MIME" or "here comes the +charset XXX". If the receiving SMTP in this situation didn't accept +that assertion, the mail would bounce. But it would be immediately +clear which gateways were able to cope in a useful way, and which ones +couldn't. And it would make it relatively easy to establish a +B-1341bis/B-1342bis that used different "charset" conventions if that +was appropriate. The cost would have been that all of the MTAs would +have had to be changed to implement MIME. + +Those who have been putting up with this long enough will recall that I +argued fairly strongly for transport involvement in this process. The +problems, and semantic unpleasantnesses, that Rick is concerned about +now were most of my motivation then. Given the engineering tradeoffs +between making things easier for some gateways and a little safe overall +versus speed of deployment, I was probably wrong. I was certainly +soundly outvoted. + +(6) Ok, now what should be done with "MIME" over B-822? There are a +couple of realistic possibilities. There are also a bunch of +unrealistic ones that depend, to a greater or lesser degree, on getting +agreement from every gateway and every host that sits on an +Internet/EBCDIC boundary to either bounce MIME messages or handle them +in the same specific way. I don't think those are worth discussing now, +although maybe it is too bad that we didn't try to deploy MIME when the +number of gateways and hosts in this situation was closer to three than +a few hundred. + + (i) You can let the gateways keep blindly converting everything that +they get from the Internet into EBCDIC, as they are doing now. If you +do this, you need to extend the first sentence of B-822 to say that +anytime "us-ascii" is seen in a message, it means "ebcdic". In this +scenario, you don't teach the gateways to accept 8bit traffic. If that +means you end up with a lot of quoted-printable stuff and base64 stuff, +that is just the way it goes. Fix it in the receiving UAs if they +recognize the MIME value of the "charset" parameter. If not, life is no +worse for them than for real MIME UAs. + + (ii) You can do the above, but let the gateways access 8bit traffic. +This means that they have to be a little more activist about potential +conversions. They might want to convert ISO-8859-1 to an appropriate +Latin-1-oriented EBCDIC. I strongly recommend that they identify that +they have done this with a new header that they filter on the way in and +out. That header has to do with which EBCDIC is being used, presumably +with CodePage 1047 as the default. If you don't do that, you are going +to be in deep trouble when Latin-2 (much less ideographic character sets +and non-Latin-based ones) arrives. Remember that there are EARN sites +in Poland and Hungary and Russia and Turkey. It won't take long and +then BITNET will have an EBCDIC-labelling problem even if there were no +MIME. + + (iii) You can teach the smarter gateways to put a new verb into the +BMSTP for sites that want it that identifies unconverted MIME and then +pass the message exactly as received by the gateway (e.g., no character +conversion). This would move the conversion problem away from the +gateways and to the delivery MTAs and UAs, which may be able to do +smarter things for their users. This would work well for smart gateways +talking to smart sites. It might be rational to assume that the others +fall under (i) above, i.e., they are on their own and they are going to +see some things encoded that don't strictly need to be. As the saying +goes, life is hard sometimes. + +(7) There are a couple of other things in your note that are invitations +to interoperability problems. For example... +>Specifically, I feel +>(quite strongly) that the user should be able to specify any old +>charset and have display at least attempted at the other end. + I feel (quite strongly) that this falls between "looking for +trouble" and a potential real disaster. Suppose you receive +"text/plain; charset=Mickey-Mouse". What is the recipient going to try +to display? We made the mistake with RFC822 of permitting people to put +anything in, subject only to the rule that we might later come along and +assign some semantics to it. That means that message structures that +had a specific meaning a half-dozen years ago now may have a different +meaning, with no real clues to anyone. Bad mistake. If a user wants to +use "any old charset", use an "X-" as a warning that there had better be +a private agreement between sender and receiver. If the "X-" is +offensive, let it be defined and registered so that there is some hope +that "attempting display" will get it right. + +Similarly, + +>If you specify "Latin-1", then you can (must; I'm arguing for a +>definition here, not an explanation) assume that SMTP will carry it +>as ISO-8859-1, BUT THE RECEIVING (or sending) HOST MIGHT NOT. +>(and yes, sad but true, any SMTPs will strip the high bit) + If you specify "Latin-1", then you cannot make any assumptions at all +about how SMTP will carry it. "Latin-1" is an ambiguous reference, one +of whose instantiations of ISO 8859-1. If you specify "iso-8859-1", +together with a content-transfer-encoding, you know exactly what is +being carried on the wire. In neither case is any assertion made about +what the receiving host might do with it. That is a MTA-delivery-UA +problem, not a MIME/822/821/etc one. + +And +>That's why I ask that +>(today, 1993) we NOT LABEL true plain text as US-ASCII/ISO-8859-1. +>Just leave it alone and let it default at the receiving end. + Get into your time machine. Go back to 1981 or 82. Make this case +then. In "today, 1981" we labelled true plain text as ANS X3.4 ASCII. +We put the label in the protocol document, not in the mail messages, but +the specification is clear, was clear, and will still be clear when your +time machine gets back to 1993. + +>(nor the MIME developers; not mad at anyone, just trying to push a +>point that I think is important and has been missed). + + For whatever my assurances are worth, it hasn't been missed. The +questions and options were examined very carefully; nothing above is +really new. What is missing, I fear, is an understanding of what has +been going on with email for the last decade. + + There is a dirty little secret that many of us have known, or feared, +for many years and that, for better or worse, MIME and the SMTP +extensions have brought to the foreground. The mail environment has +worked for the last decade not because of a high level of conformance or +understanding of subtle aspects of the protocols but because of a very +high level of robustness and tolerance for nonsense. Protocol changes +and extensions almost inevitably raise the conformance threshold and the +understanding threshold along with it. And we are shaking out a lot of +beliefs that are handy but not quite true, e.g., the one that assumes +that BITNET uses RFC822 on NJE-wires. It has never been true, but +believing it up until recently hasn't been harmful. Well, it is getting +harmful and that is one of the prices we pay for MIME. + + john + diff --git a/vmworkshop-vmarcs/1996/mime/mime.xedit b/vmworkshop-vmarcs/1996/mime/mime.xedit new file mode 100644 index 0000000..b34eb18 --- /dev/null +++ b/vmworkshop-vmarcs/1996/mime/mime.xedit @@ -0,0 +1,47 @@ +/* + * Name: MIME XEDIT + * a hack to put some MIME capability into RiceMAIL + * Author: Rick Troth, Rice University, Information Systems + * Date: 1992-Aug-04, 1993-Mar-12 + * + * Calls: MIMEREAD REXX (pipeline stage) + * Called by: MAILUSER XEDIT (from RiceMAIL) + * + * Note: you must enable the POSTREAD exit in Mail 92, + * trap it in your MAILUSER XEDIT, and then call + * this macro with the parameter "READ". + */ + +Parse Source . . . . . arg0 . +argo = arg0 || ':' +Parse Upper Arg mode + +Select /* mode */ + + When mode = "INITIAL" Then nop + + When mode = "MENU" Then nop + + When mode = "READ" Then Do + + 'COMMAND EXTRACT/LINE' + 'MACRO ALL' + 'COMMAND TOP' + 'COMMAND CMS PIPE XEDIT | MIMEREAD' + 'COMMAND :' || line.1 + + End /* When .. Do */ + + When mode = "SEND" Then Do + + /* I have tried. I have failed. */ + /* Maybe someone else can do it. */ + + End /* When .. Do */ + + Otherwise Say argo "What mode is" mode || "?" + + End /* Select mode */ + +Exit + diff --git a/vmworkshop-vmarcs/1996/mime/mimemain.xedit b/vmworkshop-vmarcs/1996/mime/mimemain.xedit new file mode 100644 index 0000000..bcebb02 --- /dev/null +++ b/vmworkshop-vmarcs/1996/mime/mimemain.xedit @@ -0,0 +1,222 @@ +/* + * Name: MIMEMAIN XEDIT + * main macro for doing MIME with MAILBOOK + * + * Warning: code developers, this macro is shared by both MIMEREAD + * and MIMESEND. In the case of the former, we presume + * we are in a sub-instance of XEDIT and might QUIT. + */ + +Parse Upper Source . . . . . arg0 . +Parse Arg args +'COMMAND CMS GLOBALV SELECT MIME GET MAILBOOK' +mailbook = (mailbook = 1) /* just in case */ + +Trace "OFF" + +Select /* arg0 */ + + When ^mailbook Then 'COMMAND' arg0 args + + When Abbrev("PRINT",arg0,2) Then Do + 'COMMAND CMS GLOBALV SELECT MAIL GET SUBJECT' + 'MACRO PRINT (TITLE Subject:' subject + End /* When .. Do */ + + When Abbrev("ATTACH",arg0,3) Then Signal ATTACH + When Abbrev("SIGN",arg0,3) Then Signal SIGN + + Otherwise Do /* pass the command to Schafer's code */ + Push arg0 args + Push "QQUIT" /* and quit from this XEDIT instance */ + End /* When .. Do */ + + End /* Select arg0 */ + +Exit + + +/* -------------------------------------------------------------- ATTACH + * Mark this mail as multi-part and include the requested file. + */ +ATTACH: + +Parse Var args fn ft fm . +If Index(fn,'.') > 0 Then Parse Var fn fn '.' ft '.' fm '.' . +If ft = "" Then Do + 'COMMAND CMS PIPE COMMAND XMITMSG 54 (ERRMSG | VAR EMSG' + 'COMMAND EMSG' emsg + Exit 24 + End /* If .. Do */ +If fm = "" Then fm = "*" +'COMMAND CMS PIPE CMS LISTFILE' fn ft fm '(DATE NOHEADER' , + '| TAKE FIRST 1 | VAR RS' +If rc ^= 0 Then Do + lsrc = rc + 'COMMAND EMSG' rs + Exit lsrc + End /* If .. Do */ +Parse Var rs . . fm recfm lrecl recs blks date time . + +'COMMAND EXTRACT/LINE/CURSOR' /* retain current position */ +'COMMAND CMS GLOBALV SELECT MIME GET BOUNDARY' + +If boundary = "" Then Do + boundary = Date('S') || '.' || Time('L') /* something unique */ + 'COMMAND CMS GLOBALV SELECT MIME PUT BOUNDARY' + 'COMMAND TOP' /* move to top of file */ + 'COMMAND /Content-Type:' /* change MIME content-type tag */ + 'COMMAND REPLACE Content-Type: multipart/mixed;' + 'COMMAND INPUT boundary=' || boundary + 'COMMAND /================' +'COMMAND -1' +'COMMAND INPUT' " " + 'COMMAND INPUT' "This note is in MIME format. If you can see this line," + 'COMMAND INPUT' "then you're either NOT using a MIME capable mail reader," + 'COMMAND INPUT' "or this note was mangled by a bad gateway or list server." + 'COMMAND INPUT --' || boundary + 'COMMAND INPUT Content-Type: text/plain' +/* 'COMMAND INPUT ' */ + /* The following input step is done out of sequence * + * because we can't get MAILBOOK SEND to cooperate. */ + 'COMMAND BOTTOM' + 'COMMAND INPUT --' || boundary + If line.1 > -1 Then , + line.1 = line.1 + 4 /* adjust current line */ + If cursor.3 > -1 Then , + cursor.3 = cursor.3 + 4 /* adjust cursor location */ + End /* If .. Do */ + +'COMMAND CMS PIPE <' fn ft fm '| TAKE | VAR MAGIC' +Select /* magic */ + When Left(magic,4) = '47494638'x Then Do /* GIF8x */ + type = "Image/GIF" + code = "BASE64" + End /* When .. Do */ + Otherwise Do + type = "text/plain" + code = "" + End /* Otherwise Do */ + End /* Select magic */ + +'COMMAND BOTTOM' +'COMMAND INPUT Subject: FILE' fn || '.' || ft +'COMMAND INPUT Content-Type:' type +If code ^= "" Then , +'COMMAND INPUT Content-Transfer-Encoding:' code +'COMMAND INPUT X-RECFM:' recfm +'COMMAND INPUT X-LRECL:' lrecl +'COMMAND INPUT ' +'COMMAND INPUT ' /* extra blank line will get clobbered */ + +Select /* code */ + When code = "BASE64" Then , + 'COMMAND CMS PIPE <' fn ft fm '| ENBASE64 | XEDIT' + Otherwise , + 'COMMAND CMS PIPE <' fn ft fm '| XEDIT' + End /* Select magic */ + +/* The following input step is done out of sequence * + * because we can't get MAILBOOK SEND to cooperate. */ +'COMMAND BOTTOM' +'COMMAND INPUT --' || boundary + +If line.1 > -1 Then , + 'COMMAND :' || line.1 /* restore current line */ +If cursor.3 > -1 Then , + 'COMMAND CURSOR FILE' cursor.3 /* restore cursor location */ + +/* + * This whole ATTACH thing is incomplete! + * We need to be sure to append a trailing boundary line + * (which has a different form than other boundary lines) + * after the last "attachment" and insert the signature + * before the first "attachment". Lotta work. :-( + */ + +Exit + + +/* ---------------------------------------------------------------- SIGN + * Supply a text/signature (contact info) part. + * Implement Greg Vaud's MIME signature trick. + */ +SIGN: + +'COMMAND EXTRACT/LINE/CURSOR' /* retain current position */ +'COMMAND CMS GLOBALV SELECT MIME GET BOUNDARY' +If boundary = "" Then Call MAKEMULT /* make it multipart */ + +'COMMAND CMS LPIPE COMMAND IDENTIFY | XLATE LOWER | VAR IDENTITY' +If rc ^= 0 Then Exit rc +Parse Var identity userid . nodeid . + +'COMMAND CMS PIPE COMMAND NAMEFIND :NICK * :NAME :USERID :NODE' , + ':PHONE :FAXPHONE :ADDR :PORTRAIT' , + '| VAR NAME | DROP | VAR USER | DROP | VAR NODE | DROP' , + '| VAR PHONE | DROP | VAR FAXPHONE | DROP | VAR ADDR' , + '| DROP | VAR PORTRAIT' +If rc ^= 0 & rc ^= 88 Then Exit rc +If user = "" Then user = userid +If node = "" Then node = nodeid + +Exit + +'COMMAND BOTTOM' +'COMMAND INPUT Subject: FILE' fn || '.' || ft +'COMMAND INPUT' "Content-Type: Application/Signature" +'COMMAND INPUT ' +'COMMAND INPUT' "Name:" name +'COMMAND INPUT' "Email:" user || '@' || node +'COMMAND INPUT' "Telephone:" phone +'COMMAND INPUT' "Fax:" faxphone +'COMMAND INPUT' "Address:" addr +'COMMAND INPUT' "Portrait:" portrait + +/* The following input step is done out of sequence * + * because we can't get MAILBOOK SEND to cooperate. */ +'COMMAND BOTTOM' +'COMMAND INPUT --' || boundary + +If line.1 > -1 Then , + 'COMMAND :' || line.1 /* restore current line */ +If cursor.3 > -1 Then , + 'COMMAND CURSOR FILE' cursor.3 /* restore cursor location */ + +Exit + +/* +Greg's mug: +R0lGODdhEAAQAIAAAAAAAP///ywAAAAAEAAQAAACK4wNqceR7UCT8FB +n2aUc47550nZ5iFZWVqpG2bS+WhbK3frYrYmwOaRYMAoAOw== + */ +'OUTPUT' "Capabilities: Text/Plain, Image/GIF, Image/Postscript, Audio/Basic" +'OUTPUT' "PEM-Cert:" + + +/* ------------------------------------------------------------ MAKEMULT + * Convert this into a multipart message. + */ +MAKEMULT: + +boundary = Time('L') /* some unique arbitrary string */ +'COMMAND CMS GLOBALV SELECT MIME PUT BOUNDARY' +'COMMAND TOP' /* move to top of file */ +'COMMAND /Content-Type:' /* change MIME content-type tag */ +'COMMAND REPLACE Content-Type: multipart/mixed;' +'COMMAND INPUT boundary=' || boundary +'COMMAND /================' +'COMMAND INPUT --' || boundary +'COMMAND INPUT Content-Type: text/plain' +'COMMAND INPUT ' +/* The following input step is done out of sequence * + * because we can't get MAILBOOK SEND to cooperate. */ +'COMMAND BOTTOM' +'COMMAND INPUT --' || boundary +If line.1 > -1 Then , + line.1 = line.1 + 4 /* adjust current line */ +If cursor.3 > -1 Then , + cursor.3 = cursor.3 + 4 /* adjust cursor location */ + +Return + diff --git a/vmworkshop-vmarcs/1996/mime/mimepart.rexx b/vmworkshop-vmarcs/1996/mime/mimepart.rexx new file mode 100644 index 0000000..84058fe --- /dev/null +++ b/vmworkshop-vmarcs/1996/mime/mimepart.rexx @@ -0,0 +1,90 @@ +/* Copyright 1994, Richard M. Troth, all rights reserved. <plaintext> + * + * Name: MIMEPART REXX + * process one part of a multipart MIME message + * (merge parent header; eliminated empty bodies) + * Author: Rick Troth, Rice University, Information Systems + * Date: 1993-May-20 + * + * Note: this stage reads the parent's header from its + * secondary input stream (number 1; primary is #0) + * and prepends that to any header in the child part. + * One effect is multiple Content-Type header lines. + * This is okay because only the last Content-Type + * is recognized (unless you try to export these files + * to certain other MIME-capable mail readers). + * + * Note: files created by this stage should be feed to MIMEREAD. + */ + +Parse Arg fn q . '(' . ')' . +If fn = "" Then Exit -1 + +/* clear the "content-type" by tacking on our own empty one */ +'CALLPIPE *.INPUT.1: | APPEND LITERAL Content-Type: | STEM HEAD.' +If rc ^= 0 Then i = 0 + Else i = head.0 + +tag = "N/A" +content = "MESSAGE" + +Do Forever + + 'PEEKTO LINE' + /* watch for end-of-file */ + If rc ^= 0 Then Leave + + /* eliminate TAB characters in the header */ + line = Translate(line,' ','05'x) + + /* watch for end-of-header */ + If Strip(line) = "" Then Leave + + If Left(line,1) = ' ' Then val = val Strip(line) + Else Do; Parse Var line tag val; Upper tag; End + + If Right(tag,1) ^= ':' Then Leave + + If tag = "CONTENT-TYPE:" Then content = val + /* all other tags ignored */ + + i = i + 1 + head.i = line + 'READTO' /* consume this record */ + + End /* Do While */ + +If rc ^= 0 Then Exit rc * (rc ^= 12) + +head.0 = i + +/* discard all blank lines after the header */ +Do Forever + 'PEEKTO LINE' + If rc ^= 0 Then Leave + If Strip(Translate(line,' ','05'x)) ^= "" Then Leave + 'READTO' /* consume this record */ + End /* Do Forever */ +If rc ^= 0 Then Exit rc * (rc ^= 12) + +If content = "" Then content = "MESSAGE" +Parse Upper Value Strip(content) With content ';' . +Parse Var content major '/' minor +ft = major +If content = "MESSAGE/EXTERNAL-BODY" Then ft = "MSGFETCH" + +If ^Datatype(q,'W') Then q = 0 +If q = 0 Then 'ADDPIPE *.OUTPUT: | HOLE' + Else 'ADDPIPE *.OUTPUT: | >' fn ft 'A' +'CALLPIPE STEM HEAD. | *:' +'OUTPUT' " " +If rc ^= 0 Then Exit rc + +/* a simple "short" doesn't always work here; why? */ +'CALLPIPE *: | *:' +If rc ^= 0 Then Exit rc + +'SEVER OUTPUT' + +Exit + diff --git a/vmworkshop-vmarcs/1996/mime/mimeprof.xedit b/vmworkshop-vmarcs/1996/mime/mimeprof.xedit new file mode 100644 index 0000000..4a7a888 --- /dev/null +++ b/vmworkshop-vmarcs/1996/mime/mimeprof.xedit @@ -0,0 +1,94 @@ +/* + * Name: MIMEPROF XEDIT + * profile for XEDIT when reading MIME mail objects + */ + +Parse Arg args '(' opts ')' . +Parse Upper Var args fn ft fm . + +'COMMAND CMS GLOBALV SELECT MIME GET RICEMAIL MAILBOOK' +mailbook = (mailbook = 1) +Do While opts ^= "" + Parse Upper Var opts op opts + Select + When Abbrev("RICEMAIL",op,4) Then mailbook = 1 + When Abbrev("NORICEMAIL",op,3) Then mailbook = 0 + When Abbrev("MAILBOOK",op,8) Then mailbook = 1 + When Abbrev("NOMAILBOOK",op,3) Then mailbook = 0 + Otherwise 'COMMAND XMITMSG 3' op '(ERRMSG' + End /* Select */ + End /* Do While */ +ricemail = mailbook +'COMMAND CMS GLOBALV SELECT MIME PUT RICEMAIL MAILBOOK' + +/* MIMEMAIN figures out which verb from a PARSE SOURCE statement, * + * thus MIMEMAIN handles all of the following verbs: */ +'COMMAND SET SYNONYM DELETE 6 MACRO MIMEMAIN' +'COMMAND SET SYNONYM DISCARD 7 MACRO MIMEMAIN' +'COMMAND SET SYNONYM EXClude 3 MACRO MIMEMAIN' +'COMMAND SET SYNONYM FOrward 2 MACRO MIMEMAIN' +'COMMAND SET SYNONYM INClude 3 MACRO MIMEMAIN' +'COMMAND SET SYNONYM Log 1 MACRO MIMEMAIN' +'COMMAND SET SYNONYM MAIL 4 MACRO MIMEMAIN' +'COMMAND SET SYNONYM NExt 2 MACRO MIMEMAIN' +'COMMAND SET SYNONYM PRint 2 MACRO MIMEMAIN' +'COMMAND SET SYNONYM PREvious 3 MACRO MIMEMAIN' +'COMMAND SET SYNONYM Reply 1 MACRO MIMEMAIN' +'COMMAND SET SYNONYM Quit 1 MACRO MIMEMAIN' +'COMMAND SET SYNONYM SEnd 2 MACRO MIMEMAIN' +'COMMAND SET SYNONYM SUspend 2 MACRO MIMEMAIN' +'COMMAND SET SYNONYM SUBject 3 MACRO MIMEMAIN' + +/* these match (old) MAILBOOK's default PFKey settings */ +'COMMAND SET PF01 HELP' +'COMMAND SET PF02 NEXT' +'COMMAND SET PF03 QUIT' +'COMMAND SET PF04 PRINT' +'COMMAND SET PF05 REPLY' +'COMMAND SET PF06 SWITCH SEND' +'COMMAND SET PF07 COMMAND BACKWARD' +'COMMAND SET PF08 COMMAND FORWARD' +'COMMAND SET PF09 DELETE' +'COMMAND SET PF10 MENUBAR' +'COMMAND SET PF11 LOG' +'COMMAND SET PF12 CANCEL' +'COMMAND SET PF13' +'COMMAND SET PF14' +'COMMAND SET PF15' +'COMMAND SET PF16' +'COMMAND SET PF17' +'COMMAND SET PF18' +'COMMAND SET PF19' +'COMMAND SET PF20' +'COMMAND SET PF21' +'COMMAND SET PF22' +'COMMAND SET PF23' +'COMMAND SET PF24' + +/* these verbs are specific to MIME */ +'COMMAND SET SYNONYM RETurn 3 COMMAND QUIT' + +/* +If ^mailbook Then Do + 'COMMAND CMS PIPE COMMAND STATE MAILUSER XEDIT *' + If rc ^= 0 Then Leave + 'MACRO MAILUSER READ' + If rc ^= 0 Then Exit rc + End ** If .. Do */ + +'COMMAND SET LINEND OFF' + +/* the following section is tricky, relies on XEDIT ring */ +If fn ^= "" Then Do + 'COMMAND CMS STATE' fn 'CMSUT2 *' + If rc = 0 Then Do + 'COMMAND EXTRACT/FNAME' + 'COMMAND XEDIT' fn 'CMSUT2' + 'COMMAND SET FN' fname.1 + 'COMMAND SET FT HEAD' + 'COMMAND XEDIT' + End /* If .. Do */ + End /* If .. Do */ + +Exit + diff --git a/vmworkshop-vmarcs/1996/mime/mimeread.exec b/vmworkshop-vmarcs/1996/mime/mimeread.exec new file mode 100644 index 0000000..2809b9a --- /dev/null +++ b/vmworkshop-vmarcs/1996/mime/mimeread.exec @@ -0,0 +1,14 @@ +/* + * Name: MIMEREAD EXEC + * "opens" MIME formatted messages from CMS disk files + * Author: Rick Troth, Rice University, Information Systems + * Date: 1993-May-18 + * + * Note: this EXEC is primarily used from the + * FILELIST of a broken-out multi-part message + */ + +Parse Arg fn ft fm . '(' opts ')' . +'PIPE <' fn ft fm '| MIMEREAD (' opts +Exit rc + diff --git a/vmworkshop-vmarcs/1996/mime/mimeread.rexx b/vmworkshop-vmarcs/1996/mime/mimeread.rexx new file mode 100644 index 0000000..c804a2e --- /dev/null +++ b/vmworkshop-vmarcs/1996/mime/mimeread.rexx @@ -0,0 +1,338 @@ +/* + * Name: MIMEREAD REXX + * CMS Pipelines stage to interpret MIME-ified mail + * Author: Rick Troth, Rice University, Information Systems + * Rick Troth, Houston, Texas, USA + * Date: 1992-Aug-01, 1993-May-21 + */ + +Trace "OFF" + +Parse Source . . arg0 . +Parse Upper Arg args '(' opts ')' . +'CALLPIPE COMMAND IDENTIFY | VAR IDENTITY' +Parse Var identity userid . hostid . rscsid . + +'CALLPIPE COMMAND QUERY LANGUAGE ALL' , + '| SPEC / / 1 1-* N / / N | VAR LANGLIST' +If Index(langlist," WEB ") = 0 Then , + Address "COMMAND" 'SET LANGUAGE (ADD WEB USER' + +version = "" +date = "" +name = "" +subject = "" +from = "" +tag = ""; content = ""; code = "" + +Address "COMMAND" 'GLOBALV SELECT MIME GET MAILBOOK' + +i = 0 + +Do Forever + + 'READTO LINE' + /* watch for end-of-file */ + If rc ^= 0 Then Leave + + /* eliminate TAB characters in the header */ + line = Translate(line,' ','05'x) + + /* watch for end-of-header */ + If Strip(line) = "" Then Leave + + i = i + 1 + head.i = line + + If Left(line,1) = ' ' Then val = val Strip(line) + Else Do; Parse Var line tag val; Upper tag; End + + Select /* tag */ + + /* MIME specific tags */ + When tag = "MIME-VERSION:" Then version = val + When tag = "CONTENT-TYPE:" Then content = val + When tag = "CONTENT-TRANSFER-ENCODING:" Then code = val + + /* regular mail tags */ + When tag = "DATE:" Then date = val + When tag = "SUBJECT:" Then subject = Strip(val) + When tag = "FROM:" Then from = val + + Otherwise /* Say "command/parameter" tag "ignored" 843 */ nop + End /* Select tag */ + + End /* Do While */ + +If rc ^= 0 Then Exit rc * (rc ^= 12) + +head.0 = i + +content = Strip(content) +If version = "" & content = "" & mailbook Then Exit -1 +/* +If version = "" & content = "" Then Do + Say "Version is empty and content is empty." +/* 637, 693, others? */ +Exit -1 + End + */ + +'PEEKTO' +If rc ^= 0 Then Exit rc * (rc ^= 12) +If content = "" Then content = "TEXT/PLAIN" + +Address "COMMAND" 'GLOBALV SELECT MIME PUT VERSION' +Parse Var content content ';' parms +Upper content code +/* Say "Content-Type:" content */ +/* Say "Content-Transfer-Encoding:" code */ +Parse Var content major '/' minor + +Select /* from */ + When Index(from,'<') > 0 Then Parse Var from . '<' user + When Index(from,'(') > 0 Then Parse Var from user '(' . + Otherwise user = from + End +If Index(user,'!') > 0 Then Do + Parse Value Reverse(user) With user '!' . + user = Reverse(user) + End /* If .. Do */ +Parse Var user user '@' host +Parse Var user user '%' . +user = Translate(user,'__','.=') + +Select /* content */ + + When content = "MULTIPART/X-SIFT" | content = "MULTIPART/X-UFT" , + | content = "MULTIPART/SIFT" | content = "MULTIPART/UFT" Then Do + + /* extract the boundary string from the "parms" */ + Do While parms ^= "" + Parse Var parms parm ';' parms + Parse Upper Var parm var '=' . + Parse Var parm . '=' val + If var = "BOUNDARY" Then boundary = Strip(val) + End /* Do While */ + If Left(boundary,1) = '"' Then , + Parse Var boundary . '"' boundary '"' . + + /* consume the first part (should be empty) */ + 'CALLPIPE *: | TOLABEL --' || boundary || '| CONSOLE' + 'READTO' /* waste that first boundary */ + + prev.0 = 0 + /* split the parts at the boundary */ + Do Forever + 'CALLPIPE (END !) *: | TOLABEL --' || boundary || , + '| FB:' arg0 args '(' opts '| STEM NEXT.' , + '! STEM PREV. | FB:' + 'READTO' /* eat the boundary */ + 'PEEKTO' /* is there any more? */ + If rc ^= 0 Then Leave + 'CALLPIPE STEM NEXT. | STEM PREV.' + End /* Do Forever */ + + End /* When .. Do */ + + When content = "X-SIFT/METAFILE" | content = "SIFT/METAFILE" , + | content = "X-SIFT/META" | content = "SIFT/META" , + | content = "APPLICATION/X-SIFT" , + | content = "APPLICATION/SIFT" Then Do +Say "Definite SIFT/UFT header:" + If code = "BASE64" Then , + 'ADDPIPE *.INPUT: | DEBASE64 | MAKETEXT LOCAL | *.INPUT:' + Do Forever + 'READTO RECORD' + If rc ^= 0 Then Leave + If Strip(record) = "" Then Iterate + Parse Var record a b . + Select + When Index(a,'=') > 0 | Left(b,1) = '=' Then , + Parse Var record tag '=' val + When Index(a,':') > 0 Then , + Parse Var record tag ':' val + Otherwise , + Parse Var record tag val + End /* Select */ + tag = Strip(tag); If tag ^= "" Then , + 'OUTPUT' Translate(tag) || '=' || Strip(val) + End /* Do Forever */ + End /* When .. Do */ + + When content = "X-SIFT/DATAFILE" | content = "SIFT/DATAFILE" , + | content = "X-SIFT/DATA" | content = "SIFT/DATA" Then Do +Say "Definite SIFT/UFT body:" + _fn = Right(Date('D'),3,'0') || Right(Time('S'),5,'0') + 'CALLPIPE *.INPUT.1: | >' _fn 'METAFILE A' + 'CALLPIPE *: | >' _fn 'DATAFILE A' +Address "COMMAND" 'XEDIT' _fn 'DATAFILE' + End /* When .. Do */ + + When content = "APPLICATION/OCTET-STREAM" Then Do + 'ADDPIPE *.OUTPUT: | UFTXREAD' + 'CALLPIPE LITERAL FILE -' user '| *:' + If date ^= "" Then 'CALLPIPE LITERAL DATE' date '| *:' + Parse Var subject . "FILE" name + If name ^= "" Then 'CALLPIPE LITERAL NAME' name '| *:' + 'CALLPIPE VAR PARMS | DEBLOCK LINEND ; | CHANGE /=/ / | *:' + 'CALLPIPE LITERAL DATA | *:' + If code = "BASE64" Then , + 'CALLPIPE *: | DEBASE64 | *:' + Else + 'CALLPIPE *: | MAKETEXT NETWORK | *:' + End /* When .. Do */ + + When content = "IMAGE/GIF" Then Do + /* verify that we have VMGIF accessed */ + 'CALLPIPE CMS STATE VMGIF MODULE * | *:' + If rc ^= 0 Then Exit rc + + /* try to stash the input stream in a temp file */ + If code = "BASE64" Then , + 'CALLPIPE *: | DEBASE64 | > TEMP#GIF GIF A3' + If code = "QUOTED-PRINTABLE" Then , + 'CALLPIPE *: | DECODEQP | > TEMP#GIF GIF A3' + If rc ^= 0 Then Do + grc = rc + 'CALLPIPE COMMAND ERASE TEMP#GIF GIF A' + Exit grc + End /* If .. Do */ + + /* ensure the right libraries GLOBALed (I hate this!) */ + 'CALLPIPE COMMAND QUERY TXTLIB' , + '| STRIP LEADING STRING /TXTLIB = / | JOIN * | VAR TXTLIB' + Upper txtlib; If Strip(txtlib) = "NONE" Then txtlib = "" + 'CALLPIPE COMMAND GLOBAL TXTLIB ADMPLIB ADMGLIB' txtlib + + /* now run VMGIF */ + 'CALLPIPE CMS VMGIF -em5 TEMP#GIF | *:'; grc = rc + + /* restore GLOBALed libraries */ + 'CALLPIPE COMMAND GLOBAL TXTLIB' txtlib + + Exit grc + End /* When .. Do */ + + When major = "TEXT" | content = "APPLICATION/POSTSCRIPT" Then Do + If code = "BASE64" Then 'ADDPIPE *.INPUT: | DEBASE64 |' , + 'MAKETEXT LOCAL | *.INPUT:' + If code = "QUOTED-PRINTABLE" Then 'ADDPIPE *.INPUT:' , + '| DECODEQP | MAKETEXT LOCAL | *.INPUT:' + If minor = "RICHTEXT" | minor = "ENRICHED" Then , + 'CALLPIPE *: | RICHTEXT | >' arg0 'CMSUT1 A3' + Else , + 'CALLPIPE *: | UNTAB -8 | >' arg0 'CMSUT1 A3' + 'CALLPIPE STEM HEAD. | >' arg0 'CMSUT2 A3' + If user ^= "" Then + Push "COMMAND SET FN" user + Push "COMMAND SET FT MAIL" + Push "COMMAND SET FM A1" + If subject ^= "" Then + Push "COMMAND MSG Subject:" subject + Push "COMMAND MACRO MIMEPROF" arg0 "(" opts + /* do NOT wrap the following with MAKEBUF/DROPBUF */ + Address "COMMAND" 'XEDIT' arg0 'CMSUT1' + End /* When .. Do */ + + When major = "MULTIPART" Then Do + + /* extract the boundary string from the "parms" */ + Do While parms ^= "" + Parse Var parms parm ';' parms + Parse Upper Var parm var '=' . + Parse Var parm . '=' val + If var = "BOUNDARY" Then boundary = Strip(val) + End /* Do While */ + If Left(boundary,1) = '"' Then + Parse Var boundary . '"' boundary '"' . + label = Right(Time('S'),5,'0') || '#' + i = 0 + + /* split the parts at the boundary */ + Do Forever + 'CALLPIPE (END !) *: | TOLABEL --' || boundary || , + '| P: MIMEPART' label || Right(i,2,'0') i , + '! STEM HEAD. | P:' + 'READTO' /* eat the boundary */ + 'PEEKTO' /* is there any more? */ + i = i + 1 + If rc ^= 0 Then Leave + End /* Do Forever */ + + /* are we running under MAILBOOK? */ + Address "COMMAND" 'GLOBALV SELECT MIME GET MAILBOOK' + mailbook = (mailbook = 1) + If mailbook Then /* turn it off under FILELIST */ , + Address "COMMAND" 'GLOBALV SELECT MIME SET MAILBOOK 0' + + /* invoke FILELIST on the now disk-resident separated parts */ + Address "COMMAND" 'MAKEBUF' + Push "COMMAND SET PF11 MACRO EXECUTE CURSOR EXEC MIMEREAD" + Push "COMMAND SET LINEND OFF" + Push "SNAME" /* sort the list by filename */ + Push "MSG These files will be erased when you leave FILELIST" + If subject ^= "" Then + Push "COMMAND MSG Subject:" subject + Push "COMMAND MSG From:" from + Address "COMMAND" 'EXEC FILELIST' label || '*' + flrc = rc + Address "COMMAND" 'DROPBUF' + + /* restore MAILBOOK flag */ + Address "COMMAND" 'GLOBALV SELECT MIME PUT MAILBOOK' + + /* clean-up after ourselves */ + Do j = 0 to i + 'CALLPIPE COMMAND ERASE' label || Right(j,2,'0') '* A' + End /* Do For */ + rc = flrc + + End /* When .. Do */ + + When content = "MESSAGE/EXTERNAL-BODY" Then Do + Do While parms ^= "" + Parse Var parms parm ';' parms + Parse Upper Var parm var '=' . + Parse Var parm . '=' val + var = Strip(var) + val = Strip(val) + If Left(val,1) = '"' Then Parse Var val '"'val'"' + Select /* var */ + When Abbrev("NAME",var,4) Then name = val + When Abbrev("SITE",var,4) Then host = val + When Abbrev("ACCESS-TYPE",var,4) Then mode = val + When Abbrev("DIRECTORY",var,3) Then directory = val + Otherwise Say var '=' val + End /* Select var */ + End /* Do While */ + If mode ^= "anon-ftp" Then Exit -1 + Address "COMMAND" 'MAKEBUF' + Queue "anonymous" userid || '@' || hostid + Queue "CD" directory + Queue "GET" name arg0 || ".CMSUT1.A3" + Address "COMMAND" 'FTP' host + Parse Var name fn '.' ft '.' . + If fn = "" Then ft = userid + Push "COMMAND SET FN" fn + If ft = "" Then ft = "TXT" + Push "COMMAND SET FT" ft + Push "COMMAND SET FM A1" + Address "COMMAND" 'XEDIT' arg0 'CMSUT1' + Address "COMMAND" 'DROPBUF' + End /* When .. Do */ + + When content = "MESSAGE/RFC822" Then , + 'CALLPIPE *: |' arg0 args '(' opts + + Otherwise Do +/* Address "COMMAND" 'XMITMSG 88 CONTENT (APPLID WEB ERRMSG' */ + Address "COMMAND" 'XMITMSG 636 CONTENT (APPLID WEB ERRMSG' +/* Say "Unsupported MIME content type:" '"'content'"' */ + rc = 8 + End + + End /* Select maj */ + +Exit rc * (rc ^= 12) + diff --git a/vmworkshop-vmarcs/1996/mime/mimeread.xedit b/vmworkshop-vmarcs/1996/mime/mimeread.xedit new file mode 100644 index 0000000..e3792cd --- /dev/null +++ b/vmworkshop-vmarcs/1996/mime/mimeread.xedit @@ -0,0 +1,26 @@ +/* + * Name: MIMEREAD XEDIT + * Date: 1993-Apr-23 + */ + +Parse Arg args '(' opts ')' . + +mailbook = 0 +Do While opts ^= "" + Parse Upper Var opts op opts + If op = "RICEMAIL" Then mailbook = 1 + If op = "MAILBOOK" Then mailbook = 1 + End /* Do While */ +'COMMAND CMS GLOBALV SELECT MIME PUT MAILBOOK' + +Parse Arg argstring + +'COMMAND EXTRACT/LINE' +'MACRO ALL' +'COMMAND TOP' +Trace "OFF" +'COMMAND CMS PIPE XEDIT | MIMEREAD' argstring +'COMMAND :' || line.1 + +Exit + diff --git a/vmworkshop-vmarcs/1996/mime/mimesend.xedit b/vmworkshop-vmarcs/1996/mime/mimesend.xedit new file mode 100644 index 0000000..7775c53 --- /dev/null +++ b/vmworkshop-vmarcs/1996/mime/mimesend.xedit @@ -0,0 +1,51 @@ +/* + * Name: MIMESEND XEDIT + * Author: Rick Troth, Houston, Texas + * Date: 1993-Apr-28 + * + * Note: this XEDIT MACRO, specifically for use with + * Richard Schafer's MAILBOOK package, is useless + * without the rest of the MIME package, although it + * is sometimes not included with the MIME package. + * Get the CMS MIME package via Anonymous FTP from + * ftp.rice.edu, or (better) from the web page at + * http://ua1vm.ua.edu/~troth/rickvmsw/rickvmsw.html. + * + * Note: this XEDIT MACRO must be invoked from MAILBOOK exits + * POSTSEND (Mailbook 91+) or SEND (Mailbook 90 or older). + * If the latter, then it must be program stack queued. + */ + +Parse Arg args '(' opts ')' . + +mailbook = 0 +Do While opts ^= "" + Parse Upper Var opts op opts + If op = "RICEMAIL" Then mailbook = 1 + If op = "MAILBOOK" Then mailbook = 1 + End /* Do While */ +ricemail = mailbook +'COMMAND CMS GLOBALV SELECT MIME PUT RICEMAIL MAILBOOK' + +'COMMAND SET SYNONYM ATTACH 3 MACRO MIMEMAIN' +'COMMAND SET SYNONYM SIGN 3 MACRO MIMEMAIN' + +'COMMAND CMS GLOBALV SELECT MIME SET BOUNDARY' /* to clear it */ + +/* don't REinsert the MIME header lines upon resuming composition */ +'COMMAND CMS GLOBALV SELECT MAIL GET COMMAND_LINE VERSION' +Parse Upper Var command_line . '(' opts ')' . +If Index(opts,"RESUME") > 0 Then Exit +version = "MAILBOOK/" || version + +'COMMAND EXTRACT/LINE/CURSOR' /* retain current position */ +'COMMAND TOP' /* move to top of file */ +'INPUT MIME-Version: 1.0' /* insert MIME tags */ +'INPUT Content-Type: text/plain' /* " " " */ +'INPUT X-Mail-User-Agent:' version /* indicate mail program */ +'COMMAND :' || line.1 + 3 /* adjust current line */ +'COMMAND CURSOR FILE' cursor.3 + 3 /* adjust cursor location */ +'COMMAND SET ALT 0 0' /* mark this file as fresh */ + +Exit + diff --git a/vmworkshop-vmarcs/1996/mime/print.rexx b/vmworkshop-vmarcs/1996/mime/print.rexx new file mode 100644 index 0000000..c0254d8 --- /dev/null +++ b/vmworkshop-vmarcs/1996/mime/print.rexx @@ -0,0 +1,240 @@ +/* + * Name: PRINT REXX + * a disposable filter for printing from + * Pipelines-based applications such as CMS Gopher. + * (disposable in that you can replace it with your own) + * Author: Rick Troth, Rice University, Information Systems + * Thanks to Jim Colten for two better versions of + * "STANDARD". + * Date: Spring 1992, 1993-Jan-07 + * + * Note: Address() returns garbage in a pipelines stage + */ + +dev = "00E" +linecount = 55 +upcase = 0 + +Parse Arg name '(' opts ')' . +Parse Upper Var name fn ft fm . +fn = Left(fn,8); ft = Left(ft,8) + +fml = Length(fm) +Select /* fml */ + When fml = 1 Then If Datatype(Left(fm1,1),'N') Then fm = "" + When fml = 2 Then Do + If Datatype(Left(fm,1),'N') Then fm = "" + If ^Datatype(Right(fm,1),'N') Then fm = "" + End /* When .. Do */ + Otherwise fm = "" + End /* Select fm */ + +If Words(name) = 2 | Words(name) = 3 Then + name = Left(fn,8) Left(ft,8) Left(fm,2) + +'CALLPIPE COMMAND QUERY CMSLEVEL | CHOP , | VAR CMSLEVEL' +'CALLPIPE CP QUERY CPLEVEL | CHOP , | VAR CPLEVEL' +title = "File:" Left(fn,8) Left(ft,8) Left(fm,2) , + " " cmslevel "--" cplevel + +cc = (ft = "LISTING" | ft = "LIST3800" | , + ft = "LISTCPDS" | ft = "LIST3820" | ft = "LIST38PP") + +Do While opts ^= "" + Parse Var opts op opts; Upper op + Select /* op */ + When Abbrev("LINECOUNT",op,2) Then Do + Parse Var opts linecount opts + If linecount = "" Then linecount = 55 + End /* When .. Do */ + When Abbrev("UPCASE",op,2) Then upcase = 1 + When Abbrev("CC",op,2) Then cc = 1 + When Abbrev("NOCC",op,4) Then cc = 0 + When Abbrev("TITLE",op,1) Then Do + title = opts + opts = "" + End /* When .. Do */ + Otherwise Say "Unrecognized option" op + End /* Select op */ + End /* Do While */ + +If cc Then 'CALLPIPE *: | ASATOMC | URO' dev +/* Else Call STANDARD */ +Else Do Forever + 'PEEKTO' + If rc ^= 0 Then Leave + 'CALLPIPE *: | TAKE' linecount , + '| SPEC .09. X2C 1 1-* NEXT' , + '| PREFACE LITERAL' '19'x || title , + '| PREFACE LITERAL' '89'x , + '| URO' dev + If rc ^= 0 Then Leave + End /* Else .. Do Forever */ +prc = rc * (rc ^= 12) + +/* use CP CLOSE, so the user can SPOOL dev CONT if he wants to */ +If fn = "" Then Parse Value Diag(08,'CLOSE' dev) With rs + Else Parse Value Diag(08,'CLOSE' dev 'NAME' fn ft) With rs + +If rs ^= "" Then + 'CALLPIPE VAR RS | SPLIT AT STRING "' || '15'x || '" | *:' + +Return prc + + + +/* ------------------------------------------------------------ STANDARD + * Here is a version of STANDARD that loops once per page rather than + * once per record. It should work with most versions of Pipelines. + */ +STANDARD: +header = '19'x || title +'PEEKTO' +Do While rc = 0 + 'CALLPIPE *: | TAKE' linecount , + '| SPEC .09. X2C 1 1-* NEXT' , + '| PREFACE VAR HEADER' , + '| PREFACE LITERAL' '89'x , + '| URO' dev + 'PEEKTO' + End /* Do Forever*/ +Return + + + +/* ------------------------------------------------------------ PRINTASA + */ +PRINTASA: + +'ADDPIPE *.OUTPUT: | URO' dev + +'PEEKTO LINE' +Do While rc = 0 + Parse Var line 1 byte 2 line + line = byte || line + 'OUTPUT' line + 'READTO' + 'PEEKTO LINE' + End /* Do While */ + +Return + + + +/* + +OVersize + allows you to print: + + * files that have records larger than the carriage size of the + virtual printer, and + + * files that have a SPECIAL status of YES. + + When the OVERSIZE option is used, the CC option will be set as + a default. This default setting of CC can be overridden by + specifying either the NOCC or the HEX option with the OVersize + option. + + If the file has a SPECIAL status of YES (and NOCC is not specified), + any records with a carriage control character of x'5A' will be + printed if all of the following conditions are true: + - the record length is not greater than 32767 bytes. + - a printer subsystem that handles the x'5A' carriage controller + (such as the 3820 or 3800-3/8) is utilized. + - a software package that handles such characters (such as PSF) + is utilized. + Otherwise, these records will not be printed. + + Other records that are larger than the virtual printer's carriage + size are printed, but are truncated to the carriage size (or + carriage size + 1 if CC is specified). + + (The SPECIAL status indicates whether or not the file contains records + with X'5A' carriage control characters. See the CP QUERY command to + determine SPECIAL status of a file.) + + The OVERSIZE (and CC) option is assumed if the filetype is + LISTCPDS, LIST3820, or LIST38PP. If OVERSIZE is not specified and + the file you want to print is larger than the virtual printer's + carriage size, the message "Records exceeds allowable maximum" + is displayed. + +CC (HEADer) + interprets the first character of each record as a carriage + control character. If the filetype is LISTING, LIST3800, or + LISTCPDS, the CC option is assumed. If CC is in effect, the PRINT + command neither performs page ejects nor counts the number of + lines per page; these functions are controlled by the carriage + control characters in the file. The LINECOUN option has no effect + if CC is in effect. + + HEADER creates a shortened header page with only the filename, + filetype, and filemode at the top of the page that follows the + standard header page. The records in the file being printed begin + on a new page following both header pages. The HEADER option can + only be used in conjunction with the CC option. If the CC option + is not specified HEADER has no effect. + +TRC + interprets the first data byte in each record as a TRC (Table Ref- + erence Character) byte. The value of the TRC byte determines + which translate table the 3800 printer selects to print a record. + The value of the TRC byte corresponds to the order in which you + have loaded WCGMs (via the CHARS keyword of the SETPRT command). + Valid values for TRC are 0, 1, 2, and 3. If an invalid value is + found, a TRC byte of 0 is assumed. If the filetype is LIST3800, + TRC is assumed. + +NOTRC + does not interpret the first data byte in each record as a TRC + byte. NOTRC is the default. + +MEMber <* > + <membername> + prints the members of macro or text libraries. This option may be + specified if the file is a simulated partitioned data set + (filetype MACLIB, TXTLIB, or LOADLIB). If an asterisk (*) is + entered, all individual members of that library are printed. If a + membername is specified, only that member is printed. + +HEX + prints the file in graphic hexadecimal format. If HEX is speci- + fied, the options CC and UPCASE are ignored, even if specified, + and even if the filetype is LISTING, LIST3800, LISTCPDS, LIST3820, + or LIST38PP. If both the OVersize and HEX options are specified, + the NOCC option will be in effect. + + */ + + + +/* -- Here is a version of STANDARD that does not loop, requires + pipes mod level 6 (for sync) */ +STANDARD2: +header = '19'x || title + + 'CALLPIPE (end \)', + '| literal' '89'x, /* page eject record? */ + '| append var header', /* page header record */ + '| spec 1-* 1', /* simulate BLOCK LINEND by */ + ' .15. x2c next', /* adding linend chars & join*/ + '| join *', /* both recs into 1 rec */ + '| dup *', /* make an endless supply */ + , + '| a: sync', /* 2 streams marching together */ + '| b: faninany', /* combine the streams */ + , + '| deblock linend', /* deblock into separate recs */ + '| uro' dev, /* print it */ + , + '\ *:', /* incoming records */ + '| spec .09. x2c 1', /* add charriage control and */ + ' 1-* next', /* simulate BLOCK LINEND by */ + ' .15. x2c next', /* adding linend chars & */ + '| join' linecount-1, /* join all recs for a page into 1 rec */ + '| a:', /* send through sync */ + '| b:' /* sync sends them back, now send them to faninany */ + +Return + diff --git a/vmworkshop-vmarcs/1996/mime/print.xedit b/vmworkshop-vmarcs/1996/mime/print.xedit new file mode 100644 index 0000000..9877a6b --- /dev/null +++ b/vmworkshop-vmarcs/1996/mime/print.xedit @@ -0,0 +1,27 @@ +/* + * Name: PRINT XEDIT + * feed this file to your virtual printer via Pipes + * Author: Rick Troth, Rice University, I/S VM Systems Support + * Date: 1992-Jun-11, Jun-25 + */ + +Parse Arg args '(' opts + +If args ^= "" Then + 'COMMAND CMS PIPE CMS PRINT' args '(' opts '| STEM EMSG.' + +Else Do + 'COMMAND EXTRACT/LINE/FNAME/FTYPE/FMODE' + 'COMMAND TOP' + 'COMMAND CMS PIPE XEDIT' , + '| PRINT' fname.1 ftype.1 fmode.1 '(' opts , + '| STEM EMSG.' + 'COMMAND :' || line.1 + rc = 0 + End /* Else Do */ + +If rc = 0 Then Do i = 1 To emsg.0; 'COMMAND MSG' emsg.i; End + Else Do i = 1 To emsg.0; 'COMMAND EMSG' emsg.i; End + +Exit + diff --git a/vmworkshop-vmarcs/1996/mime/richtext.rexx b/vmworkshop-vmarcs/1996/mime/richtext.rexx new file mode 100644 index 0000000..f2edcf4 --- /dev/null +++ b/vmworkshop-vmarcs/1996/mime/richtext.rexx @@ -0,0 +1,174 @@ +/* + * Name: RICHTEXT REXX + * convert MIME "richtext" ("enriched" text) to plain-text. + */ + +'STREAMSTATE OUTPUT 0' /* Have a primary stream? */ +If rc = 12 Then Do + 'ADDPIPE *.OUTPUT.0: | CONSOLE' + End /* If .. Do */ + +'STREAMSTATE OUTPUT 1' /* Have a secondary stream? */ +If rc = -4 Then Do + 'ADDSTREAM OUTPUT' + 'ADDPIPE *.OUTPUT.1: | HOLE' + End /* If .. Do */ + +meta = "TEST_VAR" +data = "test value" +'CALLPIPE VAR DATA | SPEC /' , + || meta || '/ 1 /=/ NEXT 1-* NEXT | *.OUTPUT.1:' + +meta = "" /* start with NOT collecting meta data */ +data = "" /* start with an EMPTY meta-data buffer */ + +qs = "> " /* quote prefix string */ +xs = "> " /* excerpt prefix string */ +indent = 4 + +'CALLPIPE COMMAND QUERY DISPLAY | VAR DISPLAY' +Parse Var display . . width . +If ^Datatype(width,'N') Then width = 72 + Else width = width - 8 + +/* what about TAB characters? */ +'ADDPIPE *.INPUT: | UNTAB -8 | SPLIT BEFORE /</' , + '| SPLIT BEFORE /&/ | SPEC 1-* 1 / / NEXT | *.INPUT:' + +line = "" +center = 0 +quote = 0 +excerpt = 0 +li = 0 +ri = 0 +hs = 0 + +Do Forever + + 'PEEKTO TEXT' + If rc ^= 0 Then Leave + + If Strip(text) = "" Then text = "<P>" + + If Left(text,1) = '<' Then Do + Parse Var text '<'command'>'text + Parse Upper Var command verb args + If Right(text,2) = "= " Then text = Left(text,Length(text)-2) + + Select /* verb */ + + When Left(verb,1) = "!" Then nop + When verb = "LT" Then line = line || '<' + When verb = "GT" Then line = line || '>' + When verb = "CENTER" Then center = 1 + When verb = "/CENTER" Then center = 0 + When verb = "QUOTATION" Then quote = 1 + When verb = "/QUOTATION" Then quote = 0 +/* what about BLOCKQUOTE? is it = EXCERPT? */ + When verb = "EXCERPT" Then Do + Call FLUSH + 'OUTPUT' + excerpt = 1 + End /* When .. Do */ + When verb = "/EXCERPT" Then Do + Call FLUSH + 'OUTPUT' + excerpt = 0 + End /* When .. Do */ + When verb = "LEFTINDENT" Then li = li + indent + When verb = "/LEFTINDENT" Then li = li - indent + When verb = "RIGHTINDENT" Then ri = ri + indent + When verb = "/RIGHTINDENT" Then ri = ri - indent + When verb = "NL" | verb = "BR" Then Call FLUSH + When verb = "LI" Then Call FLUSH + When verb = "MENU" Then Call FLUSH + When verb = "/MENU" Then Call FLUSH + When verb = "P" Then Do + 'OUTPUT' " " + Call FLUSH + End /* When .. Do */ + + When verb = "ITALIC" | verb = "/ITALIC" , + | verb = "BOLD" | verb = "/BOLD" , + | verb = "FIXED" | verb = "/FIXED" Then nop + + When verb = "TITLE" Then Do + If data ^= "" Then 'CALLPIPE VAR DATA | SPEC /' , + || meta || '/ 1 /=/ NEXT 1-* NEXT | *.OUTPUT.1:' + meta = "TITLE" + End /* When .. Do */ + When verb = "/TITLE" Then Do + If data ^= "" Then 'CALLPIPE VAR DATA | SPEC /' , + || meta || '/ 1 /=/ NEXT 1-* NEXT | *.OUTPUT.1:' + meta = "" + data = "" + End /* When .. Do */ + +When verb = "HTML" | verb = "/HTML" , + | verb = "HEAD" | verb = "/HEAD" , + | verb = "BODY" | verb = "/BODY" , + | verb = "ADDRESS" | verb = "/ADDRESS" , + | verb = "LINK" | verb = "IMG" , + | verb = "H1" | verb = "/H1" , + | verb = "H2" | verb = "/H2" , + | verb = "H3" | verb = "/H3" , + | verb = "UL" | verb = "/UL" , + | verb = "TT" | verb = "/TT" , + | verb = "I" | verb = "/I" , + | verb = "A" | verb = "/A" Then nop + + Otherwise , + Address "COMMAND" 'XMITMSG 3 VERB (ERRMSG' + + End /* Select verb */ + + End /* If .. Do */ + + If Left(text,1) = '&' & Index(text,';') > 0 Then Do + Parse Var text '&'token';'text + Select /* token */ + When token = "lt" Then text = '<' || text + When token = "gt" Then text = '>' || text + When token = "thorn" Then text = 'AE'x|| text + Otherwise text = '?' || text + End /* Select token */ + End /* If .. Do */ + + If ^hs Then text = Strip(text,'L') + If meta ^= "" Then data = data || text + Else line = line || text + + 'READTO' + + End /* Do Forever */ + +Call FLUSH + +Exit + +/* ------------------------------------------------------------------ */ +FLUSH: + +w = width - li +Do While Length(line) > w & Index(line,' ') > 0 + p = Lastpos(' ',line,w) + part = Left(line,p-1) + If center Then part = Center(part,width) + If quote Then part = qs || part + If excerpt Then part = xs || part + If li > 0 Then part = Copies(' ',li) || part + 'OUTPUT' part + line = Substr(line,p+1) + End /* Do While */ + +If center Then line = Center(line,width) +If quote Then line = qs || line +If excerpt Then line = xs || line +If li > 0 Then line = Copies(' ',li) || line +If line = "" Then line = " " + +'OUTPUT' line +line = "" + +Return + diff --git a/vmworkshop-vmarcs/1996/mime/uftxread.rexx b/vmworkshop-vmarcs/1996/mime/uftxread.rexx new file mode 100644 index 0000000..6605df9 --- /dev/null +++ b/vmworkshop-vmarcs/1996/mime/uftxread.rexx @@ -0,0 +1,73 @@ +/* + * Name: UFTXREAD REXX + * Pipelines stage to interpret SIFT/UFT jobs + * as extracted from the mailbox + * Author: Rick Troth, Rice University, Information Systems + * Date: 1993-Apr-07 and prior + */ + +pipe = "" +name = "mime.text" + +Do Forever + + 'PEEKTO LINE' + If rc ^= 0 Then Leave + + Parse Upper Var line cmnd . + Select /* cmnd */ + When cmnd = "FILE" Then Parse Var line . size from . + When cmnd = "SIZE" Then Parse Var line . size . + When cmnd = "USER" Then nop + When cmnd = "DATE" Then nop + When cmnd = "TYPE" Then Do + Parse Var line . type . + Select /* type */ + When type = "A" Then pipe = , + 'CHANGE /' || '0D0A'x || '/' || '0A'x || '/' , + '| DEBLOCK LINEND 0A | DROP LAST | A2E' + When type = "E" Then pipe = 'DEBLOCK LINEND 15 | DROP' + When type = "V" Then pipe = 'DEBLOCK CMS' + When type = "N" Then pipe = 'DEBLOCK NETDATA' , + '| LOCATE' '00C000'x '| SPEC 2-* 1' + Otherwise pipe = 'FBLOCK 80' /* binary */ + End /* Select code */ + End /* When .. Do */ + When cmnd = "NAME" Then Parse Var line . name + + When cmnd = "CLASS" Then Parse Var line . class . + When cmnd = "FORM" Then Parse Var line . form . + When cmnd = "DEST" Then Parse Var line . dest . + When cmnd = "DIST" Then Parse Var line . dist . + When cmnd = "FCB" Then Parse Var line . fcb . + When cmnd = "CTAPE" Then Parse Var line . fcb . + When cmnd = "UCS" Then Parse Var line . ucs . + When cmnd = "CHARS" Then Parse Var line . ucs . + When cmnd = "TRAIN" Then Parse Var line . ucs . + + When cmnd = "DATA" Then Leave + Otherwise Say "command/parameter" cmnd "ignored" + End /* Select cmnd */ + + 'READTO' + + End /* Do While */ + +If rc ^= 0 Then Exit rc * (rc ^= 12) + +'READTO' + +If pipe = "" Then 'CALLPIPE *: | > UFTXREAD CMSUT1 A3' + Else 'CALLPIPE *: |' pipe '| > UFTXREAD CMSUT1 A3' + +If Index(name,'"') > 0 Then + Parse Var name . '"' name '"' . +Parse Var name fn '.' ft '.' . +If fn = "" Then Parse Var from fn '.' . '@' . +Push "COMMAND SET FN" fn +Push "COMMAND SET FT" ft +Push "COMMAND SET FM A1" +Address "COMMAND" 'XEDIT UFTXREAD CMSUT1 A3' + +Return rc + diff --git a/vmworkshop-vmarcs/1996/mime/untab.rexx b/vmworkshop-vmarcs/1996/mime/untab.rexx new file mode 100644 index 0000000..3398e6c --- /dev/null +++ b/vmworkshop-vmarcs/1996/mime/untab.rexx @@ -0,0 +1,32 @@ +/* + * Name: EXPAND REXX + * Expand Tab Characters function as a pipeline filter + * This gem can be replaced with UNTAB -8, if available. + * Author: Rick Troth, Rice University, Information Systems + * Date: 1992-Apr-17, Dec-06 + */ + +/* 'CALLPIPE *: | UNTAB -8 | *:' */ + +Do Forever + + 'PEEKTO LINE' + If rc ^= 0 Then Leave + + tabpos = Pos('05'x,line) + Do While tabpos > 0 + line = Substr(line,1,tabpos-1) || , + Copies('40'x,((tabpos+7)%8)*8-tabpos+1) || , + Substr(line,tabpos+1) + tabpos = Pos('05'x,line) + End /* Do While */ + + 'OUTPUT' line + If rc ^= 0 Then Leave + + 'READTO' + + End /* Do While */ + +Exit rc * (rc ^= 12) + diff --git a/vmworkshop-vmarcs/1996/mime/webtext.rexx b/vmworkshop-vmarcs/1996/mime/webtext.rexx new file mode 100644 index 0000000..daf1bdc --- /dev/null +++ b/vmworkshop-vmarcs/1996/mime/webtext.rexx @@ -0,0 +1,178 @@ +/* Copyright 1994, Richard M. Troth <plaintext> + * + * Name: WEBTEXT REXX + * VM TCP/IP Network Client and Server text converter + * Inspired by GOPCLITX, DROPDOTS, and others. + * To be renamed MAKETEXT because it's ubiquitous. + * Author: Rick Troth, Houston, Texas, USA + * Date: 1994-Feb-27, 1994-Oct-15 + * + * Replaces: A2E, E2A, TCPA2E, TCPE2A + */ + +/* ----------------------------------------------------------------- ÆCS + * ASCII to EBCDIC and vice-versa code conversion tables. + * Tables included here are based on ASCII conforming to the ISO8859-1 + * Latin 1 character set and EBCDIC conforming to the IBM Code Page 37 + * Latin 1 character set (except for three pairs of characters in 037). + */ + +Parse Upper Arg mode code . +If mode = "" Then mode = "LOCAL" + + i = '000102030405060708090A0B0C0D0E0F'x + i = i || '101112131415161718191A1B1C1D1E1F'x + i = i || '202122232425262728292A2B2C2D2E2F'x + i = i || '303132333435363738393A3B3C3D3E3F'x + i = i || '404142434445464748494A4B4C4D4E4F'x + i = i || '505152535455565758595A5B5C5D5E5F'x + i = i || '606162636465666768696A6B6C6D6E6F'x + i = i || '707172737475767778797A7B7C7D7E7F'x + i = i || '808182838485868788898A8B8C8D8E8F'x + i = i || '909192939495969798999A9B9C9D9E9F'x + i = i || 'A0A1A2A3A4A5A6A7A8A9AAABACADAEAF'x + i = i || 'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF'x + i = i || 'C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF'x + i = i || 'D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF'x + i = i || 'E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF'x + i = i || 'F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF'x + +If code ^= "" Then Do + 'CALLPIPE DISK' code 'TCPXLBIN | STEM XLT.' + If rc ^= 0 | xlt.0 < 3 Then code = "" + End /* If .. Do */ + +Select /* mode */ + When Abbrev("LOCAL",mode,3) Then Call LOCAL + When Abbrev("LCL",mode,3) Then Call LOCAL + When Abbrev("NETWORK",mode,3) Then Call NETWORK + When Abbrev("DOTTED",mode,3) Then Call DOTTED + Otherwise Do + Address "COMMAND" 'XMITMSG 3 MODE (ERRMSG' + rc = 24 + End /* Otherwise Do */ + End /* Select mode */ + +Exit rc * (rc ^= 12) + + +/* --------------------------------------------------------------- LOCAL + * Input: raw ASCII text + * Output: plain (EBCDIC) text + */ +LOCAL: + +'ADDPIPE *.OUTPUT: | STRIP TRAILING 0D | PAD 1 | *.OUTPUT:' +If rc ^= 0 Then Return + +If code = "" Then Do /* use the standard table */ + e = '00010203372D2E2F1605250B0C0D0E0F'x + e = e || '101112133C3D322618193F271C1D1E1F'x + e = e || '405A7F7B5B6C507D4D5D5C4E6B604B61'x + e = e || 'F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F'x + e = e || '7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6'x + e = e || 'D7D8D9E2E3E4E5E6E7E8E9ADE0BD5F6D'x + e = e || '79818283848586878889919293949596'x + e = e || '979899A2A3A4A5A6A7A8A9C04FD0A107'x + e = e || '202122232415061728292A2B2C090A1B'x + e = e || '30311A333435360838393A3B04143EFF'x + e = e || '41AA4AB19FB26AB5BBB49A8AB0CAAFBC'x + e = e || '908FEAFABEA0B6B39DDA9B8BB7B8B9AB'x + e = e || '6465626663679E687471727378757677'x + e = e || 'AC69EDEEEBEFECBF80FDFEFBFCBAAE59'x + e = e || '4445424643479C485451525358555657'x + e = e || '8C49CDCECBCFCCE170DDDEDBDC8D8EDF'x + End /* If .. Do */ +Else e = xlt.2 + +buff = "" +Do Forever + + 'PEEKTO DATA' + If rc ^= 0 Then Leave + + buff = buff || data + Do While Index(buff,'0A'x) > 0 + Parse Var buff line '0A'x buff + 'OUTPUT' Translate(line,e,i) + If rc ^= 0 Then Leave + End /* Do While */ + If rc ^= 0 Then Leave + + 'READTO' + If rc ^= 0 Then Leave + + End /* Do Forever */ + +If buff ^= "" Then 'OUTPUT' Translate(buff,e,i) + +Return + + +/* ------------------------------------------------------------- NETWORK + * Input: plain (EBCDIC) text + * Output: raw ASCII byte stream + */ +NETWORK: + +'ADDPIPE *.OUTPUT: | SPEC 1-* 1 x0D0A NEXT | *.OUTPUT:' +If rc ^= 0 Then Return + +If code = "" Then Do /* use the standard table */ + a = '000102039C09867F978D8E0B0C0D0E0F'x + a = a || '101112139D8508871819928F1C1D1E1F'x + a = a || '80818283840A171B88898A8B8C050607'x + a = a || '909116939495960498999A9B14159E1A'x + a = a || '20A0E2E4E0E1E3E5E7F1A22E3C282B7C'x + a = a || '26E9EAEBE8EDEEEFECDF21242A293B5E'x + a = a || '2D2FC2C4C0C1C3C5C7D1A62C255F3E3F'x + a = a || 'F8C9CACBC8CDCECFCC603A2340273D22'x + a = a || 'D8616263646566676869ABBBF0FDFEB1'x + a = a || 'B06A6B6C6D6E6F707172AABAE6B8C6A4'x + a = a || 'B57E737475767778797AA1BFD05BDEAE'x + a = a || 'ACA3A5B7A9A7B6BCBDBEDDA8AF5DB4D7'x + a = a || '7B414243444546474849ADF4F6F2F3F5'x + a = a || '7D4A4B4C4D4E4F505152B9FBFCF9FAFF'x + a = a || '5CF7535455565758595AB2D4D6D2D3D5'x + a = a || '30313233343536373839B3DBDCD9DA9F'x + End /* If .. Do */ +Else a = xlt.3 + +Do Forever + + 'PEEKTO LINE' + If rc ^= 0 Then Leave + + 'OUTPUT' Translate(line,a,i) + If rc ^= 0 Then Leave + + 'READTO' + If rc ^= 0 Then Leave + + End /* Do Forever */ + +Return + + +/* -------------------------------------------------------------- DOTTED + * Input: plain (EBCDIC) text + * Output: ASCII byte stream terminated by CR/LF/./CR/LF + */ +DOTTED: + +Call NETWORK + +'OUTPUT' Translate('.',a,i) + +Return + + +/* + * variables: + * xlt.0 should be "3", meaning three records read + * xlt.1 should be a comment + * xlt.2 should be our ASCII ---> EBCDIC table + * xlt.3 should be our EBCDIC ---> ASCII table + * i is set to the dummy input table + */ + diff --git a/vmworkshop-vmarcs/1996/mime/webume.text b/vmworkshop-vmarcs/1996/mime/webume.text new file mode 100644 index 0000000..6103e85 Binary files /dev/null and b/vmworkshop-vmarcs/1996/mime/webume.text differ diff --git a/vmworkshop-vmarcs/1996/mod210/mod210.info b/vmworkshop-vmarcs/1996/mod210/mod210.info new file mode 100644 index 0000000..d40c913 --- /dev/null +++ b/vmworkshop-vmarcs/1996/mod210/mod210.info @@ -0,0 +1,1407 @@ +Marist 1996 VM Workshop Tools Tape Contribution, CP mods for VM/ESA 2.1.0 + +ADDR Command: +This mod will add a new command to VM/ESA called ADDR. This command will +display information about a "terminal", including its address, devicetype +and other info depending on what kind of device it is. It can be used on all +types of workstations, including SNA devices and logical devices. In the +case of an SNA device, the LU name will be displayed. If it is run on a +logical device, the owner of the device will be displayed. + +The mod consists of a new module, HCPADR and minor changes to HCPCOM, HCPMDLAT +COPY and HCPLDL. The change to HCPCOM to define the new command, ADDR. The +changes to HCPMDLAT COPY and HCPLDL are to add the new module to the system. + +This mod was developed on a VM/XA system, and later ported to VM/ESA. The +current version should run on all levels of VM/ESA ESA feature from 1.1.0 +through 2.1.0. However, future levels shouldn't be a problem either. + +Questions or problems with this mod should be directed to Martha McConaghy, +Marist College, URMM@VM.MARIST.EDU (914) 575-3252. + +FILE: HCPCOM ADDRCMD E1 +./ I 02534991 $ 2535000 100 10/31/89 18:31:26 +************************************************************** ADDRCMD 0582671 +* * ADDRCMD 0583470 +* ADDR COMMAND * ADDRCMD 0584269 +* * ADDRCMD 0585068 +************************************************************** ADDRCMD 0585867 + SPACE , ADDRCMD 0586666 +ADDR DS 0F ADDRCMD 0587465 + COMMD COMMAND=(ADDR,4),FL=CMDALOG+CMDONLY, *05882640 + CLASS=*,EP=HCPADRES ADDRCMD 0589063 + SPACE , ADDRCMD 0589862 + + +FILE: HCPMDLAT ADDRCMD E1 1 +./ I 61920002 $ 61920100 100 10/30/89 10:51:36 + AIF ('&NAME'(1,6) NE 'HCPADR' AND (NOT &HCPLLST) )*31781000 + .EHCPADR ADDRCMD 3178200 + HCPATTRB HCPADR,MODATTR=(PAG,MP,DYN), *31783000 + EP=((HCPADRES,DYN)) ADDRCMD 3178400 + AIF ('&HCPATTRC' EQ '0').MDLATEX IF FOUND, EXIT ADDRCMD 3178500 +.EHCPADR ANOP , ADDRCMD 3178600 +.**************************************************************ADDRCMD 3178000 + +FILE: HCPLDL ADDRCMD E1 +./ * CO-REQ: HCPADR +./ * IF-REQ: NONE +./ * FORCE REASSEMBLY FOR HCPADR MOD FOR HCPMDLAT MACRO + +FILE: HCPADR ASSEMBLE E1 +ADR TITLE 'HCPADR (CP) VM/ESA R 1.0' 00000100 + ISEQ 73,80 VALIDATE SEQUENCING OF INPUT 00000200 + COPY HCPOPTNS 00000300 +HCPADR HCPPROLG ATTR=(PAGEABLE,REENTERABLE),BASE=(R12) 00000400 +* 00000500 +* MODULE NAME - HCPADR 00000600 +* 00000700 +* DESCRIPTIVE NAME - ADDR COMMAND 00000800 +* 00000900 +* STATUS - VM/ESA 1.0 ESA 00001000 +* 00001100 +* FUNCTION - To process the ADDR command. 00001200 +* 00001300 +* NOTES - 00001400 +* 00001500 +* DEPENDENCIES - THIS MODULE REQUIRES THE USE OF THE IBM SYS 00001600 +* 370 - XA SERIES OF PROCESSORS RUNNING IN 370 00001700 +* MODE. 00001800 +* 00001900 +* REGISTER CONVENTIONS - SYMBOLIC REFERENCES TO REGISTERS AR 00002000 +* THE FORM "RX" WHERE X IS A NUMBER R 00002100 +* FROM 0 TO 15. 00002200 +* 00002300 +* MODULE TYPE - PROCEDURE 00002400 +* 00002500 +* PROCESSOR - ASSEMBLER H, VERSION 2 R1 00002600 +* 00002700 +* ATTRIBUTES - REENTRANT, PAGEABLE 00002800 +* 00002900 +* ENTRY POINT - 00003000 +* 00003100 +* HCPADRES - PROCESS THE ADDR COMMAND 00003200 +* 00003300 +* EXTERNAL REFERENCES - 00003400 +* 00003500 +* ROUTINES - 00003600 +* 00003700 +* HCPCVTBH - To convert binary to hex 00003800 +* HCPLDAFE - Fetch the LDD for a logical device LDEV 00003830 +* HCPLDARE - Return LDD to system LDEV 00003860 +* HCPLSOTR - Translate the device number into hex 00003900 +* 00004100 +* DATA AREAS - 00004200 +* ADRMSG - Message response DSECT 00004300 +* 00004400 +* CONTROL BLOCKS - 00004500 +* HCPCSLPL - REQUIRED FOR HCPCONSL MACRO 00004550 +* HCPEQUAT - SYSTEM EQUATES 00004600 +* HCPPFXPG - PREFIX AREA PAGE 00004700 +* HCPRDCBK - REAL DEVICE CHARACTERISTIC BLOCK 00004800 +* HCPRDEV - REAL DEVICE BLOCK 00004900 +* HCPSAVBK - SAVE AREA 00005000 +* HCPSYSCM - SYSTEM COMMON AREA 00005100 +* HCPVMDBK - INVOKER'S VMDBK 00005200 +* 00005300 +* MACROS - 00005400 +* HCPCALL - STANDARD SYSTEM CALLING LINKAGE 00005500 +* HCPCONSL - Write results to the user's console ADCONSL 00005550 +* HCPDROP - RELEASE ADDRESSABILITY 00005600 +* HCPENTER - DEFINITION OF EXECUTABLE ENTRY POINT 00005700 +* HCPEPILG - GENERATE MODULE EPILOG 00005800 +* HCPEXIT - RETURN TO CALLER 00005900 +* HCPGETST - GET FREE STORAGE 00006000 +* HCPRELST - RELEASE FREE STORAGE 00006100 +* HCPUSING - ESTABLISH ADDRESSABILITY 00006200 +* 00006300 +* ABEND CODES - NONE 00006400 +* 00006500 +* RESPONSE - 00006600 +* DEVICE XXXXX ON SYSTEM VVVVVVVV TYPE TTTTTTTT 00006700 +* or LDEV 00006860 +* Device XXXXX on System VVVVVVVV Type TTTTTTTT Owner OOOOOLDEV 00006920 +* for logical devices LDEV 00006980 +* 00007100 +* 00007200 + SPACE 3 00007300 + EXTRN HCPLDAFE Fetch LDD for logical devs LDEV 00007450 + EXTRN HCPLDARE Return LDD for logical devs LDEV 00007500 + EXTRN HCPLSOTR Translate raddr for printing LDEV 00007550 + EXTRN HCPCVTBH Convert binary to ebcdic LDEV 00007600 +* 00007700 + COPY HCPCSLPL Console parameter list LDEV 00007820 + COPY HCPPFXPG Prefix page LDEV 00007890 + COPY HCPSYSCM System common block LDEV 00007960 + COPY HCPSAVBK Save area LDEV 00008030 + COPY HCPEQUAT Common equates LDEV 00008100 + COPY HCPVMDBK VMDBK LDEV 00008170 + COPY HCPRDEV Real Device block LDEV 00008240 + COPY HCPSNABK SNA device block LDEV 00008310 + COPY HCPRDCBK Real dev characteristics block LDEV 00008380 + EJECT 00008600 + HCPUSING PFXPG,0 00008700 + HCPUSING VMDBK,R11 00008800 + HCPUSING SAVBK,R13 00008900 +* 00009000 +HCPADRES HCPENTER CALL,SAVE=DYNAMIC 00009100 +* 00009200 +* Get storage for response buffer and set up text. LDEV 00009250 + LA R0,ADRMSGDL GET SIZE OF RESPONSE 00009300 + HCPGETST LEN=(R0) GET STORAGE BLOCK 00009400 + LR R3,R1 Save address of block LDEV 00009540 + HCPUSING ADRMSG,R3 00009600 + MVI ADRMSG,C' ' CLEAR OUT RESPONSE BUFF 00009700 + MVC ADRMSG1(ADRMSGDL*8-1),ADRMSG 00009800 + MVC TXT1,=C'Device ' Insert text into message LDEV 00009940 + MVC TXT2,=C' on system ' 00010000 + MVC TXT3,=C' type ' 00010100 +* 00010200 +* Now, find the RDEV block and determine if it is a SNA device.LDEV 00010250 + L R8,VMDRTERM GET ADDRESS OF RDEVBLOK 00010300 + HCPUSING RDEV,R8 00010400 + ICM R1,B'1111',RDEVSNA IS THERE A SNABK BLOCK? 00010500 + BNZ SNADEV Yes then get SNA info 00010600 +* LDEV 00010710 +* For non-SNA devices, get raddr and device type. LDEV 00010720 + LA R1,RADDR Set location of buffer LDEV 00010730 + HCPCALL HCPLSOTR GET ADDRESS OF TERMINAL 00010800 + L R7,RDEVRDCA GET DEVICE CHAR BLOCK 00010900 + HCPUSING RDCBK,R7 00011000 + SR R1,R1 CLEAR OUT REG 00011100 + MVC DEVTYP(2),RDCDVID Get device type LDEV 00011240 + LH R1,DEVTYP 00011300 + HCPCALL HCPCVTBH Convert it to EBCDIC LDEV 00011410 + STM R0,R1,DEVTYP Put back in buffer LDEV 00011420 +* LDEV 00011430 +* Determine if we are on a logical device. If so, then LDEV 00011440 +* get the owner of the device too. LDEV 00011450 + L R1,RDEVLSOP Get pointer to LSOBJ LDEV 00011460 + LTR R1,R1 Are we on a LDEV? LDEV 00011470 + BZ SYSTEMID NO, then finish up LDEV 00011480 + LH R1,RDEVDEV Get LDEV number LDEV 00011490 +* The call to HCPLDAFE locks the LDDBK for the logical device.LDEV 00011500 +* It must be released before leaving the module. LDEV 00011510 + HCPCALL HCPLDAFE Fetch LDDBK for device LDEV 00011520 + LTR R15,R15 Did we find one? LDEV 00011530 + BNZ SYSTEMID NO, something's wrong LDEV 00011540 + LR R4,R2 Save VMDBK addr for owner LDEV 00011550 + HCPCALL HCPLDARE Release lock on LDDBK LDEV 00011560 + MVC LOWNER,VMDUSER-VMDBK(R4) Get owner's ID LDEV 00011570 + MVC TXT4,=C' Owner ' LDEV 00011580 + B SYSTEMID 00011600 +* 00011700 +* If user is on a SNA device, set the device type to SNA LDEV 00011730 +* and set address to LU name. LDEV 00011760 +SNADEV L R1,RDEVSNA Get address of SNABK 00011800 + HCPUSING SNABK,R1 00011900 + MVC RADDR,SNALUN Move in the LU name 00012000 + MVC DEVTYP,=C' SNA ' 00012100 + HCPDROP R1 00012200 +* 00012300 +* Finish up by setting the system ID field. LDEV 00012350 +SYSTEMID L R1,PFXSYS 00012400 + HCPUSING SYSCM,R1 00012500 + MVC SYSID,SYSTMID Get system id from SYSCM LDEV 00012640 + HCPDROP R1 00012700 +* 00012800 +* Write the message to the user's console and release the LDEV 00012860 +* storage. LDEV 00012920 +PRTMSG DS 0H ADCONSL 00012990 + HCPCONSL WRITE,DATA=((R3),ADRMSGL) ADCONSL 00013080 + HCPRELST BLOCK=(R3) ADCONSL 00013170 + HCPEXIT EP=(HCPADRES),SETCC=NO 00013400 + EJECT 00013500 +* LDEV 00013530 +* Define block for resulting message. LDEV 00013560 +ADRMSG DSECT 00013600 +TXT1 DS CL8 "DEVICE " LDEV 00013740 +RADDR DS CL8 00013800 +TXT2 DS CL12 " ON SYSTEM " 00013900 +SYSID DS CL8 00014000 +TXT3 DS CL8 " TYPE " 00014100 +DEVTYP DS CL8 00014300 +TXT4 DS CL8 " OWNER " LDEV 00014330 +LOWNER DS CL8 LDEV 00014360 +ADRMSGL EQU (*-ADRMSG) LENGTH OF RESPONSE 00014400 +ADRMSGDL EQU (*-ADRMSG+7)/8 LENGTH OF RES IN DW 00014500 +ADRMSG1 EQU ADRMSG+1 00014600 + EJECT 00014700 +HCPADR CSECT 00014800 + LTORG 00014900 + HCPDROP R3,R7,R8,R11,R13 00015000 + HCPEPILG 00015100 + +******************************************************************************* +Reformat QUERY NAMES command: + +The purpose of this mod is to reformat the output of the QUERY NAMES command. +The results of this command on a vanilla system includes the address of +where the virtual machine is running or 'DSC' for disconnected machines. +On a large system, such as a 9672-R42E, this can generate several screens +worth of data and is confusing to unsophisticated users. This mod removes +the address from the display, and shows 8 virtual machine names on each line. +This greatly decreases the size of the display. + +In addition, this mod adds several new options to the command. The 'ALL' +option shows all virtual machines running on the system, whether they +are connected or not. This is the default. The 'DISCONNECT' option shows +only those machines that are running disconnected, while 'CONNECT' shows +only connected machines. Finally, 'SNA' shows only those machines that +are logged onto the system via a *VSM connection (ie. VTAM or TCPIP). + +The following is an example of how the QUERY NAMES command looks after +this mod: + +query names all + +STSS KMMQ STMQ URCG URBP UICOMM SYS$MMM SYS$DKB +URDB UIHD JZEM MUSICB URLS URMJ KK3R HDPOPR1 +XAMWRITE MUSICC MUSICA SERVDIR HDPCNTRL VMNET MARISTA MARISTC +MARISTB SPSSBAT PRT3820 PDMREM1 PDMGRP3 SFCM RSCS MAILER +LISTSERV SIM3278 SQL2DBA NETSERV RSCSX GCS AUTOLINK OPERSYMP +URMM2 + +query names disconnect + +STSS KMMQ STMQ JZEM MUSICB XAMWRITE MUSICC MUSICA +HDPCNTRL VMNET MARISTA MARISTC MARISTB SPSSBAT PRT3820 PDMREM1 +PDMGRP3 SFCM RSCS MAILER LISTSERV SIM3278 SQL2DBA NETSERV +RSCSX GCS AUTOLINK OPERSYMP + +query names connect + +URCG URBP UICOMM SYS$MMM SYS$DKB URDB UIHD URLS +URMJ KK3R HDPOPR1 SERVDIR URMM2 + +query names sna + +VSM - VTAM +URCG -LM020B2A +VSM - TCPIPA +VSM - TCPIPB +VSM - TCPIP +VSM - TCPIPC + +The mod contained in this file is running on VM/ESA ESA 1.0. +Problems, questions or comments should be sent to the mod developer, +Martha McConaghy URMM@MARIST (BITNET) or URMM@VM.MARIST.EDU (Internet) +Senior VM Systems Programmer +Marist College +Poughkeepsie, NY 12601 +(914) 575-3252 +6/24/96 + +FILE: HCPCQU QNAMES E1 +./ R 02540001 $ 2544991 4990 02/15/96 10:54:59 +* 2. PLACE FIELD IN BUFFER EIGHT TO A LINE. * QNAMES 02544991 +./ R 02612401 02616001 $ 2612691 290 02/15/96 10:54:59 +* +----------+--------------------+ * QNAMES 02612691 +* | QUERY | NAMES <ALL> | * QNAMES 02612981 +* | QUERY | <DISCONN> | * QNAMES 02613271 +* | QUERY | <CONNECT> | * QNAMES 02613561 +* | QUERY | <SNA> | * QNAMES 02613851 +* +----------+--------------------+ * QNAMES 02614141 +* ALL - PRINTS ALL CONNECTED AND DISCONNECTED USERS * QNAMES 02614431 +* DISCONN- PRINTS ONLY DISCONNECTED USERS * QNAMES 02614721 +* CONNECT- PRINTS ONLY CONNECTED USERS * QNAMES 02615011 +* SNA - PRINTS ALL SNA USERS W/LUNAMES * QNAMES 02615301 +* * QNAMES 02615591 +./ R 02640001 02660001 $ 2646991 6990 02/15/96 10:54:59 +* USERID USERID USERID USERID USERID USERID USERID USERID * QNAMES 02646991 +* ... * QNAMES 02653981 +* - * QNAMES 02660971 +./ I 02930001 $ 2932001 2000 02/15/96 10:54:59 + LA R0,1(0) GET BLOCK FOR QNAMOP QNAMES 02932001 + HCPGETST LEN=(R0) QNAMES 02934001 + LR R9,R1 QNAMES 02936001 + HCPUSING QNAMOP,R9 QNAMES 02938001 +./ R 02942001 02960001 $ 2942991 990 02/15/96 10:54:59 + BNZ SETDEF NO OPERANDS? SET TO 'ALL' QNAMES 02942991 + LR R6,R0 SAVE LENGTH QNAMES 02943981 + BCTR R6,0 QNAMES 02944971 +* CHECK OPERANDS QNAMES 02945961 + EX R6,CLCALL QNAMES 02946951 + BE SETDEF QNAMES 02947941 + EX R6,CLCDISC QUERY DISCONNECTED USERS? QNAMES 02948931 + BNE CONNECT NO, NEXT ONE QNAMES 02949921 + MVI QNAMFLG,QDISC SET DISCONNECT FLAG QNAMES 02950911 + B QRYSTRT GO DO IT QNAMES 02951901 +CONNECT EX R6,CLCCONN QUERY CONNECTED USERS? QNAMES 02952891 + BNE SNAUSRS NO, NEXT ONE QNAMES 02953881 + MVI QNAMFLG,QCONN SET CONNECT FLAG QNAMES 02954871 + B QRYSTRT GO DO IT QNAMES 02955861 +SNAUSRS EX R6,CLCSNA QUERY SNA USERS? QNAMES 02956851 + BNE SETDEF NO, THEN DO ALL ANYWAY QNAMES 02957841 + MVI QNAMFLG,QSNA SET SNA FLAG QNAMES 02958831 + B QRYSTRT GO DO IT QNAMES 02959821 +SETDEF MVI QNAMFLG,QALL SET ALL FLAG QNAMES 02960811 +QRYSTRT DS 0H QNAMES 02961801 +./ I 04180001 $ 4183001 3000 02/15/96 10:54:59 + TM QNAMFLG,QSNA DISPLAY SNA USERS QNAMES 04183001 + BO QRYSNA QNAMES 04186001 +./ R 04310001 04320001 $ 4314991 4990 02/15/96 10:54:59 + BZ CHKDISC NO, SO THIS IS A NON-SNA USER QNAMES 04314991 + TM VMDOSTAT,VMDDISC QNAMES 04319981 + BO CHKDISC QNAMES 04324971 +./ R 04350001 $ 4354991 4990 02/15/96 10:54:59 + BZ CHKCONN NO, SO THIS IS A NON-SNA USER QNAMES 04354991 +./ R 04370001 04380001 $ 4375991 5990 02/15/96 10:54:59 + BNE CHKCONN NOPE - REGULAR Q NAMES QNAMES 04375991 +DONXT C R10,VMDORIG-VMDBK(,R11) END IF UNDER SYS VMDBK QNAMES 04381981 +./ R 04430001 04480001 $ 4437991 7990 02/15/96 10:54:59 +*QRYNISF1 DS 0H QNAMES 04437991 +* CL R10,VMDORIG-VMDBK(,R11) BACK TO START? QNAMES 04445981 +* BE QRYMSGL YES - GO STACK GSDBK AND GET SNA QNAMES 04453971 +* PART OF THE RESPONSE QNAMES 04461961 +* L R10,VMDCYCLE LOAD NEXT VMDBK ADDRESS QNAMES 04469951 +* B QRYCONT CHECK IF THIS IS A NON-SNA USER QNAMES 04477941 +./ I 04500001 $ 4500901 900 02/15/96 10:54:59 +CHKDISC TM QNAMFLG,QALL CHECK FOR 'ALL' OR 'DISC' QNAMES 04500901 + BO QRYGETID QNAMES 04501801 + TM QNAMFLG,QDISC QNAMES 04502701 + BO QRYGETID QNAMES 04503601 + B DONXT QNAMES 04504501 +CHKCONN TM QNAMFLG,QALL CHECK FOR 'ALL' OR 'CONN' QNAMES 04505401 + BO QRYGETID QNAMES 04506301 + TM QNAMFLG,QCONN QNAMES 04507201 + BO QRYGETID QNAMES 04508101 + B DONXT QNAMES 04509001 +./ R 04620001 $ 4620991 990 02/15/96 10:54:59 + CLC VMDUSER(4),=C'LOGN' IS IT A PRE-LOGON? QNAMES 04620991 + BE QRYGTID3 YES, THEN GET NEXT USERID QNAMES 04621981 + CLC VMDUSER(4),=C'LOGL' IS IT A PRE-LOGON? QNAMES 04622971 + BE QRYGTID3 QNAMES 04623961 + CLC VMDUSER(4),=C'LOGV' IS IT A SNA PRELOGON? QNAMES + BE QRYGTID3 QNAMES + MVC 0(L'VMDUSER,R6),VMDUSER GET USERID QNAMES 04624951 +./ R 04810001 04830001 $ 4816991 6990 02/15/96 10:54:59 +* BZ QYGTID2A LOCAL OR LOGICAL IS OK. QNAMES 04816991 +* CL R10,VMDORIG-VMDBK(,R11) BACK TO START? QNAMES 04823981 +* BE QRYMSGL YES - GO STACK GSDBK AND GET SNA *04830971 +./ R 04990001 05000001 $ 4995991 5990 02/15/96 10:54:59 + MVI L'VMDUSER(R6),C' ' SPACE OVER QNAMES 04995991 + LA R6,9(R6) BUMP TO NEXT SEGMENT QNAMES 05001981 +./ R 05210001 $ 5212991 2990 02/15/96 10:54:59 + TM QNAMFLG,QSNA DISPLAY SNA USERS? QNAMES 05212991 + BNO QRYEXIT GET SNA PART OF THE RESPONSE QNAMES 05215981 +./ I 05250001 $ 5252001 2000 02/15/96 10:54:59 + TM QNAMFLG,QSNA DISPLAY SNA USERS? QNAMES 05252001 + BO QRYSNA GET SNA PART OF RESPONSE QNAMES 05254001 + HCPRELST BLOCK=(R9) QNAMES 05256001 + B QRYEXIT QNAMES 05258001 +./ I 05260001 $ 5265001 5000 02/15/96 10:54:59 + HCPDROP R9 QNAMES 05265001 +./ I 05370001 $ 5371001 1000 02/15/96 10:54:59 + HCPRELST BLOCK=(R9) QNAMES 05371001 +./ I 05930001 $ 5935001 5000 02/15/96 10:54:59 + HCPUSING NRESP,R6 QNAMES 05935001 +./ I 06340001 $ 6342001 2000 02/15/96 10:54:59 +CLCALL CLC 0(*-*,R1),=C'ALL ' QNAMES 06342001 +CLCDISC CLC 0(*-*,R1),=C'DISCONN ' QNAMES 06344001 +CLCCONN CLC 0(*-*,R1),=C'CONNECT ' QNAMES 06346001 +CLCSNA CLC 0(*-*,R1),=C'SNA ' QNAMES 06348001 +./ R 15680001 $ 15684991 4990 02/15/96 10:54:59 +QRYNCNT EQU 8 8 QUERY NAMES PER LINE QNAMES 15684991 +./ I 16290001 $ 16290801 800 02/15/96 10:54:59 +************************************************************ QNAMES 16290801 +* DSECT FOR DETERMINING TYPE OF Q NAMES OPERANDS * QNAMES 16291601 +************************************************************ QNAMES 16292401 + SPACE 2 QNAMES 16293201 +QNAMOP DSECT QNAMES 16294001 +QNAMFLG DS X OPERAND FLAG QNAMES 16294801 +QALL EQU X'0F' PRINT ALL OF THE USERS QNAMES 16295601 +QDISC EQU X'08' PRINT ONLY DISCONNECT USERS QNAMES 16296401 +QCONN EQU X'04' PRINT ONLY CONNECT USERS QNAMES 16297201 +QSNA EQU X'82' PRINT ONLY SNA USERS QNAMES 16298001 + EJECT QNAMES 16298801 + +***************************************************************************** +Secure QUERY NAMES command: + +This mod implements a more 'secure' version of the QUERY NAMES command. +It allows you to hide certain virtual machines from view in the results +of the QUERY NAMES. It does this by defining a new OPTION in the directory, +SECURE. When the QUERY NAMES command is processed, it will not display the +names of virtual machines with the SECURE option, unless the invoker +has class A, C or E. + +This mod has two benefits. First, the less curious students see, the better. +This is obviously not a foolproof security system and is not meant to prevent +hackers from breaking into a guest machine. However, it also does not present +them with temptation. The addition of the SECURE option also implies other +future possibilities. For example, the 'QUERY vmname' command could be +modified to respect the option. + +A second, unexpected benefit was to 'clean up' the QUERY NAMES display. +Normal, class G users, such as our students, use the QUERY NAMES to see if +they friends are online. This is made difficult when the results include +dozens of service machines, guest systems, etc. By using the SECURE option, +the general users see only a list of other users or service machines to +which they have access, ie. LISTSERV, etc. We have had very positive +feedback on this from our users. + +This mod consists of two parts. First, it adds the SECURE parameter to +the OPTION record in the directory. Along with this, it utilizes one of +the installation flags in the VMDBLK to indicate that the SECURE option +is on. The second part of the mod, modifies the QUERY NAMES command to +skip those machines who have SECURE on. This part of the mod is dependent +on another Marist mod, QNAMES, which reformats the results of the +QUERY NAMES command. However, the code could be rewritten to work on +a vanilla version of HCPCQU. + +This mod was developed on VM/ESA ESA 1.0 service level 9202. This level +was modified to run on VM/ESA 2.1.0. Questions +or problems with it should be directed to the author, + +Martha McConaghy URMM@MARIST or URMM@VM.MARIST.EDU +Senior VM Systems Programmer +Marist College +Poughkeepsie, NY 12601 +(914) 575-3252 +6/24/96 + + +Moduled changed: HCPCQU + HCPDIR + HCPLGN + +Copy blocks changed: HCPVMDBK + HCPDVMD + + + +FILE: HCPDIR SECQNAM E1 +./ R 54601954 $ 54602000 50 02/14/92 11:14:45 +OPTLEN3C DS 0H LENGTH IS AT LEAST 3 SECQNAM 10339100 + SPACE 1 SECQNAM 10339110 + COMP =C'SECURE ',SCOPTCMP IS IT 'SECURE'? SECQNAM 10339120 + BNE OPTLEN3D NO, CHECK NEXT OPTION SECQNAM 10339130 + SPACE 1 SECQNAM 10339140 + OI DVMDMARS,DVMDSEC TURN ON SECURE FLAG BIT SECQNAM 10339150 + B OPTGET Go scan for the next option SECQNAM 10339160 + SPACE 1 SECQNAM 10339170 +OPTLEN3D DS 0H SECQNAM 10339180 + +FILE: HCPDVMD SECQNAM E1 +./ R 02610002 $ 2611000 100 05/13/94 10:41:29 +* DS X RESERVED FOR FUTURE IBM USE SECQNAM 01730001 +DVMDMARS DS 1X USE FOR MARIST FLAGS SECQNAM +DVMDSEC EQU X'01' MARIST SECURE OPTION IS ON SECQNAM + +FILE: HCPVMDBK SECQNAM E1 +./ R 23620002 $ 23621000 100 05/13/94 10:37:17 +*MDUSER3 DS F RESERVED FOR INSTALLATION USE SECQNAM 22340001 +VMDMARFL DS X MARIST FLAGS SECQNAM +VMDSECUR EQU X'01' INDICATE SECURE USER SECQNAM +VMDUSER3 DS 3X PLACE HOLDER FOR REST OF SPACE SECQNAM + +FILE: HCPLGN SECQNAM E1 +./ R 07730001 $ 7730100 100 02/14/92 11:16:31 + BNO LGNSETSC BRANCH IF NOT SECQNAM 08048300 +./ I 07740001 $ 7740100 100 02/14/92 11:16:31 +LGNSETSC DS 0H SECQNAM 08048890 + TM DVMDMARS,DVMDSEC IS SECURE OPTION SPECIFIED?SECQNAM 08048900 + BNO LGNSETOR Branch if not SECQNAM 08048910 + OI VMDMARFL,VMDSECUR SET SECURE BIT IN VMDBK SECQNAM 08048920 + +FILE: HCPCQU SECQNAM E1 +./ R 03760001 $ 3760100 100 09/25/90 17:10:15 +* DETERMINE IF THIS IS A PRIVILEDGED USER - CLASS A, C SECQNAM 02420890 +* OR E CAN SEE ALL USERS, REGARDLESS OF VMDSECUR FLAG SECQNAM 02421780 + TM VMDPCLB0,CLASSA IS THIS A CLASS A USER? SECQNAM 02422670 + BO SETSECR YES, SET SECURITY FLAG SECQNAM 02423560 + TM VMDPCLB0,CLASSC IS THIS A CLASS C USER? SECQNAM 02424450 + BO SETSECR YES, SET SECURITY FLAG SECQNAM 02425340 + TM VMDPCLB1,CLASSO IS THIS A CLASS O USER? SECQNAM 02424450 + BO SETSECR YES, SET SECURITY FLAG SECQNAM 02425340 + TM VMDPCLB0,CLASSE IS THIS A CLASS E USER? SECQNAM 02426230 + BNO DOQRY NO, THEN GO ON WITH IT SECQNAM 02427120 +SETSECR OI QNAMFLG,QSECUR SET SECURITY FLAG ON SECQNAM 02428010 +DOQRY L R10,VMDORIG-VMDBK(,R11) FIRST VMDBK SECQNAM 02428900 +./ R 04300001 $ 4300100 100 09/25/90 17:10:15 + TM VMDMARFL,VMDSECUR IS THIS A SECURE ACCOUNT? SECQNAM 02546590 + BNO DOITNOW NOPE, THEN DISPLAY IT SECQNAM 02546680 + TM QNAMFLG,QSECUR ARE WE PRIVILEDGED? SECQNAM 02546770 + BNO DONXT THEN SKIP IT. SECQNAM 02546860 +DOITNOW ICM R8,B'1111',VMDRTERM IS THERE AN RDEV? SECQNAM 02546950 +./ R 16298001 $ 16298100 100 09/25/90 17:10:15 +QSNA EQU X'12' PRINT ONLY SNA USERS SECQNAM 10478190 +QSECUR EQU X'80' QUERY SECURE USERS SECQNAM 10478380 + +****************************************************************************** + +Set FROM command: + + Modules affected: HCPFRM, HCPMSG, HCPQUY, HCPSET, HCPSFV, + HCPLDL, HCPMDLAT MACRO, HCPVMDBK COPY + This mod creates the SET and QUERY FROM commands. It creates + a field in the VMDBK from the VMDUSERx fields, which will hold + an 8 character text string. This string is created by the + SET FROM command and can be displayed using QUERY FROM. The + mod also changes spooling and message processing to make use + of this field when spooling a file to another vm or sending + a message. Essentially, this mod allows a privileged user to + "fake" their userid when sending a file, or message. + + This mod was developed for VM/XA and the current version will + on VM/ESA 2.1.0. Martha McConaghy 6/24/96 + +FILE: HCPSET FROMCMD E1 +./ I 04010001 $ 4010100 100 03/07/90 15:59:45 +************************************************************ FROMCMD 00396500 +* * FROMCMD 00396550 +* SET FROM COMMAND * FROMCMD 00396600 +* * FROMCMD 00396650 +************************************************************ FROMCMD 00396700 + SPACE , FROMCMD 00396750 + COMMD COMMAND=(FROM,4),EP=HCPFRMST,IBMCLASS=A, *00395450 + CLASS=B FROMCMD 00396800 + SPACE , FROMCMD 00396850 + COMMD COMMAND=(FROM,4),EP=HCPFRMST,IBMCLASS=B, *00395450 + CLASS=B FROMCMD 00396800 + SPACE , FROMCMD 00396850 + COMMD COMMAND=(FROM,4),EP=HCPFRMST,IBMCLASS=C, *00395450 + CLASS=C FROMCMD 00396800 + SPACE , FROMCMD 00396850 + +FILE: HCPQUY FROMCMD E1 +./ I 06369991 $ 6370100 100 03/07/90 15:55:16 +************************************************************ FROMCMD 00524220 +* * FROMCMD 00524290 +* QUERY FROM COMMAND * FROMCMD 00524360 +* * FROMCMD 00524430 +************************************************************ FROMCMD 00524500 + SPACE , FROMCMD 00524570 + COMMD COMMAND=(FROM,4),EP=HCPFRMQU, *00524640 + CLASS=A,IBMCLASS=A FROMCMD 00524710 + COMMD COMMAND=(FROM,4),EP=HCPFRMQU, *00524780 + CLASS=B,IBMCLASS=B FROMCMD 00524850 + COMMD COMMAND=(FROM,4),EP=HCPFRMQU, *00524920 + CLASS=C,IBMCLASS=C FROMCMD 00524990 + +FILE: HCPMSU FROMCMD E1 +./ I 00845980 $ 846980 1000 05/08/94 15:35:24 + COPY HCPVMDBK FROMCMD 00846980 +./ I 02370000 $ 2371000 1000 05/08/94 15:35:24 +* Marist Comments: FROMCMD +* FROMCMD +* 5/8/94: Modifications to support the FROM command have FROMCMD +* been added by Martha McConaghy. This mod will FROMCMD +* zap the userid portion of the message header FROMCMD +* if a FROM value has been set using the SET FROMCMD +* FROM command. FROMCMD +* FROMCMD +./ R 02480000 02560000 $ 2485990 5990 05/08/94 15:35:24 + HCPUSING VMDBK,R11 FROMCMD 02486990 + HCPUSING MSGPLIST,R1 FROMCMD 02493980 + CLI VMDFROM,C' ' Check if From is on? FROMCMD 02500970 + BE LEAVEIT No, then bye. FROMCMD 02507960 + CLI VMDFROM,X'00' Check this one too.. FROMCMD 02514950 + BE LEAVEIT No, bye. FROMCMD 02521940 +* SMSG and MSGNOH have no header field, so there is nothing FROMCMD +* to zap. Therefore, exit if its either of those two types. FROMCMD + L R2,MSGTYPPT Now, check type of message FROMCMD 02528930 + CLI 0(R2),MESSAGE Is it a message? FROMCMD 02535920 + BE SETFROM Good, zap it. FROMCMD 02542910 + CLI 0(R2),WARNING Is it a warning? FROMCMD 02549900 + BE SETFROM Zap that too. FROMCMD 02556890 +./ R 02586990 $ 2590980 3990 05/08/94 15:35:24 +LEAVEIT SLR R15,R15 SET RETURN CODE OF 0 FROMCMD 02590980 +./ I 02603940 $ 2604040 100 05/08/94 15:35:24 +SETFROM DS 0H FROMCMD 02604040 +* Zap the "from" part of the message header with our FROMCMD +* version of "from". FROMCMD + L R2,MSGTXTPT Get pointer to pointer FROMCMD 02604140 + L R3,0(R2) Get pointer to actual text FROMCMD 02604240 + MVC 12(8,R3),VMDFROM Overlay USERID with from txt FROMCMD 02604340 + B LEAVEIT All done here FROMCMD 02604440 +./ R 02605920 $ 2606310 390 05/08/94 15:35:24 + HCPDROP R1,R11,R13 FROMCMD 02606310 +./ I 02612850 $ 2612950 100 05/08/94 15:35:24 +* These equates map the message type flag in the Plist FROMCMD +* pointed to by MSGTYPPT. See comments in beginning of FROMCMD +* module for definitions. FROMCMD +MESSAGE EQU X'80' FROMCMD 02612950 +MSGNOH EQU X'40' FROMCMD 02613050 +SMSG EQU X'20' FROMCMD 02613150 +WARNING EQU X'10' FROMCMD 02613250 +./ I 02620000 $ 2620900 900 05/08/94 15:35:24 +* The following DSECT maps the Plist passed to this module FROMCMD +* in R1. The descriptions of each pointer in the Plist are FROMCMD +* located at the beginning of this module. FROMCMD +MSGPLIST DSECT FROMCMD 02621000 +MSGCTLPT DS 1F Ptr to delivery control flags FROMCMD 02622000 +MSGTYPPT DS 1F Ptr to message type flag and class FROMCMD 02623000 +MSGISSPT DS 1F Ptr to Issuer userid, reference only FROMCMD 02624000 +MSGLENPT DS 1F Ptr to length of message FROMCMD 02625000 +MSGTXTPT DS 1F Ptr to Ptr to message text FROMCMD 02626000 +MSGRECPT DS 1F Ptr to userid of message FROMCMD 02627000 +MSGHLNPT DS 1F Ptr to length of header FROMCMD 02628000 + +FILE: HCPSFV FROMCMD E1 +./ I 04010000 $ 4010900 900 11/06/89 13:24:22 +* FROMCMD 04010900 +* TEST FOR VMDFROM FLAG - SET FROM USERID FROMCMD 04011800 +* FROMCMD 04012700 + LTR R8,R8 IS THERE AN ALTERNATE USER? FROMCMD 04013600 + BNZ NOFRMSET YES, THEN FORGET IT FROMCMD 04014500 + CLI VMDFROM-VMDBK(R15),X'00' IS FROM SET? FROMCMD 04015400 + BE NOFRMSET FROMCMD 04016300 + CLI VMDFROM-VMDBK(R15),C' ' IS FROM SET? FROMCMD 04017200 + BE NOFRMSET FROMCMD 04018100 + MVC SPFORIG,VMDFROM-VMDBK(R15) FROMCMD 04019000 +./ R 04030000 $ 4034990 4990 11/06/89 13:24:22 +NOFRMSET LA R4,SPFOPUN ASSUME PUNCH IS CREATING FROMCMD 04034990 + +FILE: HCPLDL FROMCMD E1 +./ * CO-REQ: HCPADR +./ * IF-REQ: NONE +./ * FORCE REASSEMBLY FOR HCPFRM MOD FOR HCPMDLAT MACRO + +FILE: HCPMDLAT FROMCMD E1 +./ I 66830002 $ 66830100 100 11/05/89 16:15:53 + AIF ('&NAME'(1,6) NE 'HCPFRM' AND (NOT &HCPLLST) )*27692200 + .EHCPFRM FROMCMD 27692400 + HCPATTRB HCPFRM,MODATTR=(PAG,MP,DYN), *27692600 + EP=((HCPFRMST,DYN),(HCPFRMQU,DYN)) FROMCMD 27692800 + AIF ('&HCPATTRC' EQ '0').MDLATEX IF FOUND, EXIT FROMCMD 27693000 +.EHCPFRM ANOP , FROMCMD 27693200 +.**************************************************************FROMCMD 27693400 + +FILE: HCPVMDBK FROMCMD E1 +./ R 23600002 23610002 $ 23611000 100 02/12/92 15:01:54 +*MDUSER1 DS F RESERVED FOR INSTALLATION USE FROMCMD 18114990 +*MDUSER2 DS F RESERVED FOR INSTALLATION USE FROMCMD 18119980 +VMDFROM DS 2F FROM FLAG WAS VMDUSER1 AND 2 FROMCMD 18124970 + +FILE: HCPFRM ASSEMBLE E1 +FRM TITLE 'HCPFRM (CP) VM/XA SP 2' SPR3 00001000 + ISEQ 73,80 VALIDATE SEQUENCING OF INPUT 00011000 + COPY HCPOPTNS 00021000 +HCPFRM HCPPROLG ATTR=(PAGEABLE,REENTERABLE),BASE=(R12) 00031000 +*. 00041000 +* MODULE NAME - 00051000 +* 00061000 +* DMKFRM 00071000 +* 00081000 +* FUNCTION - 00091000 +* 00101000 +* TO PROCESS THE FOLLOWING USER-WRITTEN SET COMMAND 00111000 +* FUNCTIONS: 00121000 +* 00131000 +* SET FROM 00141000 +* QUERY FROM 00151000 +* 00161000 +* ATTRIBUTES - 00171000 +* 00181000 +* REENTRANT, PAGEABLE, CALLED VIA SVC 00191000 +* 00201000 +* ENTRY POINTS - 00211000 +* 00221000 +* HCPFRMST - PROCESS SET FROM COMMAND 00231000 +* HCPFRMQU - PROCESS QUERY FROM COMMAND 00241000 +* 00251000 +* ENTRY CONDITIONS - 00261000 +* 00271000 +* R0, R1, R2, R3 - WORK 00281000 +* R4, R5 - USED IN STACK 00291000 +* R6 - FUNCTION INDEX,VMDBK ANCHOR 00301000 +* R7 - QUERY PARM ADDR 00311000 +* R8 - QUERY PARM LENGTH 00321000 +* R11 - VMDBK ADDRESS 00331000 +* R12 - ENTRY POINT ADDRESS 00341000 +* R13 - SAVEAREA ADDRESS 00351000 +* 00361000 +* EXIT CONDITIONS - 00371000 +* 00381000 +* NORMAL - R2 = 0 00391000 +* ERROR - R2 = ERROR MESSAGE CODE NUMBER 00401000 +* 00411000 +* CALLS TO OTHER ROUTINES - 00421000 +* 00431000 +* HCPSCCFD - FIND NEXT ENTRY IN INPUT BUFFER 00451000 +* 00461000 +* EXTERNAL REFERENCES - 00471000 +* 00481000 +* TABLES/WORKAREAS - 00491000 +* 00501000 +* SAVBK WORK AREAS USED FOR SCRATCH DATA 00511000 +* VMDBK The VMDBK for the caller. CONSOLE 00512000 +* CONSOLE 00513000 +* MACROS - CONSOLE 00514000 +* CONSOLE 00515000 +* HCPCONSL WRITE TO USER'S TERMINAL CONSOLE 00516000 +* 00521000 +* REGISTER USAGE - 00531000 +* 00541000 +* R0 - Work CONSOLE 00556990 +* R1 - Work CONSOLE 00562980 +* R2 - PARAMETER PASSING 00571000 +* R3 - Length of message CONSOLE 00586990 +* R4 - Address of message block CONSOLE 00592980 +* R5-R10 - Work CONSOLE 00598970 +* R11 - VMDBLOK ADDRESS CONSOLE 00604960 +* R12 - BASE REGISTER 00611000 +* R13 - SAVEAREA ADDRESS 00621000 +* R14 - LINKAGE REGISTER 00631000 +* R15 - LINKAGE REGISTER 00641000 +* 00651000 +* 00661000 +* NOTES - 00671000 +* 00681000 +* THE OPERATION OF EACH SET FUNCTION IS DESCRIBED IN ITS 00691000 +* INDIVIDUAL PROLOGUE BELOW. 00701000 +* 00711000 +*. 00721000 + EJECT 00731000 + EXTRN HCPSCCFD 00751000 + EJECT 00761000 + PUNCH 'SPB' FORCE PAGE BOUNDARY ALIGNMENT 00771000 + SPACE 3 00781000 +* HCPCSLPL is required for the HCPCONSL macro CONSOLE 00795990 + COPY HCPCSLPL console parm list CONSOLE 00800980 + COPY HCPEQUAT commonly used equates CONSOLE 00805970 + COPY HCPPFXPG prefix page, needed by macros CONSOLE 00810960 + COPY HCPSAVBK module save area block CONSOLE 00815950 + COPY HCPVMDBK VM data blocks CONSOLE 00820940 +* 00831000 + HCPUSING VMDBK,R11 00851000 + HCPUSING PFXPG,R0 CONSOLE 00856000 + HCPUSING SAVBK,R13 00861000 + SPACE 3 00871000 + EJECT 00881000 +*. 00891000 +* FUNCTION - 00901000 +* 00911000 +* SET FROM 00921000 +* 00931000 +* COMMAND FORMAT - 00941000 +* 00951000 +* CLASS A, B, OR C 00961000 +* 00971000 +* +-------+-----------------+ 00981000 +* | SET | FROM XXXXXXXX | 00991000 +* +-------+-----------------+ 01001000 +* 01011000 +* OPERATION - 01021000 +* 01031000 +FILE: HCPFRM ASSEMBLE E1 VM/ESA 3 +* 1. CALL DMKSCCFD TO LOCATE THE USERID. IF NO USERID 01041000 +* FOUND, BLANK OUT VMDFROM 01051000 +* 2. MOVE THE PARAMETER TO THE VMDBK. 01061000 +* 3. ISSUE THE 'COMMAND COMPLETE' MESSAGE AND EXIT. 01071000 +* 01081000 +* RESPONSES - 01091000 +* 01101000 +* COMMAND COMPLETE 01111000 +* 01121000 +* ERROR MESSAGES - 01131000 +* 01141000 +* DMKFRM002E INVALID OPERAND 01151000 +* 01161000 +*. 01171000 + EJECT 01181000 +HCPFRMST HCPENTER CALL,SAVE=DYNAMIC FROM 01191000 + MVC SETFROM,BLANKS Initialize save area CONSOLE 01207990 + CALL HCPSCCFD Scan for FROM parameter CONSOLE 01214980 + BNZ CLRFRM No parm? Then set to blanks CONSOLE 01221970 + CL R0,EIGHT Is the parm length too long? CONSOLE 01228960 + BH FRM002 Yes, then give error CONSOLE 01235950 + LR R2,R0 Get length CONSOLE 01242940 + BCTR R2,0 less 1 for execute CONSOLE 01249930 + EX R2,FROMSAVE Store FROM parameter CONSOLE 01256920 +* CONSOLE 01263910 +* To get rid of previous FROM value, reset field CONSOLE 01270900 +* to blanks. Blanks are the same as no FROM being set. CONSOLE 01277890 +CLRFRM DS 0H 01291000 + MVC VMDFROM(8),SETFROM Move FROM value to VMDBK CONSOLE 01310990 + B FRMCOMSG All done, then leave. CONSOLE 01320980 +*. 01351000 +* FUNCTION - 01361000 +* 01371000 +* QUERY FROM 01381000 +* 01391000 +* COMMAND FORMAT - 01401000 +* 01411000 +* CLASS A, B, OR C 01421000 +* 01431000 +* +-------+--------+ 01441000 +* | QUERY | FROM | 01451000 +* +-------+--------+-----+ 01461000 +* | QUERY | FROM USERID | 01471000 +* +-------+--------------+ 01481000 +* 01491000 +* OPERATION - 01501000 +* 01511000 +* 1. PRINT THE MESSAGE AND EXIT 01521000 +* 01531000 +* RESPONSES - 01541000 +* 01551000 +* COMMAND COMPLETE 01561000 +* 01571000 +* ERROR MESSAGES - 01581000 +* 01591000 +* 01601000 +*. 01611000 + EJECT 01621000 +HCPFRMQU HCPENTER CALL,SAVE=DYNAMIC FROM 01631000 +QRYFROM DS 0H 01641000 + CALL HCPSCCFD Are there more parameters? CONSOLE 01660990 + BZ MASSQRY Yes, must be mass query CONSOLE 01670980 + CLI VMDFROM,C' ' Is there a FROM set for us? CONSOLE 01680970 + BE NEGRESP No, then say so. CONSOLE 01690960 + CLI VMDFROM,X'00' Same check. CONSOLE 01700950 + BE NEGRESP No, then say so too. CONSOLE 01710940 +* Build response for QUERY FROM command CONSOLE 01720930 + MVC FROMC,FROM Move in "From:" CONSOLE 01730920 + MVC FROMID,VMDFROM Move in From userid CONSOLE 01740910 + HCPCONSL WRITE,DATA=(FROMC,LMSGDS) Write it and leave CONSOLE 01750900 + B FRMCOMSG CONSOLE 01760890 + SPACE 1 01871000 +* If user specified a parameter, search VMDBK chain for any maCONSOLE 01885990 +* that have that FROM value set. CONSOLE 01890980 +MASSQRY DS 0H CONSOLE 01895970 + MVI QRYFLAG,MSGCLEAR Clear the flag before beginniCONSOLE 01900960 + CL R0,EIGHT Is the parm length too long? CONSOLE 01905950 + BH FRM002 Yes, then give error CONSOLE 01910940 + LR R8,R0 Save the length CONSOLE 01915930 + BCTR R8,0 less 1 for execute CONSOLE 01920920 + LR R7,R1 Save parameter CONSOLE 01925910 + L R10,VMDORIG Point to system vmdbk CONSOLE 01930900 + L R10,VMDCYCLE-VMDBK(R10) POINT TO FIRST ACTIVE VNEWOUT 01941000 + HCPDROP R11 01951000 + HCPUSING VMDBK,R10 01961000 + MVC USERC,USERTXT Move in "Userid:" CONSOLE 01980990 + MVC FROMC,FROM Move in "From:" CONSOLE 01990980 +* Now loop through VMDBK chain looking for anyone who has CONSOLE 02000970 +* the specified FROM set, or whose USERID equals the FROM. CONSOLE 02010960 +QRYNXT DS 0H 02041000 + TM VMDCFLAG,VMDLOGON Is vm logging on? CONSOLE 02058990 + BO QRYCHKEN Yes, skip it. CONSOLE 02066980 + EX R8,CLCUSR Does USERID match FROM parm? CONSOLE 02074970 + BE QRYMSG Yes, then print it CONSOLE 02082960 + EX R8,CLCFROM Does FROM field match parm? CONSOLE 02090950 + BE QRYMSG Yes, then print it CONSOLE 02098940 +QRYCHKEN DS 0H 02111000 + CL R10,VMDORIG-VMDBK(,R11) ARE WE AT THE START? NEWOUT 02121000 + BE QRYDONE Yes, then finish CONSOLE 02140990 + L R10,VMDCYCLE Otherwise, get next VMDBK CONSOLE 02150980 + B QRYNXT Do it again. CONSOLE 02160970 +* CONSOLE 02170960 +* Send negative msg or "complete" depending on outcome CONSOLE 02180950 +QRYDONE DS 0H CONSOLE 02190940 + TM QRYFLAG,MSGSENT Did we send a message? CONSOLE 02200930 + BO FRMCOMSG Yes, then send "complete" CONSOLE 02210920 +NEGRESP DS 0H CONSOLE 02220910 + HCPCONSL WRITE,DATA=(NOFROM) CONSOLE 02230900 + B FRMEXIT GO HOME 02281000 +* CONSOLE 02300990 +* Generate full message for user CONSOLE 02310980 +QRYMSG DS 0H 02321000 + OI QRYFLAG,MSGSENT Say that message was printed CONSOLE 02336990 + MVC USERID,BLANKS Clear out fields CONSOLE 02342980 + MVC FROMID,BLANKS CONSOLE 02348970 + MVC USERID,VMDUSER Move in current USERID CONSOLE 02354960 + MVC FROMID,VMDFROM Move in from field CONSOLE 02360950 + HCPCONSL WRITE,DATA=(FROMC,LMSGD) CONSOLE 02366940 + LTR R15,R15 Did msg go through? CONSOLE 02372930 + BNZ QRYDONE No, then end it now. CONSOLE 02378920 + B QRYCHKEN Msg was OK, get next VMDBK CONSOLE 02384910 +* CONSOLE 02390900 +* The follwing will issue an error message if specified operanCONSOLE 02396890 +* is invalid because its too long. Max. of 8 chars. allowed. CONSOLE 02402880 +FRM002 DS 0H CONSOLE 02408870 + HCPCONSL WRITE,DATA=(TOOLONG) CONSOLE 02414860 + LA R2,002 CONSOLE 02420850 +* CONSOLE 02426840 +* Print generic "complete" message when all done CONSOLE 02432830 +FRMCOMSG DS 0H 02451000 + HCPCONSL WRITE,DATA=(COMPLETE) CONSOLE 02470990 +* CONSOLE 02480980 +* Get out at last..... CONSOLE 02490970 +FRMEXIT DS 0H 02511000 + HCPEXIT EP=(HCPFRMST,HCPFRMQU),SETCC=NO 02521000 + EJECT 02661000 +***************************************************************CONSOLE 02661500 +* Data areas for HCPFRM CONSOLE 02662000 +* CONSOLE 02662500 +* Code for execute instructions CONSOLE 02663000 +CLCUSR CLC VMDUSER(*-*),0(R7) EXECUTED CONSOLE 02663500 +CLCFROM CLC VMDFROM(*-*),0(R7) EXECUTED CONSOLE 02664000 +FROMSAVE MVC SETFROM(*-*),0(R1) CONSOLE 02664500 +* CONSOLE 02665000 +* Constants for messages, etc. CONSOLE 02665500 +TOOLONG DC C'Operand too long' CONSOLE 02666000 +COMPLETE DC C'Command Complete' CONSOLE 02666500 +NOFROM DC C'No FROM Set' CONSOLE 02667000 +USERTXT DC C' Userid: ' CONSOLE 02667500 +FROM DC C'From: ' CONSOLE 02668000 +BLANKS DC C' ' CONSOLE 02668500 +EIGHT DC F'00000008' CONSOLE 02669000 + LTORG , 02671000 +* Map of necessary work storage CONSOLE 02682990 +SAVBK DSECT , CONSOLE 02684980 + ORG SAVEWRK0 CONSOLE 02686970 +FROMC DS CL6 CONSTANT 'FROM: ' 02691000 +FROMID DS CL8 VMDFROM 02701000 +LMSGDS EQU *-FROMC SHORT MESSAGE CONSOLE 02720990 +USERC DS CL9 CONSTANT ' USER: ' CONSOLE 02730980 +USERID DS CL8 VMUSER 02741000 +LMSGD EQU *-FROMC CONSOLE 02754990 +QRYFLAG DS X CONSOLE 02758980 +MSGCLEAR EQU X'00' CONSOLE 02762970 +MSGSENT EQU X'80' CONSOLE 02766960 +SETFROM DS CL8 CONSOLE 02770950 + HCPDROP R0,R10,R13 CONSOLE 02774940 + HCPEPILG 02781000 + +************************************************************************ +The Marist INFOFOX modification allows an installation to define a new command +that will translate into a dial into a predetermined virtual machine beginning +at a specified address. This essentially allows you to define a synonym +for "DIAL xxx cuu". At Marist, this is used to implement our INFOFOX BBS, +which resides on system, MUSICB. A user issues the INFOFOX command, which +will dial the MUSICB machine, at the first available port address above +the address configured in the mod. + +The effect, therefore, enables you to reserve ports on a specific virtual +machine for a specific application. + +The original modification was developed at McGill University, by Anne-Marie +Marcoux (MARIE@VM1.McGill.CA). It supported only one synonym definition +and the starting address was hardcoded in the mod. While the basic +design of the modification remains the same, +Marist has extended the original by adding a table which allows you to define +multiple synonyms, each with its own starting address. It also +now supports the command, "DIAL INFOFOX" in addition to the standard +"INFOFOX" format. This was made necessary by a modification that Marist +developed for the logo screen, which automatically places the DIAL command +into the command stream. It is also useful, however for users who are +used to issuing "DIAL xxxxxx". + +The most important part of the mod is in HCPDIA. This adds a new entry point +to HCPDIA, HCPDIAIN. This routine is described more fully in the comments +at the entry point. Its purpose is to compare the specified command with +a pre-configured table. This table contains the synonym definition, its +true virtual machine name and the beginning port address. If the specified +command matches a synonym in the table, it is modified to contain the +true virtual machine name and beginning address. In addition, a flag is set +indicating that this was a synonym command. Control is then returned to +the main part of HCPDIA. HCPSCNVT is called to find the first available port +on the true virtual machine. HCPSCNVT has been modified to recognize that +a synonym command was issued. In this case, it ignores all ports until it +reaches the configured beginning address. It then returns the first available +port. + +Currently, the INFOFOX mod supports only one synonym per virtual machine. +This is because HCPSCNVT does not stop searching until it reaches +the last port on the virtual machine. Therefore, you can control the +beginning address of the range, but not the ending address. This should +not be difficult to add, however, and is planned for the future. + +In addition to HCPDIA and HCPSCN, HCPCOM is modified to define the +new synonyms. These should point to HCPDIAIN as the entry point +and should be available in the pre-logon state. + +Also included are optional modifications to HCPBVM and HCPMES. These +are necessary if you also have the PFKDIAL modification installed. +They change the definition of the PF keys and the messages in the +pre-logon state. These were required in the original mod from McGill +but are no longer required. + +The mod in this file is for VM/ESA 2.1.0. The original version of this +mod was developed on VM/ESA ESA 1.0 SLC 9202. + +As usual, you may alter this modification as you wish. Any problems, +comments and feedback (but no complaints) can be sent to Martha +McConaghy, Marist College (URMM@VM.MARIST.EDU) (914) 575-3252. +06/24/96 + +FILE: HCPDIA INFOFOX E1 +./ I 04240001 $ 4242001 2000 02/16/96 17:50:04 +* The following indicates a normal dial. The flag will INFOFOX 04242001 +* be set on if we are dialing to a userid in our INFOTAB. INFOFOX 04244001 +* See comments at HCPDIAIN. INFOFOX 04246001 + MVI WHICHCMD,OTHERCMD INDICATE NORMAL DIAL INFOFOX 04248001 +./ I 04280001 $ 4285001 5000 02/16/96 17:50:04 +MAINENTR DS 0H Join main code from DIAIN INFOFOX 04285001 +./ I 05460001 $ 5463001 3000 02/16/96 17:50:04 + CLI WHICHCMD,INFOCMD Are we doing info cmd? INFOFOX + BE NOCHECK INFOFOX +./ I 05560001 $ 5565001 5000 02/16/96 17:50:04 +NOCHECK DS 0H INFOFOX +./ I 06010001 $ 6012001 2000 02/16/96 17:50:04 + LR R15,R0 Ensure length in R15 INFOFOX 06012001 + B INFOCHK Go check for synonyms INFOFOX 06014001 +* INFOFOX 06016001 +GETVMDBK DS 0H Rejoin HCPDIA in progress INFOFOX 06018001 +./ I 07440001 $ 7443001 3000 02/16/96 17:50:04 + CLI WHICHCMD,INFOCMD Are we doing the info thing? INFOFOX 07443001 + BE FINDVDEV Yes, then search for vdev INFOFOX 07446001 +./ I 08020001 $ 8023001 3000 02/16/96 17:50:04 +* Set info flag for HCPSCNVT. INFOFOX 08023001 + ICM R0,B'1000',WHICHCMD Pass flag for type of dial INFOFOX 08026001 +./ I 16690001 $ 16690101 100 02/16/96 17:50:04 +*START OF SPECIFICATIONS***************************************INFOFOX 16690101 +* INFOFOX 16690201 +* Entry point name - HCPDIAIN INFOFOX 16690301 +* INFOFOX 16690401 +* Descriptive name - Dial processing for INFOFOX and related INFOFOX 16690501 +* commands. INFOFOX 16690601 +* INFOFOX 16690701 +* Developed by Martha McConaghy for Marist College 8/6/92 INFOFOX 16690801 +* for VM/ESA 1.0. INFOFOX 16690901 +* Based on a modification developed at McGill University. INFOFOX 16691001 +* Updated for VM/ESA 2.1 by Martha McConaghy 5/5/94. INFOFOX 16691101 +* INFOFOX 16691201 +* Function - This routine allows you to define commands in CP INFOFOX 16691301 +* that are pseudonyms for a dial function. For INFOFOX 16691401 +* example, INFOFOX, will really dial MUSICB using INFOFOX 16691501 +* a specific address range. The pseudonym commands INFOFOX 16691601 +* and the real DIALEE's name are kept in a table INFOFOX 16691701 +* along with the starting address. The table is INFOFOX 16691801 +* INFOTAB, located in this module. If you don't INFOFOX 16691901 +* care about the vaddr of the dial port, specify INFOFOX 16692001 +* x'0000' in the table. INFOFOX 16692101 +* INFOFOX 16692201 +* There are two ways of entering this routine: INFOFOX 16692301 +* entering the vanilla command, ie. INFOFOX. The INFOFOX 16692401 +* operation will enter this routine via HCPDIAIN. INFOFOX 16692501 +* The second INFOFOX 16692601 +* way is to issue DIAL xxxx, ie. DIAL INFOFOX. INFOFOX 16692701 +* In this case, operation will enter via HCPDIAL INFOFOX 16692801 +* and will be sent down to INFOCHK before going on. INFOFOX 16692901 +* INFOFOX 16693001 +* Prior to entering HCPSCNVT at label SCANLOOP, we INFOFOX 16693101 +* will set a flag in R0 that indicates if we are INFOFOX 16693201 +* processing an INFO command or not. If we are, INFOFOX 16693301 +* HCPSCNVT will check the vaddr of each port againstINFOFOX 16693401 +* the address defined in INFOTAB. HCPSCNVT will INFOFOX 16693501 +* reject all vaddrs below this address. INFOFOX 16693601 +* INFOFOX 16693701 +* R2, R3 and R4 are used. INFOFOX 16693801 +* R15 is expected to have the length of dialee's name INFOFOX 16693901 +* upon input. INFOFOX 16694001 +* INFOFOX 16694101 +*END OF SPECIFICATIONS*****************************************INFOFOX 16694201 +HCPDIAIN HCPENTER CALL,SAVE=DYNAMIC INFOFOX 16694301 +* INFOFOX 16694401 +* Enter here for one of the special commands and then join INFOFOX 16694501 +* the main HCPDIA for terminal checking. We will come back INFOFOX 16694601 +* later on. INFOFOX 16694701 + MVI WHICHCMD,INFOCMD Signal the info command INFOFOX 16694801 + B MAINENTR Rejoin HCPDIA INFOFOX 16694901 +* INFOFOX 16695001 +INFOCHK DS 0H Main checking code INFOFOX 16695101 +* INFOFOX 16695201 +* The following code will check a table of pseudonym INFOFOX 16695301 +* commands. If the userid matches one, then we will INFOFOX 16695401 +* will reset the DIALEUSR name to the table value and set the INFOFOX 16695501 +* vaddr value for HCPSCNVT in VNUMBIN. INFOFOX 16695601 +* INFOFOX 16695701 +* Restrictions: We expect R15 to have length in it. INFOFOX 16695801 +* Also, R1 should point to DIALEUSR. INFOFOX 16695901 +* INFOFOX 16696001 +* Set a minimum length for R15. This is to ensure that there INFOFOX 16696101 +* is at least 3 characters in the command to be checked. INFOFOX 16696201 +* Otherwise, send it back to HCPDIA to be handled normally. INFOFOX 16696301 + BCTR R15,0 Got to sub 1 from length INFOFOX 16696401 + CL R15,PFX2 Is length < 3? INFOFOX 16696501 + BL GETVMDBK Yes, then skip check. INFOFOX 16696601 +* INFOFOX 16696701 + LA R2,20 Set Table Increment INFOFOX 16696801 + LA R3,EINFOTAB Set ending address INFOFOX 16696901 + LA R4,INFOTAB Get addr of our table INFOFOX 16697001 +COMPTAB EX R15,COMPINFO Is it an entry in the table? INFOFOX 16697101 + BE INFOSET yes, then set the information INFOFOX 16697201 + BXLE R4,R2,COMPTAB Get next entry and try again INFOFOX 16697301 + B GETVMDBK None found, go back to HCPDIA. INFOFOX 16697401 +* INFOFOX 16697501 +INFOSET MVI WHICHCMD,INFOCMD Indicate the info command INFOFOX 16697601 + MVC DIALEUSR(8),8(R4) Set dialee name from table INFOFOX 16697701 + LA R0,8 Hardcode length at 8 INFOFOX 16697801 + MVC VNUMSTRT,16(R4) Set Vaddr for HCPSCNVT INFOFOX 16697901 + B GETVMDBK Rejoin HCPDIA INFOFOX 16698001 + EJECT INFOFOX 16698101 +./ I 27320971 $ 27321671 700 02/16/96 17:50:04 +COMPINFO CLC DIALEUSR(*-*),0(R4) CHECK DIALED VM INFOFOX 27321671 +* INFOFOX 27322371 +INFOTAB DC CL16'INFOFOX MUSICB ' SYNONYM AND SYSTEM INFOFOX 27323071 + DC X'000005E0' BEGIN VADDR INFOFOX 27323771 + DC CL16'DOBIS MVS ' SYNONYM AND SYSTEM INFOFOX 27324471 + DC X'00000576' BEGIN VADDR INFOFOX 27325171 + DC CL16'TSO MVS ' SYNONYM AND SYSTEM INFOFOX 27325871 + DC X'00000000' BEGIN VADDR INFOFOX 27326571 + DC CL16'IAPROD MVS ' SYNONYM AND SYSTEM INFOFOX 27327271 + DC X'00000000' BEGIN VADDR INFOFOX 27327971 +EINFOTAB EQU *-1 INFOFOX 27328671 +./ I 28520001 $ 28522001 2000 02/16/96 17:50:04 + ORG SAVEWRK9 INFOFOX 28522001 +WHICHCMD DS XL1 is it INFO or normal DIAL ? INFOFOX 28524001 +OTHERCMD EQU X'00' INFOFOX 28526001 +INFOCMD EQU X'01' INFOFOX 28528001 + +FILE: HCPMES INFOFOX E1 +./ R 61255400 61255450 $ 61255410 2 08/11/92 09:51:19 +70600506 PF3 or PF15: LOGOFF INFOFOX 74808974 +70600507 PF4 or PF16: INFOFOX INFOFOX 74808976 +70600508 PF5 or PF17: DOBIS INFOFOX 74808978 +70600509 PF6 or PF18: IAPROD INFOFOX 74808980 +70600510 PF12 or PF24: ADDR INFOFOX 74808982 +70600511 INFOFOX 74808982 +70600512 To access CMS, type: LOGON accountcode INFOFOX 74808982 +./ R 61255900 61255950 $ 61255910 2 08/11/92 09:51:19 +70600606 PF3: LOGOFF INFOFOX 74809054 +70600607 PF4: INFOFOX INFOFOX 74809056 +70600608 PF5: DOBIS INFOFOX 74809058 +70600609 PF6: IAPROD INFOFOX 74809060 +70600610 PF12: ADDR INFOFOX 74809062 + +FILE: HCPCOM INFOFOX E1 +./ I 06344991 $ 6345000 100 08/06/92 15:11:26 +************************************************************** INFOFOX 00513910 +* * INFOFOX 00514900 +* DOBIS COMMAND * INFOFOX 00515890 +* * INFOFOX 00516880 +************************************************************** INFOFOX 00517870 + SPACE , INFOFOX 00518860 + COMMD COMMAND=(DOBIS,5),FL=CMDONLY+CMDALOG+CMDOLOG, *00519850 + CLASS=*,EP=HCPDIAIN INFOFOX 00520840 + SPACE , INFOFOX 00521830 +./ I 07869991 $ 7870000 100 08/06/92 15:11:26 +************************************************************** INFOFOX 00662410 +* * INFOFOX 00663400 +* IAPROD COMMAND * INFOFOX 00664390 +* * INFOFOX 00665380 +************************************************************** INFOFOX 00666370 + SPACE , INFOFOX 00667360 + COMMD COMMAND=(IAPROD,6),FL=CMDONLY+CMDALOG+CMDOLOG, *00668350 + CLASS=*,EP=HCPDIAIN INFOFOX 00669340 + SPACE , INFOFOX 00670330 +./ I 08064991 $ 8065000 100 08/06/92 15:11:26 +************************************************************** INFOFOX 00662410 +* * INFOFOX 00663400 +* INFOFOX COMMAND * INFOFOX 00664390 +* * INFOFOX 00665380 +************************************************************** INFOFOX 00666370 + SPACE , INFOFOX 00667360 + COMMD COMMAND=(INFOFOX,4),FL=CMDONLY+CMDALOG+CMDOLOG, *00668350 + CLASS=*,EP=HCPDIAIN INFOFOX 00669340 + SPACE , INFOFOX 00670330 +./ I 14379991 $ 14380000 100 08/06/92 15:11:26 + SPACE , INFOFOX 00670330 +************************************************************** INFOFOX 00662410 +* * INFOFOX 00663400 +* TSO COMMAND * INFOFOX 00664390 +* * INFOFOX 00665380 +************************************************************** INFOFOX 00666370 + SPACE , INFOFOX 00667360 + COMMD COMMAND=(TSO,3),FL=CMDONLY+CMDALOG+CMDOLOG, *00668350 + CLASS=*,EP=HCPDIAIN INFOFOX 00669340 + +FILE: HCPBVM INFOFOX E1 +./ R 12714401 12714801 $ 12714901 50 08/06/92 15:00:32 + DC AL1(3),X'01',CL13'LOGOFF' INFOFOX 07977200 + DC AL1(4),X'01',CL13'INFOFOX' INFOFOX 07977200 + DC AL1(5),X'01',CL13'DOBIS' INFOFOX 07977200 + DC AL1(6),X'01',CL13'IAPROD' INFOFOX 07977800 + DC AL1(12),X'01',CL13'ADDR' INFOFOX 07978400 + +********************************************************************** +The PFKDIAL modification allows you to define PF keys to be used in +the pre-logon state. These PF keys can be assigned CP commands that +are also valid in the pre-logon state to make them easier to use. + +The original PFKDIAL mod came from Anne-Marie Marcoux of McGill +University (MARIE@VM1.McGill.CA). The mod in this file is essentially +the same as the original. A few serial numbers have been updated +to conform with my level of VM/ESA 2.1.0 and support for +other CP commands, besides DIAL, has been added. These changes are +slight, however, and the mod remains essentially the McGill version. + +The bulk of the work is done by HCPBVM, which processes the PF key +and contains a table of the key definitions. The original mod +only allowed DIAL commands to be defined to each key, ie. it hardcoded +DIAL into the processing of the key. I have extended the mod to allow +any valid pre-logon CP command to be placed in the table. + +HCPLOG and HCPLON are modified to allow PF keys to be used. HCPMES +and HCPMXRBK are modified to change the messages on the pre-logon +screen. + +My thanks to Anne-Marie for sharing her mod with me and her +permission to post in on the LISTSERV. + +As usual, you are free to do with this what you will. Questions, +comments and feedback (but no complaints) can be sent to Martha +McConaghy, Marist College (URMM@VM.MARIST.EDU) (914) 575-3252. +06/24/96 + +./ * HCPMES PFKDIAL +./ * let users dial by hitting PF keys +./ R 61254804 61414804 $ 61255000 50 07/10/92 10:40:48 +* PFKDIAL 74808908 +* Translation information for message 7060-05 PFKDIAL 74808916 +* No fields need to be translated PFKDIAL 74808924 +70600501R PFKDIAL 74808932 +70600502 Use a PFkey to access the desired system: PFKDIAL 74808940 +70600503 PFKDIAL 74808948 +70600504 PF1 or PF13: Dial MUSICA PFKDIAL 74808956 +70600505 PF2 or PF14: Dial MUSICB PFKDIAL 74808964 +70600506 PF11 or PF23: ADDR PFKDIAL 74808972 +70600507 PF12 or PF24: LOGOFF PFKDIAL 74808980 +* PFKDIAL 74808988 +* Translation information for message 7060-06 PFKDIAL 74808996 +* No fields need to be translated PFKDIAL 74809004 +70600601R PFKDIAL 74809012 +70600602 Use a PFkey to access the desired system: PFKDIAL 74809020 +70600603 PFKDIAL 74809028 +70600604 PF1: Dial MUSICA PFKDIAL 74809036 +70600605 PF2: Dial MUSICB PFKDIAL 74809044 +70600606 PF11: ADDR PFKDIAL 74809052 +70600607 PF12: LOGOFF PFKDIAL 74809060 +* PFKDIAL 74809068 +* Translation information for message 7060-07 PFKDIAL 74809076 +* No fields need to be translated PFKDIAL 74809084 +70600701R PFKDIAL 74809092 +70600702 Use a PFkey to access the desired system: PFKDIAL 74809100 +70600703 PFKDIAL 74809108 +70600704 PF1 or PF13: musicf PFKDIAL 74809116 +* PFKDIAL 74809124 +* Translation information for message 7060-08 PFKDIAL 74809132 +* No fields need to be translated PFKDIAL 74809140 +70600801R PFKDIAL 74809148 +70600802 Use a PFkey to access the desired system: PFKDIAL 74809156 +70600803 PFKDIAL 74809164 +70600804 PF1: musicf PFKDIAL 74809172 +* PFKDIAL 74809180 + +FILE: HCPBVM PFKDIAL E1 +./ * HCPBVM PFKDIAL +./ * let users dial by hitting PF keys +./ * vmdpfunc points to a 24 fullword list which in turn points +./ * to gsdbloks for those pfkeys having settings +./ * see module HCPPFK for pfk processing +./ I 00935001 $ 937001 2000 05/03/94 17:53:42 +* HCPGSDBK - General System Data Block PFKDIAL +./ I 00980001 $ 985001 5000 05/03/94 17:53:42 +* HCPPFUNC - PF Keys Function block PFKDIAL +./ I 01965001 $ 1966000 1000 05/03/94 17:53:42 + COPY HCPGSDBK - General system data block PFKDIAL 01962001 +./ I 02000001 $ 2005001 5000 05/03/94 17:53:42 + COPY HCPPFUNC - PF Keys Function Table PFKDIAL 02005001 +./ I 10070001 $ 10070101 100 05/03/94 17:53:42 +************************************************************** PFKDIAL 10070101 +* * PFKDIAL 10070201 +* Now create PFK entries for menu to be shown at logon * PFKDIAL 10070301 +* Make sure R8 and R10 are unchanged * PFKDIAL 10070401 +* * PFKDIAL 10070501 +************************************************************** PFKDIAL 10070601 + HCPUSING RDEV,R8 PFKDIAL 10070701 +PFKDIAL CLI RDEVCLAS,CLASGRAF is this a local 3270? PFKDIAL 10070801 + BNE PFKDONE no, then no PFKs PFKDIAL 10070901 +PFKDEFS LA R2,PFDEFS R2 -> list of definitions PFKDIAL 10071001 + HCPUSING SYSDEF,R2 PFKDIAL 10071101 + LA R4,NPFDEFS R4 = number of these definitions PFKDIAL 10071201 +* just covering here, an already defined function table PFKDIAL 10071301 +* means it wasn't released properly last time around! PFKDIAL 10071401 +* and that's a BUG !!! PFKDIAL 10071501 + ICM R1,B'1111',VMDPFUNC get the function table PFKDIAL 10071601 + BNZ FILLKEYS this is not the first time PFKDIAL 10071701 +* In VM/ESA 2.1, the PFUNC block was added to map the list PFKDIAL +* of pointers to the PF key definitions. We must use that PFKDIAL +* block layout now. PFKDIAL + LA R0,PFUNSZD(R1) Let's get one then. PFKDIAL 10071801 + HCPGETST LEN=(R0),TYPE=GUESTPERM get free storage PFKDIAL 10071901 + ST R1,VMDPFUNC save that precious address PFKDIAL 10072001 + LR R6,R1 PFKDIAL 10072101 + HCPUSING PFUNC,R6 PFKDIAL 10072201 + XC 0(PFUNSZD*8,R1),0(R1) Zero out the whole thing PFKDIAL 10072501 + LA R6,PFUNGSDS Get location of PF pointers PFKDIAL 10072601 + HCPDROP R6 PFKDIAL 10072701 +* Now load the PFUNC table and create GSD's for each PFKDIAL +* PF key to be defined. PFKDIAL +FILLKEYS SLR R3,R3 clear to PFKDIAL 10072801 + IC R3,SYSKEY ... load PF key number PFKDIAL 10072901 + LA R0,PFDENTRY size of block PFKDIAL 10073001 + HCPGETST ID=GSDBK,LEN=(R0),TYPE=GUESTPERM get it! PFKDIAL 10073101 + SLL R3,2 Calculate the index into the PFKDIAL 10073201 + S R3,PFX4 ...function table for this PF PFKDIAL 10073301 + AR R3,R6 Add offset to table pointer PFKDIAL 10073401 + ST R1,0(,R3) store gsdbk into addr table slot PFKDIAL 10073501 + SPACE 1 PFKDIAL 10073601 + HCPUSING GSDBK,R1 addressability to PF GSDBK PFKDIAL 10073701 + STH R0,GSDFRESZ save the double word size PFKDIAL 10073801 + LA R5,L'SYSNAME length of data to be moved PFKDIAL 10073901 + STH R5,GSDDCNT save the pfdata data count PFKDIAL 10074001 + MVC GSDDATA(L'SYSNAME),SYSNAME move part 2 PFKDIAL 10074201 + MVC GSDFLAG,=AL1(GSDPFIMM) immediate PF key PFKDIAL 10074301 + CLI RDEVTYPE,TYP3278 got 24-PFkey terminal ? PFKDIAL 10074401 + BNE NEXTSYS nope, all done for this one then PFKDIAL 10074501 + SPACE 1 PFKDIAL 10074601 + HCPGETST ID=GSDBK,LEN=(R0),TYPE=GUESTPERM get one morPFKDIAL 10074701 + LA R3,4*12(,R3) repeat at PF(n+12) PFKDIAL 10074801 + ST R1,0(,R3) store gsdbk into addr table slot PFKDIAL 10074901 + HCPUSING GSDBK,R1 addressability to PF GSDBK PFKDIAL 10075001 + STH R0,GSDFRESZ save the double word size PFKDIAL 10075101 + STH R5,GSDDCNT save the pfdata data count PFKDIAL 10075201 +* MVC GSDDATA(L'DIAL),DIAL move pfdata part 1 PFKDIAL 10075301 + MVC GSDDATA(L'SYSNAME),SYSNAME move part 2 PFKDIAL 10075401 + MVC GSDFLAG,=AL1(GSDPFIMM) immediate PF key PFKDIAL 10075501 + SPACE 1 PFKDIAL 10075601 +NEXTSYS LA R2,SYSLEN(,R2) PFKDIAL 10075701 + BCT R4,FILLKEYS move on to next definition PFKDIAL 10075801 + HCPDROP R1,R2,R8 PFKDIAL 10075901 + SPACE 1 PFKDIAL 10076001 +PFKDONE DS 0H PFKDIAL 10076101 +./ I 12710001 $ 12710401 400 05/03/94 17:53:42 + EJECT PFKDIAL 12710301 +* PFdefs : PFKDIAL 12711201 +* Byte 1 = PFK number PFKDIAL 12711501 +* Byte 2 = cpu number X'01' --> VM1 PFKDIAL 12711801 +* X'02' --> VM2 PFKDIAL 12712101 +* X'00' --> system runs on both PFKDIAL 12712401 +* BYTE 3-15 = command to issue PFKDIAL 12712701 +* PFKDIAL 12713001 +PFDEFS DC AL1(1),X'01',CL13'DIAL MUSICA' PFKDIAL 12713301 + DC AL1(2),X'01',CL13'DIAL MUSICB' PFKDIAL 12713601 + DC AL1(11),X'01',CL13'ADDR' PFKDIAL 12713901 + DC AL1(12),X'01',CL13'LOGOFF' PFKDIAL 12714201 + SPACE 1 PFKDIAL 12714501 +NPFDEFS EQU (*-PFDEFS)/15 PFKDIAL 12714801 +PFDENTRY EQU (L'SYSNAME+7)/8+GSDHSIZE double words PFKDIAL 12715101 +* Size of each PFkey entry PFKDIAL 12715401 + SPACE 1 PFKDIAL 12715701 +SYSDEF DSECT initial PFK definition PFKDIAL 12716001 +SYSKEY DS X PFK number PFKDIAL 12716301 +SYSFLAG DS X cpu flag PFKDIAL 12716601 +SYSNAME DS CL13 name of system to dial PFKDIAL 12716901 +SYSLEN EQU *-SYSDEF length of this dsect PFKDIAL 12717201 + SPACE 3 PFKDIAL 12717501 + +FILE: HCPLOG PFKDIAL E1 +./ * HCPLOG PFKDIAL +./ * let users dial by hitting PFkeys +./ I 00970001 $ 00970100 +* HCPPFKPG - Deallocate PF key storage PFKDIAL +./ I 02820001 $ 02820100 + EXTRN HCPPFKPG PFKDIAL +./ * this part entered if new user is logging on +./ * skeleton vmblok must reset pfkeys first +./ I 11090001 $ 11090100 100 + HCPCALL HCPPFKPG deallocate PF key storage PFKDIAL + SPACE 1 PFKDIAL + +FILE: HCPLON PFKDIAL E1 +./ * HCPLON PFKDIAL +./ * let users dial by hitting PF keys +./ R 10030001 $ 10034991 4990 05/02/94 15:53:00 + HCPDROP R3 PFKDIAL 10030005 +./ R 10060001 $ 10060991 990 05/02/94 15:53:00 + LA R14,5 Hardcode version 5 PFKDIAL + CLI RDEVTYPE,TYP3278 Do we have 24 PF keys? PFKDIAL + BE PTFOK Yes, then we are cool. PFKDIAL + HCPDROP R8 PFKDIAL + LA R14,6 No, then use version 6 PFKDIAL +PTFOK BCTR R14,0 Decrement for offset PFKDIAL 10060001 \ No newline at end of file diff --git a/vmworkshop-vmarcs/1996/msg/README.md b/vmworkshop-vmarcs/1996/msg/README.md new file mode 100644 index 0000000..c8e1b69 --- /dev/null +++ b/vmworkshop-vmarcs/1996/msg/README.md @@ -0,0 +1,43 @@ +# MSGD + +This is freely distributable software. The author shall not be held +liable for any incorrect operation of your system(s) resulting from +using this package. (having said that, I think you'll find that it +*does* work) + +MSGD is a server to handle the Message Send Protocol per RFC 1312. +Neither the server nor the client implement all features of RFC 1312. +Note that you can run the client without the server and vice versa. + +Files in the package are: +MSGD EXEC +TELL EXEC +MSGD README (this file) +MSGD DIRECT + +To run MSGD, you need: + +1. IBM VM TCP/IP Version 2 (5735-FAL) +2. REXX/Sockets from Arty Ecock of CUNY +3. a service virtual machine named MSGD + +MSGD is the TCP and UDP operative Message Send Protocol server. It needs port 18 from your TCP/IP service machine and likes to have class B (for MSGNOH), but will work with just class G (for MSG). + +TELL EXEC is a (from scratch) replacement for standard CMS TELL. + +The Message Send Protocol is considered experimental. Discussion and suggestions for improvement are requested by the authors of RFC 1312. This protocol is used to send a short message to a given user on a given host. Such message service is known in the VM world as "TELL". On VM, RSCS provides this kind of interactive messaging, but TCP/IP, until now, has not. + +The details of the protocol are discussed in RFC1312 TXT (included). Thanks go to Russell Nelson of Crynwr Software and Geoff Arnold of Sun Microsystems, Inc. for collaborating on this RFC. + +All you really need to do is: + +1. Create the MSGD virtual machine, +2. put MSGD EXEC on a disk available to the MSGD service VM and arrange that MSGD EXEC is invoked (eg: from PROFILE), +3. put the supplied TELL EXEC in such a place where your users can invoke it. (the supplied TELL EXEC should function as a direct replacement for the standard CMS TELL, but there is NO WARRANTY provided) + +## Bugs + +The client (TELL) is only TCP based, and should have UDP support for "broadcasts". (server handles both) + +The client ties-up CMS until the message is delivered. (just the sending virtual machine, not the whole system) + diff --git a/vmworkshop-vmarcs/1996/msg/getline.c b/vmworkshop-vmarcs/1996/msg/getline.c new file mode 100644 index 0000000..83049b6 --- /dev/null +++ b/vmworkshop-vmarcs/1996/msg/getline.c @@ -0,0 +1,40 @@ +/* ------------------------------------------------------------- GETLINE + * Name: GETLINE/UFTXGETS/UFTXRCVS + * common Get/Receive String function + * Operation: Reads a CR/LF terminated string from socket s + * into buffer b. Returns the length of that string. + * Author: Rick Troth, Ithaca NY, Houston TX (METRO) + * Date: 1993-Sep-19, Oct-20 + * + * See also: putline.c, netline.c + */ +int getline(s,b) + int s; + char *b; + { + char *p; + int i; + + p = b; + while (1) + { + if (read(s,p,1) != 1) /* get a byte */ + if (read(s,p,1) != 1) return -1; /* try again */ + if (*p == '\n') break; /* NL terminates */ + if (*p == 0x00) break; /* NULL terminates */ +/* if (*p == '\t') *p = ' '; ** [don't] eliminate TABs */ + p++; /* increment pointer */ + } + *p = 0x00; /* NULL terminate, even if NULL */ + + i = p - b; /* calculate the length */ + if (i > 0 && b[i-1] == '\r') /* trailing CR? */ + { + i = i - 1; /* shorten length by one */ + p--; /* backspace */ + *p = 0x00; /* remove trailing CR */ + } + + return i; + } + diff --git a/vmworkshop-vmarcs/1996/msg/hostname.exec b/vmworkshop-vmarcs/1996/msg/hostname.exec new file mode 100644 index 0000000..6dc67f2 --- /dev/null +++ b/vmworkshop-vmarcs/1996/msg/hostname.exec @@ -0,0 +1,71 @@ +/* * Copyright 1995, Richard M. Troth, all rights reserved. + * + * Name: HOSTNAME EXEC + * display the TCP/IP hostname for this system + * Author: Rick Troth, Houston, Texas, USA + * Date: 1992-Sep-09, 1994-Aug-28, 1995-Aug-13, 31 + * + * Note: Typical invokation is something like + * + * hostname -f for FQDN + * hostname -s for short hostname + * hostname -d for internet domain + */ + +/* load the TCPIP DATA file, presuming it's available */ +Address COMMAND 'PIPE < TCPIP DATA | SPLIT BEFORE /;/' , + '| NLOCATE /;/ | XLATE LOWER | STEM TCP.' +If rc ^= 0 Then Exit rc + +Parse Source . type . + +Parse Arg args +If type = "COMMAND" Then Say _hn(args) +Else Return _hn(args) + +Exit + + +/* ------------------------------------------------------------------ */ +_HN: Procedure Expose tcp. + +/* first find out what CP and CMS say */ +Address COMMAND 'PIPE CP QUERY USERID' , + '| SPEC WORD 3 1 | XLATE LOWER | VAR CPH' +Address COMMAND 'PIPE COMMAND IDENTIFY' , + '| SPEC WORD 3 1 | XLATE LOWER | VAR CMSH' + +/* initialize strings */ +hostname = "" +domainorigin = "" + +/* crunch the file into usable data */ +Do i = 1 To tcp.0 + Parse Var tcp.i w1 w2 . + If Index(w1,':') > 0 Then Do + Parse Var tcp.i hh ':' w1 w2 . + If hh ^= cph & hh ^= cmsh Then Iterate + End /* If .. Do */ + Select + When w1 = "hostname" Then hostname = w2 + When w1 = "domainorigin" Then domainorigin = w2 + Otherwise nop + End /* Else Do */ + End /* Do For */ + +/* build FQDN string from components */ +If hostname = "" Then hostname = cmsh +If domainorigin ^= "" Then fqdn = hostname || '.' || domainorigin + Else fqdn = hostname +/* we may be doing a little more work here and immediately above + but it simplifies the logic somewhat (and/or I'm just lazy */ + +/* now decide just what to return */ +Parse Upper Arg flag . , . +Select /* flag */ + When flag = "-F" Then return fqdn + When flag = "-D" Then return domainorigin + When flag = "-S" Then return hostname + Otherwise return fqdn + End /* Select flag */ + diff --git a/vmworkshop-vmarcs/1996/msg/msg.filelist b/vmworkshop-vmarcs/1996/msg/msg.filelist new file mode 100644 index 0000000..c56a8f1 --- /dev/null +++ b/vmworkshop-vmarcs/1996/msg/msg.filelist @@ -0,0 +1,45 @@ +* © Copyright 1992, 1996, Richard M. Troth, all rights reserved. +* (casita sourced) <plaintext> +* +* Name: MSG FILELIST +* a list of all files associated with the +* RFC 1312 (MSP) TELL/MSGD implementation for CMS +* Author: Rick Troth, Houston, Texas, USA +* Date: 1992-Jun-14, Dec-09, 1996-Feb-15 +* + MSG FILELIST * README "" 0 +* + MSGD EXEC * + MSGD README * + RFC1312 TXT * + MSGD DIRECT * +* + TELL EXEC * + TELL REXX * + TELL HELPCMS * + USERLIST REXX * + HOSTNAME EXEC * +* +* MSGD is the TCP and UDP operative Message Send Protocol server. +* It needs port 18 from your TCP/IP service machine and likes to have +* class B (for MSGNOH), but will work with just class G (for MSG). +* +* TELL EXEC is a (from scratch) replacement for standard CMS TELL. +* +* Be sure to get the latest REXX/Sockets for this to work! +* +* UNIX client and server: + MSGC C * + MSGLOCAL C * + MSGCUFTD C * + MSGCMSP C * + MSGHNDLR H * + MSGCAT C * + MSGD C * + GETLINE C * + PUTLINE C * + USERID C * + TCPIO C * + MSG MAK * +* MSGC C is TELL C for UNIX; see the makefile +* diff --git a/vmworkshop-vmarcs/1996/msg/msg.mak b/vmworkshop-vmarcs/1996/msg/msg.mak new file mode 100644 index 0000000..317edf9 --- /dev/null +++ b/vmworkshop-vmarcs/1996/msg/msg.mak @@ -0,0 +1,40 @@ +# +# Name: msg.mak (make file) +# makefile for MSG package: tell, msgcat, msgd +# Author: Rick Troth, Houston, Texas, USA +# Date: 1996-Mar-25 (Oscar night), cut from main "makefile" +# + +default: tell msgcat msgd + +msgcat: msg.mak msgcat.o putline.o + cc -o msgcat msgcat.o putline.o + strip msgcat + +msgd: msg.mak msgd.o putline.o tcpio.o + cc -o msgd msgd.o putline.o tcpio.o + strip msgd + +tell: msg.mak msgc.o msgcmsp.o msgcuftd.o msglocal.o \ + getline.o tcpio.o userid.o putline.o + cc -o tell msgc.o msgcmsp.o msgcuftd.o msglocal.o \ + getline.o tcpio.o userid.o putline.o + strip tell + +msgcmsp.o: msg.mak msghndlr.h msgcmsp.c + cc -c msgcmsp.c + +msgcuftd.o: msg.mak msghndlr.h msgcuftd.c + cc -c msgcuftd.c + +msglocal.o: msg.mak msghndlr.h msglocal.c + cc -c msglocal.c + +install: tell msgcat msgd + mv tell msgcat /usr/local/bin/. + mv msgd /usr/local/etc/. + +clean: + rm -f *.o *.a core a.out tell msgcat msgd + + diff --git a/vmworkshop-vmarcs/1996/msg/msgc.c b/vmworkshop-vmarcs/1996/msg/msgc.c new file mode 100644 index 0000000..95cc76c --- /dev/null +++ b/vmworkshop-vmarcs/1996/msg/msgc.c @@ -0,0 +1,127 @@ +/* © Copyright 1994, 1996, Richard M. Troth, all rights reserved. + * (casita sourced) <plaintext> + * + * Name: msgc.c (tell.c) + * a multi-mode 'tell' command for UNIX + * Author: Rick Troth, Rice University, Houston, Texas, USA + * Date: 1994-Jul-25 and prior + */ + +#include <fcntl.h> +#include <errno.h> +#include "msghndlr.h" + +/* ------------------------------------------------------------ MSGWRITE + * Try stock UNIX 'write' command if local user. + */ +int msgwrite(user,text) + char *user, *text; + { + char temp[256]; + (void) sprintf(temp,"echo \"%s\" | write %s",text,user); + return system(temp); + } + +/* ------------------------------------------------------------ MSGSMTPS + * Try SMTP "send" command. (not always implemented) + */ +int msgsmtps(user,text) + char *user, *text; + { + return -1; + } + +/* ------------------------------------------------------------ MSGSMTPM + * Try SMTP mail. (advantage is direct -vs- queued) + */ +int msgsmtpm(user,text) + char *user, *text; + { + return -1; + } + +/* ------------------------------------------------------------- MSGMAIL + * Try queued mail (sendmail) as a last resort. + */ +int msgmail(user,text) + char *user, *text; + { + return -1; + } + +/* -------------------------------------------------------------- DOTELL + */ +int dotell(user,text) + char *user, *text; + { + if (msgcmsp(user,text) && + msgcuftd(user,text) && + msglocal(user,text) && + msgwrite(user,text) && + msgsmtps(user,text) && + msgsmtpm(user,text) && + msgmail(user,text)) return -1; + else return 0; + } + +/* ------------------------------------------------------------------ */ +int main(argc,argv) + int argc; + char *argv[]; + { + int i, j, k; + char msgbuf[4096], *arg0; + + arg0 = argv[0]; + + /* process options */ + for (i = 1; i < argc && argv[i][0] == '-' && + argv[i][1] != 0x00; i++) + { + switch (argv[i][1]) + { + case 'v': (void) sprintf(msgbuf, + "%s: %s Internet TELL client", + arg0,MSG_VERSION); + (void) putline(2,msgbuf); + return 0; + break; + default: (void) sprintf(msgbuf, + "%s: invalid option %s", + arg0,argv[i]); + (void) putline(2,msgbuf); + return 20; + break; + } + } + + /* confirm sufficient arguments */ + if (argc < 2) + { + (void) system("xmitmsg -2 386"); + return 24; + } + + /* parse them */ + if (argc > 2) + { + k = 0; + for (i = 2; i < argc; i++) + { + for (j = 0; argv[i][j] != 0x00; j++) + msgbuf[k++] = argv[i][j]; + msgbuf[k++] = ' '; + } + msgbuf[k++] = 0x00; + (void) dotell(argv[1],msgbuf); + } + else while (1) + { + (void) getline(0,msgbuf); + if (msgbuf[0] == '.' && msgbuf[1] == 0x00) break; + (void) dotell(argv[1],msgbuf); + } + return 0; + } + + diff --git a/vmworkshop-vmarcs/1996/msg/msgcat.c b/vmworkshop-vmarcs/1996/msg/msgcat.c new file mode 100644 index 0000000..95b24f6 --- /dev/null +++ b/vmworkshop-vmarcs/1996/msg/msgcat.c @@ -0,0 +1,142 @@ +/* © Copyright 1995, Richard M. Troth, all rights reserved. <plaintext> + * (casita sourced) + * + * Name: msgcat.c + * writes incoming messages to standard output + * Author: Rick Troth, Houston, Texas, USA + * Date: 1995-Oct-26 and prior + * + * Operation: I think the original idea came from David Lippke, + * that there should be a FIFO in the home directory + * to which the user could attach any custom listener. + * This is a quick and easy solution using that technique. + */ + +extern int errno; +#include <fcntl.h> + +#include "msghndlr.h" + +/* -------------------------------------------------------------- ENVGET + * Returns a pointer to the value of the requested variable, + * or points to the end of the environment buffer. + */ +char *envget(env,var) + char *env, *var; + { + char *p, *q; + + if (*env == 0x00) return env; + + p = env; q = var; + while (*p) + { + while (*p == *q && *p && *q && *p != '=') { p++; q++; } + if (*p == '=' && *q == 0x00) return ++p; + while (*p++); q = var; + } + + return p; + } + +/* ------------------------------------------------------------------ */ +main(argc,argv) + int argc; char *argv[]; + { + int i, fd; + char buffer[4096], *p, *q, *arg0, *envbuf, *user; + char outbuf[4096]; + + arg0 = argv[0]; + + /* process options */ + for (i = 1; i < argc && argv[i][0] == '-' && + argv[i][1] != 0x00; i++) + { + switch (argv[i][1]) + { + case 'v': (void) sprintf(buffer, + "%s: %s Internet TELL agent", + arg0,MSG_VERSION); + (void) putline(2,buffer); + return 0; + break; + case 'u': (void) close(1); + (void) open("/dev/console",O_WRONLY|O_NOCTTY,0); + (void) close(2); + user = argv[++i]; + i = fork(); if (i < 1) return i; + break; + default: (void) sprintf(buffer, + "%s: invalid option %s", + arg0,argv[i]); + (void) putline(2,buffer); + return 20; + break; + } + } + + /* close stdin */ + (void) close(0); + + /* loop forever */ + while (1) + { + errno = 0; + sprintf(buffer,"%s/.msgpipe",getenv("HOME")); + fd = open(buffer,O_RDONLY); + if (fd < 0) + { + sprintf(buffer,"/tmp/%s.msgpipe",getenv("LOGNAME")); + fd = open(buffer,O_RDONLY); + } + if (fd < 0) break; + + /* loop on message instance */ + while (1) + { + i = read(fd,buffer,4096); + if (i < 1) + i = read(fd,buffer,4096); + if (i < 1) break; + + /* be sure it's environment terminated (double NULL) */ + buffer[i++] = 0x00; buffer[i++] = 0x00; buffer[i++] = 0x00; + /* and reference the environment */ + envbuf = buffer; while (*envbuf) envbuf++; envbuf++; + + /* remove trailing line breaks and white space */ + i = strlen(buffer) - 1; + while (i >= 0 && + (buffer[i] == '\n' || buffer[i] == '\r' + || buffer[i] == ' ')) buffer[i--] = 0x00; + + /* remove CTRLs and canonicalize line breaks */ + for (p = q = buffer; *p != 0x00; p++) + { + if (*p < '\r') *q++ = ' '; + if (*p < ' ' && *p != '\t') *q++ = '.'; + else *q++ = *p; + } + + /* now write the message text */ + errno = 0; + sprintf(outbuf,"From %s(%s): %s", + envget(envbuf,"MSGHOST"),envget(envbuf,"MSGUSER"),buffer); +/* + sprintf(outbuf,"From %s@%s: %s", + envget(envbuf,"MSGUSER"),envget(envbuf,"MSGHOST"),buffer); + */ + if (putline(1,outbuf) < 0) break; + } + (void) close(fd); + } + (void) perror(buffer); /* argv[0]? */ +/* + (void) sprintf(buffer,"xmitmsg -2 -a errno %d",errno); + (void) system(buffer); + */ + return 0; + } + + diff --git a/vmworkshop-vmarcs/1996/msg/msgcmsp.c b/vmworkshop-vmarcs/1996/msg/msgcmsp.c new file mode 100644 index 0000000..b11ad35 --- /dev/null +++ b/vmworkshop-vmarcs/1996/msg/msgcmsp.c @@ -0,0 +1,64 @@ +/* © Copyright 1994, 1996, Richard M. Troth, all rights reserved. + * (casita sourced) <plaintext> + * + * Name: msgcmsp.c + * part of multi-mode 'tell' command for UNIX + * Author: Rick Troth, Houston, Texas, USA + * Date: 1996-May-08 (split from tell.c) + */ + +/* #include <fcntl.h> */ +#include <errno.h> +#include "msghndlr.h" + +/* -------------------------------------------------------------- MSGMSP + * Try to send the message via MSP. See RFC 1312. + * This method should work even if the user is local, + * but requires an MSP server to be running (psbly under 'inetd'). + */ +int msgcmsp(user,text) + char *user, *text; + { + char *host, temp[256], *p, *q, buffer[BUFSIZ]; + int s, port; + extern char *userid(); + + /* parse */ + host = user; user = p = temp; + while (*host != '@' && *host != 0x00) *p++ = *host++; + if (*host == '@') host++; + if (host == 0x0000 || *host == 0x00) host = MSP_HOST; + port = MSP_PORT; + + /* try to contact the MSP server */ + errno = 0; + (void) sprintf(temp,"%s:%d",host,port); + s = tcpopen(temp,0,0); + if (s < 0) return s; + + /* build an MSP message structure */ + p = buffer; + *p++ = 'B'; /* use "type B" MSP structure */ + q = user; while (*q) *p++ = *q++; *p++ = 0x00; + q = "*"; while (*q) *p++ = *q++; *p++ = 0x00; + /* canonicalize text to CR/LF */ + q = text; while (*q) + { if (*q == '\n') *p++ = '\r'; + *p++ = *q++; } *p++ = 0x00; + q = userid(); while (*q) *p++ = *q++; *p++ = 0x00; + q = "?"; while (*q) *p++ = *q++; *p++ = 0x00; /* my terminal? */ + q = "-"; while (*q) *p++ = *q++; *p++ = 0x00; /* ticket */ + q = "-"; while (*q) *p++ = *q++; *p++ = 0x00; /* secure */ + *p++ = 0x00; + + /* send the message */ + (void) write(s,buffer,p-buffer); + (void) read(s,buffer,BUFSIZ); + + /* clean up */ + (void) close(s); + + return 0; + } + + diff --git a/vmworkshop-vmarcs/1996/msg/msgcuftd.c b/vmworkshop-vmarcs/1996/msg/msgcuftd.c new file mode 100644 index 0000000..83185a5 --- /dev/null +++ b/vmworkshop-vmarcs/1996/msg/msgcuftd.c @@ -0,0 +1,107 @@ +/* © Copyright 1994, 1996, Richard M. Troth, all rights reserved. + * (casita sourced) <plaintext> + * + * Name: msgcuftd.c + * part of multi-mode 'tell' command for UNIX + * (message client talking to UFT daemon) + * Author: Rick Troth, Rice University, Houston, Texas, USA + * Date: 1994-Jul-25 and prior, 1996-May-09 (split from tell.c) + */ + +#include <errno.h> +#include "msghndlr.h" + +/* ------------------------------------------------------------- MSGUFTD + * That's UFTD, not just UFT, because messaging isn't part of + * UFT protocol, but may be a feature of some UFTD servers. + */ +int msgcuftd(user,text) + char *user, *text; + { + char temp[256], ubuf[64], *host; + int port, rc, s; + + /* parse */ + host = user; user = ubuf; + while (*host != '@' && *host != 0x00) *user++ = *host++; + if (*host == '@') host++; *user = 0x00; user = ubuf; + if (host == 0x0000 || *host == 0x00) host = MSG_DEFAULT_HOST; + port = MSG_UFT_PORT; + + /* try to contact the UFT server */ + errno = 0; + (void) sprintf(temp,"%s:%d",host,port); + s = tcpopen(temp,0,0); + if (s < 0) return s; + + /* wait on a UFT/1 or UFT/2 herald */ + (void) tcpgets(s,temp,sizeof(temp)); + + /* now try a UFT "MSG" command, if available */ + (void) sprintf(temp,"MSG %s %s",user,text); + (void) tcpputs(s,temp); + + /* wait for ACK/NAK */ + rc = uftcwack(s,temp,sizeof(temp)); + + /* say goodbye politely */ + (void) tcpputs(s,"QUIT"); + (void) uftcwack(s,temp,sizeof(temp)); + + /* return cleanly */ + (void) close(s); + return rc; + } + +/* ------------------------------------------------------------ UFTCWACK + */ +int uftcwack(s,b,l) + int s; char *b; int l; + { + int i; + char *p; + + while (1) + { + errno = 0; + i = tcpgets(s,b,l); + if (i < 0) + { + /* broken pipe or network error */ + b[0] = 0x00; + return i; + } + switch (b[0]) + { + case 0x00: + /* NULL ACK */ + (void) strncpy(b,"2XX ACK (NULL)",l); + return 0; + case '6': + /* write to stdout, then loop */ + p = b; + while (*p != ' ' && *p != 0x00) p++; + if (*p != 0x00) (void) putline(1,++p); + case '1': case '#': case '*': + /* discard and loop */ + break; + case '2': case '3': + /* simple ACK or "more required" */ + return 0; + case '4': case '5': + /* "4" means client is confused anyway, + and "5" means a hard error, so ... */ + return -1; + default: + /* protocol error */ + return -1; + } +/* + if (uftcflag & UFT_VERBOSE) + if (b[0] != 0x00) + (void) putline(2,b); + */ + } + } + + diff --git a/vmworkshop-vmarcs/1996/msg/msgd.c b/vmworkshop-vmarcs/1996/msg/msgd.c new file mode 100644 index 0000000..2915d29 --- /dev/null +++ b/vmworkshop-vmarcs/1996/msg/msgd.c @@ -0,0 +1,165 @@ +/* © Copyright 1995, Richard M. Troth, all rights reserved. <plaintext> + * (casita sourced) + * + * Name: msgd.c + * a simplistic MSP server using $HOME/.msgpipe FIFO + * Author: Rick Troth, Houston, Texas, USA + * Date: 1995-Oct-27 and prior + */ + +#include <errno.h> +#include <fcntl.h> +#include <pwd.h> +#include <sys/types.h> +#include <sys/stat.h> + +#include "msghndlr.h" + +/* ------------------------------------------------------------------ */ +int main(argc,argv) + int argc; + char *argv[]; + { + char buff[BUFSIZ], temp[BUFSIZ], idnt[BUFSIZ]; + char *p, *user, *term, *text, *from, *ftty, + *time, *sqty, *host, *arg0; + int i, fd, msg_flag; + struct passwd *pwdent; + char pipe[256]; + + arg0 = argv[0]; + + msg_flag = MSG_IDENT; + /* process options */ + for (i = 1; i < argc && argv[i][0] == '-' && + argv[i][1] != 0x00; i++) + { + switch (argv[i][1]) + { + case 'v': (void) sprintf(temp, + "%s: %s Internet TELL server", + arg0,MSG_VERSION); + (void) putline(2,temp); + return 0; + break; + case 'n': msg_flag = (msg_flag & ~MSG_IDENT); + break; + case 'i': msg_flag = (msg_flag | MSG_IDENT); + break; + default: (void) sprintf(temp, + "%s: invalid option %s", + arg0,argv[i]); + (void) putline(2,temp); + return 20; + break; + } + } + + /* read the MSP data from the client */ + read(0,buff,BUFSIZ); + p = buff; + user = term = text = ""; + switch (*p++) + { + case 'A': user = p; while (*p) p++; p++; + term = p; while (*p) p++; p++; + text = p; while (*p) p++; + break; + case 'B': user = p; while (*p) p++; p++; + term = p; while (*p) p++; p++; + text = p; while (*p) p++; p++; + from = p; while (*p) p++; p++; + ftty = p; while (*p) p++; p++; + time = p; while (*p) p++; p++; + sqty = p; while (*p) p++; + break; + default: break; + } + + /* maybe try an IDENT lookup? */ + if (msg_flag & MSG_IDENT) (void) tcpident(0,idnt,sizeof(idnt)); + host = idnt; + while (*host != 0x00 && *host != '@') host++; + if (*host == '@') *host++ = 0x00; + /* trust IDENT's user value (if available) over MSP's */ + if (idnt[0] != 0x00) user = idnt; + + /* clean-up the target username for security */ + for (p = user; *p != 0x00 && *p >= ' ' && + *p != '|' && *p != ';' && + *p != '/' && *p != '*' && + *p != '$' && *p != '\\'; p++); *p = 0x00; + if (*user == 0x00) user = "operator"; + + /* compute the message pipe path */ + pwdent = getpwnam(user); + if (pwdent) sprintf(pipe,"%s/.msgpipe",pwdent->pw_dir); + else (void) sprintf(pipe,"/home/%s/.msgpipe",user); + + /* try opening message pipe FIFO */ + fd = open(pipe,O_WRONLY|O_NDELAY); + if (fd < 0 && errno == ENOENT) + { + (void) sprintf(pipe,"/tmp/%s.msgpipe",user); + fd = open(pipe,O_WRONLY|O_NDELAY); + } + if (fd < 0 && errno == ENOENT) + { + /* try creating the FIFO; world writable, yes! */ + (void) mknod(pipe,S_IFIFO|0622,0); + } + if (fd < 0 && errno == ENXIO) + { + /* launch default message handler */ + (void) sprintf(temp,"msgcat -u '%s'",user); + (void) system(temp); + /* see if that worked */ + fd = open(pipe,O_WRONLY|O_NDELAY); + } + if (fd < 0) + { + /* everything failed; bail out */ + sprintf(temp,"-%d (UNIX or POSIX ERRNO)",errno); + write(1,temp,strlen(temp)+1); + return fd; + } + + /* build the buffer; begin at offset zero */ + i = 0; + + /* copy the message text */ + p = text; while (*p) temp[i++] = *p++; temp[i++] = 0x00; + + /* now environment variables; first, who from? */ + p = "MSGFROM="; while (*p) temp[i++] = *p++; + p = from; while (*p) temp[i++] = *p++; temp[i++] = 0x00; + + /* what type of message? (MSP if by way of this server) */ + p = "MSGTYPE=MSP/"; while (*p) temp[i++] = *p++; + temp[i++] = buff[0]; temp[i++] = 0x00; + + /* also ... who's it too? (in case that isn't obvious) */ + p = "MSGUSER="; while (*p) temp[i++] = *p++; + p = user; while (*p) temp[i++] = *p++; temp[i++] = 0x00; + + /* what about the sender's HOST address? */ + p = "MSGHOST="; while (*p) temp[i++] = *p++; + p = host; while (*p) temp[i++] = *p++; temp[i++] = 0x00; + + /* an additional NULL terminates the environment buffer */ + temp[i++] = 0x00; + + /* hand it off; feed the FIFO (hoping there's a listener) */ + (void) write(fd,temp,i); + + /* all done, so close the file descriptor */ + (void) close(fd); + + /* tell the client "okay" */ + write(1,"+",1); + + /* get outta here */ + return 0; + } + + diff --git a/vmworkshop-vmarcs/1996/msg/msgd.direct b/vmworkshop-vmarcs/1996/msg/msgd.direct new file mode 100644 index 0000000..ac4001f --- /dev/null +++ b/vmworkshop-vmarcs/1996/msg/msgd.direct @@ -0,0 +1,10 @@ +USER MSGD password 4M 12M GB 64 MSG00010 +* Note: MSGD will probably run fine in 2M or even less MSG00020 + INCLUDE CMS MSG00030 + ACIGROUP gggggggg MSG00040 +*:name.TCP/IP Message Send server :list.TCPMAINT MSG00050 + ACCOUNT aaaaaaaa dddd MSG00060 +* Note: the PROFILE EXEC on TCPMAINT 591 calls MSGD for this SVM. MSG00070 + LINK TCPMAINT 591 191 RR MSG00080 + LINK TCPMAINT 592 192 RR MSG00090 +* MSG00100 diff --git a/vmworkshop-vmarcs/1996/msg/msgd.exec b/vmworkshop-vmarcs/1996/msg/msgd.exec new file mode 100644 index 0000000..0291a5d --- /dev/null +++ b/vmworkshop-vmarcs/1996/msg/msgd.exec @@ -0,0 +1,369 @@ +/* © Copyright 1995, Richard M. Troth, all rights reserved. <plaintext> + * + * Name: MSGD EXEC + * CMS MessageD TCP/IP (RFC 1312) message receiver + * Author: Rick Troth, Houston, Texas, USA + * Date: 1992-May-27, Jun-03, Jun-29, 1993-Feb-24 + * + * Note: the one line that would enable the asterisk ('*') + * for "all users" is commented out, because most sites + * will probably *not* want such exposure. + * + * Changes: + * 1993-Feb-24: Converted to use REXX/Sockets (RXSOCKET version 2). RMT + * 1993-Aug-21: Present remote hostname in lower case. RMT + */ + +Address "COMMAND" + +progid = "CMS MessageD 1.2.2" + +Parse Upper Arg port . '(' . ')' . + +If port = "" Then port = "18" + +If ^Datatype(port,'N') Then Do + Say "TCP/IP service port must be numeric." + Exit 24 + End /* If .. Do */ + +Say progid "starting" + + stdin = 0 + stdout = 1 + stderr = 2 + +/* + * Verify REXX/Sockets (RXSOCKET version 2). + */ +Parse Value Socket("VERSION") With rc . ver . +If ver < 2 Then Do + Say progid "requires REXX/Sockets (RXSOCKET version 2)" + Exit -1 + End /* If .. Do */ + +/* + * Initialize REXX/Sockets. + */ +Parse Value Socket("INITIALIZE", "MessageD") With rc . maxdesc . +If rc ^= 0 Then Do + Say tcperror() + Exit rc + End /* If .. Do */ +Say "REXX/Sockets initialized for" maxdesc "descriptors" + +/* + * Request a new socket descriptor (TCP protocol). + */ +Parse Value Socket("SOCKET", "AF_INET", "SOCK_STREAM") , + With rc tcp +If rc ^= 0 Then Do + Say tcperror() + Exit rc + End /* If .. Do */ +Say "TCP socket =" tcp + +/* + * Set this socket to non-blocking mode. + */ +Parse Value Socket("IOCTL", tcp, "FIONBIO", "ON") With rc . +If rc ^= 0 Then Do + Say tcperror() + Exit rc + End /* If .. Do */ + +/* + * Bind to port 18. + */ +Parse Value Socket("BIND", tcp, "AF_INET" port) With rc . +If rc ^= 0 Then Do + Say tcperror() + Exit rc + End /* If .. Do */ +Say "Socket" tcp "bound to port" port + +/* + * Set the socket to listen for new connections. + */ +Parse Value Socket("LISTEN", tcp, maxdesc) With rc . +If rc ^= 0 Then Do + Say tcperror() + Exit rc + End /* If .. Do */ + +/* + * Request a new socket descriptor (UDP protocol). + */ +Parse Value Socket("SOCKET", "AF_INET", "SOCK_DGRAM") With rc udp . +If rc ^= 0 Then Do + Say tcperror() + Exit rc + End /* If .. Do */ +Say "UDP socket =" udp + +/* + * Set this socket to non-blocking mode. + */ +Parse Value Socket("IOCTL", udp, "FIONBIO", "ON") With rc . +If rc ^= 0 Then Do + Say tcperror() + Exit rc + End /* If .. Do */ + +/* + * Bind to the right IP port. + */ +Parse Value Socket("BIND", udp, "AF_INET" port) With rc . +If rc ^= 0 Then Do + Say tcperror() + Exit rc + End /* If .. Do */ +Say "Socket" udp "bound to port" port + +/* + * Enable ASCII <---> EBCDIC translation option. + */ +Parse Value Socket("SETSOCKOPT", udp, "SOL_SOCKET", "SO_ASCII", "ON") , + With rc . +If rc ^= 0 Then Do + Say tcperror() + Exit rc + End /* If .. Do */ + +Say progid "waiting for a connection" + +Do Forever + + Say "*" /* waiting */ + + Parse Value Socket("SELECT", "READ" tcp udp stdin) , + With rc ec "READ" rl "WRITE" wl "EXCEPTION" xl + If rc ^= 0 Then Leave + + If Find(rl,tcp) > 0 Then Call READ_TCP(tcp) + If Find(rl,udp) > 0 Then Call READ_UDP(udp) + If Find(rl,stdin) > 0 Then Leave + + End /* Do Forever */ + +/* + * Close primary TCP socket. + */ +Parse Value Socket("CLOSE", tcp) With rc . +If rc ^= 0 Then Say tcperror() + +/* + * Close the UDP socket. + */ +Parse Value Socket("CLOSE", udp) With rc . +If rc ^= 0 Then Say tcperror() + +/* + * Tell REXX/Sockets that we are done with this IUCV path. + */ +Parse Value Socket("TERMINATE") With rc . +If rc ^= 0 Then Say tcperror() + +Exit + + + +/* ------------------------------------------------------------ READ_TCP + * Read packets from a TCP connection. + */ +READ_TCP: Procedure +Parse Arg tcp + +/* + * Accept this inbound connection. + */ +Parse Value Socket("ACCEPT", tcp) With rc tcp client +If rc ^= 0 Then Do + Say "READ_TCP:" tcperror() + Return + End /* If .. Do */ +Say "READ_TCP: accepted" tcp "at" Time() +Say "READ_TCP: client" client + +/* + * Resolve remote hostname (if we can). + */ +Parse Var client . . cipa +Parse Value Socket("RESOLVE", cipa) With rc RemoteAddress RemoteHost . +If rc ^= 0 Then Do + Say "READ_TCP:" tcperror() + RemoteAddress = cipa + RemoteHost = cipa + End /* If .. Do */ +Else Do + Say "READ_TCP: Remote host looks like" RemoteHost + Say "READ_TCP: Accepted" tcp "from" RemoteHost "at" Time() + End /* Else Do */ + +/* + * Enable ASCII <---> EBCDIC translation option. + */ +Parse Value Socket("SETSOCKOPT", tcp, "SOL_SOCKET", "SO_ASCII", "ON") , + With rc . +If rc ^= 0 Then Do + Say "READ_TCP:" tcperror() + Parse Value Socket("CLOSE", tcp) With . + Return + End /* If .. Do */ + +/* + * Loop, reading message(s) from the client. + */ +Do Forever + + /* + * Read a packet from the client. + */ + Parse Value Socket("READ", tcp, 4096) With rc bc pack + If rc ^= 0 Then Do + Say "READ_TCP:" tcperror() + Parse Value Socket("CLOSE", tcp) With . + Return + End /* If .. Do */ + If bc < 1 Then Leave + + /* + * Process the MSP message packet. + */ + Parse Var pack ver +1 . + Say "READ_TCP: Protocol version" ver + Select /* ver */ + When ver = 'A' Then rs = reva(pack) + When ver = 'B' Then rs = revb(pack) + Otherwise rs = "unknown protocol version" ver + End /* Select ver */ + + /* + * Send some reply back to the client. + */ + If rs = "" Then rs = '+' /* ACK */ + Else Say "READ_TCP: Reply" rs + Parse Value Socket("WRITE", tcp, rs || '00'x) With rc bc . + If rc ^= 0 Then Do + Say "READ_TCP:" tcperror() + Parse Value Socket("CLOSE", tcp) With . + Return + End /* If .. Do */ + If bc < 1 Then Leave + + End /* Do Forever */ + +/* + * All done, relinquish our socket descriptor. + */ +Parse Value Socket("CLOSE", tcp) With rc . +If rc ^= 0 Then Do + Say "READ_TCP:" tcperror() + Return + End /* If .. Do */ +Say "READ_TCP: Closed" tcp "at" Time() + +Return + + + +/* ------------------------------------------------------------ READ_UDP + * Read packets as UDP datagrams. + */ +READ_UDP: Procedure Expose ticket. +Parse Arg udp + +Parse Value Socket("RECVFROM", udp, 512) With rc afam sock cipa bc pack +If rc ^= 0 Then Do + Say "READ_UDP:" tcperror() + Return + End /* If .. Do */ +If bc < 1 Then Return +Say "READ_UDP: client" afam sock cipa + +Say "READ_UDP: client's IP address is" cipa +Parse Value Socket("RESOLVE", cipa) With rc RemoteAddress RemoteHost . +If rc ^= 0 Then Do + Say "READ_UDP:" tcperror() + Return + End /* If .. Do */ +Say "READ_UDP: remote host looks like" RemoteHost + + Parse Var pack ver +1 . + Say "READ_UDP: Protocol version" ver + Select /* ver */ + When ver = 'A' Then rs = reva(pack) + When ver = 'B' Then rs = revb(pack) + Otherwise rs = "unknown protocol version" ver + End /* Select ver */ + + If rs = "" Then rs = '00'x + Else Say "READ_UDP: reply" rs +/* bc = Socket('SendTo', udp, rs, 0, client) + If bc = "-1" Then Do + Say "RXSOCKET subfunction SENDTO returned error" errno + Leave + End */ + +Return + + + +/* ---------------------------------------------------------------- REVA + * Handle a Message Send Protocol "revision A" packet. + */ +REVA: Procedure Expose RemoteHost +Parse Arg data +'PIPE VAR REMOTEHOST | XLATE LOWER | VAR REMOTEHOST' + +Parse Var data ver +1 data +Parse Var data user '00'x data; Upper user +Parse Var data term '00'x data +Parse Var data text '00'x data +Parse Value Diagrc(08,'MSGNOH' user "From" , + RemoteHost || ":" text) With 1 rc 10 . 17 rs '15'x . +Say "REVA: leftover data:" data + +Return rs + + + +/* ---------------------------------------------------------------- REVB + * Handle a Message Send Protocol "revision B" packet. + */ +REVB: Procedure Expose RemoteHost ticket. +Parse Arg data +'PIPE VAR REMOTEHOST | XLATE LOWER | VAR REMOTEHOST' + +Parse Var data +1 data /* skip past protocol version byte */ +Parse Var data LocalUser '00'x data; Upper LocalUser +Parse Var data LocalTerminal '00'x data /* not useable */ +Parse Var data MessageText '00'x data +Parse Var data RemoteUser '00'x data +Parse Var data RemoteTerminal '00'x data /* not used */ +Parse Var data ticket '00'x data +Parse Var data secure '00'x data +/* remainder of packet is ignored */ + +If ticket.LocalUser = ticket Then Return '-' || "DUP_OF" ticket +from = "From" RemoteHost || "(" || RemoteUser || "):" + +Parse Value Diagrc(08,'QUERY USER' LocalUser) With , + 1 rc 10 . 17 rs '15'x . +If rc ^= 0 Then Return '-' || rs +/* If LocalUser = '*' Then LocalUser = "ALL" */ + +Do While MessageText ^= "" + Parse Var MessageText text '25'x MessageText + Parse Var text text '0D'x . + Parse Value Diagrc(08,'MSGNOH' LocalUser from text) With , + 1 rc 10 . 17 rs '15'x . + If rc = 1 | rc = -1 Then + Parse Value Diagrc(08,'MSG' LocalUser from text) With , + 1 rc 10 . 17 rs '15'x . + If rc = 0 Then ticket.LocalUser = ticket + Else Return '-' || rs + End /* Do While */ + +Return "" + diff --git a/vmworkshop-vmarcs/1996/msg/msghndlr.h b/vmworkshop-vmarcs/1996/msg/msghndlr.h new file mode 100644 index 0000000..bf487f5 --- /dev/null +++ b/vmworkshop-vmarcs/1996/msg/msghndlr.h @@ -0,0 +1,29 @@ +/* © Copyright 1996, Richard M. Troth, all rights reserved. <plaintext> + * (casita sourced) + * + * Name: msghndlr.h + * header file for msgd.c and msgcat.c + * Author: Rick Troth, Houston, Texas, USA + * Date: 1994-Jul-26, 1996-Mar-24 + */ + +#define MSG_VERSION "MSG/1.3.0" + +#define MSG_IDENT 0x0001 +#define MSG_VERBOSE 0x0002 + +#define MSP_HOST "localhost" +#define MSG_DEFAULT_HOST "localhost" +#define MSP_PORT 18 +#define MSG_MSP_PORT 18 + +#define MSG_UFT_PORT 608 + +#ifndef BUFSIZ +#define BUFSIZ 4096 +#endif + +static char *msg_copyright = + "© Copyright 1996, Richard M. Troth, all rights reserved. "; + + diff --git a/vmworkshop-vmarcs/1996/msg/msglocal.c b/vmworkshop-vmarcs/1996/msg/msglocal.c new file mode 100644 index 0000000..77c6c3c --- /dev/null +++ b/vmworkshop-vmarcs/1996/msg/msglocal.c @@ -0,0 +1,72 @@ +/* © Copyright 1994, 1996, Richard M. Troth, all rights reserved. + * (casita sourced) <plaintext> + * + * Name: msglocal.c + * a multi-mode 'tell' command for UNIX + * Author: Rick Troth, Houston, Texas, USA + * Date: 1994-Jul-25 and prior + */ + +#include <fcntl.h> +#include <errno.h> +#include "msghndlr.h" + +/* ------------------------------------------------------------- HOMEDIR + * Attempt to write the message directly to the user's ".msgpipe". + */ +#include <pwd.h> +char *homedir(u) + char *u; + { + struct passwd *pwdent; + static char failsafe[256]; + pwdent = getpwnam(u); + if (pwdent) return pwdent->pw_dir; + (void) sprintf(failsafe,"/home/%s",u); + return failsafe; + } + +/* ------------------------------------------------------------ MSGLOCAL + */ +int msglocal(user,text) + char *user, *text; + { + int fd; + char temp[256]; + + (void) sprintf(temp,"%s/.msgpipe",homedir(user)); + fd = open(temp,O_WRONLY|O_NDELAY); +/* if (fd < 0 && errno == ENOENT) + then 'mknod' with 622 perms (writable */ + if (fd < 0 && errno == ENXIO) + { + /* launch our special application */ + fd = open(temp,O_WRONLY|O_NDELAY); + } + if (fd < 0) return fd; + + (void) write(fd,text,strlen(text)); + (void) close(fd); + + return 0; + } + +/* + O_NDELAY When opening a FIFO (named pipe - see + mknod(2V)) with O_RDONLY or O_WRONLY set: + + If O_NDELAY is set: + An open() for reading-only returns + without delay. An open() for writing- + only returns an error if no process + currently has the file open for reading. + + If O_NDELAY is clear: + A call to open() for reading-only blocks + until a process opens the file for writ- + ing. A call to open() for writing-only + blocks until a process opens the file + for reading. + */ + + diff --git a/vmworkshop-vmarcs/1996/msg/putline.c b/vmworkshop-vmarcs/1996/msg/putline.c new file mode 100644 index 0000000..33be7ca --- /dev/null +++ b/vmworkshop-vmarcs/1996/msg/putline.c @@ -0,0 +1,27 @@ +/* ------------------------------------------------------------- PUTLINE + * Name: PUTLINE/UFTXPUTS + * common Put String function + * Operation: Writes the NULL terminated string from buffer b + * to socket s with NL (UNIX text) line termination. + * Author: Rick Troth, Ithaca, NY / Houston, TX (METRO) + * Date: 1993-Sep-19, Oct-20 + * + * See also: getline.c, netline.c + */ +int putline(s,b) + int s; + char *b; + { + int i, j; + char temp[4096]; + +/* i = strlen(b); */ + for (i = 0; b[i] != 0x00; i++) temp[i] = b[i]; + temp[i] = '\n'; + j = write(s,temp,i+1); +/* b[i] = 0x00; */ + + if (j != i+1) return -1; + return i; + } + diff --git a/vmworkshop-vmarcs/1996/msg/tcpio.c b/vmworkshop-vmarcs/1996/msg/tcpio.c new file mode 100644 index 0000000..cb6bd22 --- /dev/null +++ b/vmworkshop-vmarcs/1996/msg/tcpio.c @@ -0,0 +1,374 @@ +/* © Copyright 1995, Richard M. Troth, all rights reserved. <plaintext> + * + * Name: tcpiolib.c + * various TCP utility functions + * Author: Rick Troth, Houston, Texas, USA + * Date: 1995-Apr-19 + */ + +#include <sys/types.h> +#include <sys/socket.h> +#include <stdio.h> +#include <netdb.h> + +#define TCPSMALL 256 +#define TCPLARGE 4096 + +int tcp_ubuf[TCPLARGE]; +int tcp_uoff, tcp_uend; +char tcp_umsg[TCPSMALL]; + +/* ------------------------------------------------------------- TCPOPEN + * Tries to mimick open(path,flags[,mode]) + * but connects to a TCP port, not a local file. + */ +int tcpopen(host,flag,mode) + char *host; int flag; int mode; + { + int s, i, port, rc, j; + struct sockaddr name; + struct hostent *hent, myhent; + char *myhental[2], myhenta0[4], myhenta1[4]; + char temp[TCPSMALL], *p, *q; + + /* parse host address and port number by colon */ + p = host; host = temp; i = 0; + while (i < TCPSMALL && *p != 0x00 && *p != ':') + host[i++] = *p++; host[i++] = 0x00; + if (*p != ':') port = 0; + else + { + p++; q = p; + while (i < TCPSMALL && *q != 0x00 && *q != ':') + temp[i++] = *q++; temp[i++] = 0x00; + port = atoi(p); + } + + /* figure out where to connect */ + hent = gethostbyname(host); + if (hent == NULL) + { + /* netDB lookup failed; numeric address supplied? */ + p = host; + if (*p < '0' || '9' < *p) return -1; + hent = &myhent; + hent->h_addr_list = myhental; /* address list */ + hent->h_addr_list[0] = myhenta0; /* address 0 */ + hent->h_addr_list[1] = myhenta1; /* address 1 */ + hent->h_addrtype = AF_INET; + hent->h_length = 4; + + /* try to pick-apart the string as dotted decimal */ + hent->h_addr_list[0][0] = atoi(p); + while (*p != '.' && *p != 0x00) p++; p++; + if (*p < '0' || '9' < *p) return -1; + hent->h_addr_list[0][1] = atoi(p); + while (*p != '.' && *p != 0x00) p++; p++; + if (*p < '0' || '9' < *p) return -1; + hent->h_addr_list[0][2] = atoi(p); + while (*p != '.' && *p != 0x00) p++; p++; + if (*p < '0' || '9' < *p) return -1; + hent->h_addr_list[0][3] = atoi(p); + + /* dotted decimal worked! now terminate the list */ + hent->h_addr_list[1][0] = 0; hent->h_addr_list[1][1] = 0; + hent->h_addr_list[1][2] = 0; hent->h_addr_list[1][3] = 0; + /* better form might be to use NULL pointer? */ + hent->h_addr_list[1] = NULL; + + /* and what else do we need to set? */ + hent->h_name = host; + /* should probably call gethostbyaddr() + at this point; maybe in the next rev */ + } + + /* gimme a socket */ + s = socket(AF_INET,SOCK_STREAM,0); + if (s < 0) return s; + + /* build that structure */ + name.sa_family = AF_INET; + name.sa_data[0] = (port >> 8) & 0xFF; + name.sa_data[1] = port & 0xFF; + + /* try address one-by-one */ + for (i = 0; hent->h_addr_list[i] != NULL; i++) + { + /* any more addresses? */ + if (hent->h_addr_list[i] == NULL) break; + if (hent->h_addr_list[i][0] == 0x00) break; + + /* fill-in this address to the structure */ + for (j = 0; j < hent->h_length; j++) + name.sa_data[j+2] = hent->h_addr_list[i][j]; + name.sa_data[j+2] = 0x00; /* terminate */ + + /* note this attempt */ + (void) sprintf(tcp_umsg,"trying %d.%d.%d.%d\n",name.sa_data[2], + name.sa_data[3],name.sa_data[4],name.sa_data[5]); + + /* can we talk? */ + rc = connect(s, &name, 16); + if (rc == 0) return s; + } + + /* can't seem to reach this host on this port :-( */ + (void) close(s); + if (rc < 0) return rc; + return -1; + } + +/* ------------------------------------------------------------ TCPCLOSE + */ +int tcpclose(fd) + int fd; + { + return close(fd); + } + +/* ------------------------------------------------------------- TCPGETS + * Operation: Reads a CR/LF terminated string from socket s + * into buffer b. Returns the length of that string. + * Author: Rick Troth, Houston, Texas, USA + * Date: 1995-Apr-19 + * + * See also: getline.c, putline.c, netline.c + */ +int tcpgets(s,b,l) + int s; char *b; int l; + { + char *p; + int i; + + p = b; + for (i = 0; i < l; i++) + { + if (read(s,p,1) != 1) /* get a byte */ + if (read(s,p,1) != 1) return -1; /* try again */ + if (*p == '\n') break; /* NL terminates */ + if (*p == 0x00) break; /* NULL terminates */ +/* if (*p == '\t') *p = ' '; ** [don't] eliminate TABs */ + p++; /* increment pointer */ + } + *p = 0x00; /* NULL terminate, even if NULL */ + + if (i > 0 && b[i-1] == '\r') /* trailing CR? */ + { + i = i - 1; /* shorten length by one */ + p--; /* backspace */ + *p = 0x00; /* remove trailing CR */ + } + + tcp_uoff = 0; + tcp_uend = 0; + return i; + } + +/* ------------------------------------------------------------- TCPPUTS + * Operation: Writes the NULL terminated string from buffer b + * to socket s with CR/LF (network text) line termination. + * Author: Rick Troth, Houston, Texas, USA + * Date: 1995-Apr-19 + * + * See also: getline.c, putline.c, netline.c + */ +int tcpputs(s,b) + int s; + char *b; + { + int i, j; + char temp[4096]; + + for (i = 0; b[i] != 0x00; i++) temp[i] = b[i]; + temp[i+0] = '\r'; + temp[i+1] = '\n'; + j = write(s,temp,i+2); + + if (j != i+2) return -1; + return i; + } + +/* ------------------------------------------------------------ TCPWRITE + */ +int tcpwrite(fd,s,n) + int fd; char *s; int n; + { + return write(fd,s,n); + } + +/* ------------------------------------------------------------- TCPREAD + */ +int tcpread(fd,s,n) + int fd; char *s; int n; + { + return read(fd,s,n); + } + +/* ------------------------------------------------------------ TCPIDENT + * + * Name: tcpident.c + * who's on the other end of this TCP socket? + * Author: Rick Troth, Rice University, Information Systems + * Date: 1995-Apr-19 + * + * This is the part that was done on Rice time, + * prompting the "R" in the version string. + * It was to shore-up the last requirements + * for the implementation that Rice might keep. + * Sadly (to me) someone yanked it (UFT entirely) + * the very first day I was gone. + */ + +#ifndef NULL +#define NULL 0x0000 +#endif + +#define HOST_BSZ 128 +#define USER_BSZ 64 +#define TEMP_BSZ 256 + +#define IDENT_PORT 113 + +/* ------------------------------------------------------------ TCPIDENT + */ +int tcpident(sock,buff,size) + int sock; char *buff; int size; + { + struct sockaddr sadr; + struct hostent *hent; + int i, rc, slen, styp, soff; + char temp[TEMP_BSZ]; + char hadd[16]; /* is that enough? */ + char host[HOST_BSZ]; + char user[USER_BSZ]; + int plcl, prmt; + char *p; + +/* +(void) netline(2,">>>>>>>>"); + */ + + /* preload a few storage areas */ + host[0] = 0x00; + user[0] = 0x00; + + /* first, tell me about this end */ + slen = sizeof(sadr); + rc = getsockname(sock,&sadr,&slen); + if (rc != 0) + { +/* perror("getsockname()"); */ + if (rc < 0) return rc; + else return -1; + } + styp = sadr.sa_family; + + /* where's the offset into the address? */ + switch (styp) + { + case AF_INET: soff = 2; slen = 4; + break; + default: soff = 2; + break; + } + + /* and snag that port number */ + plcl = 0; + for (i = 0; i < soff; i++) + plcl = (plcl << 8) + (sadr.sa_data[i] & 0xFF); + +/* +(void) sprintf(temp,"PORT=%d (mine)",plcl); +(void) netline(2,temp); + */ + + /* what's the host on the other end? */ + slen = sizeof(sadr); + rc = getpeername(sock,&sadr,&slen); + if (rc != 0) + { +/* perror("getpeername()"); */ + if (rc < 0) return rc; + else return -1; + } + styp = sadr.sa_family; + + /* where's the offset into the address? */ + switch (styp) + { + case AF_INET: soff = 2; slen = 4; + break; + default: soff = 2; + break; + } + + /* now copy the address */ + for (i = 0; i < slen; i++) + hadd[i] = sadr.sa_data[i+soff]; + + /* and snag that port number */ + prmt = 0; + for (i = 0; i < soff; i++) + prmt = (prmt << 8) + (sadr.sa_data[i] & 0xFF); + +/* +(void) sprintf(temp,"PORT=%d (yours)",prmt); +(void) netline(2,temp); + */ + + /* what host is at that address? */ + hent = gethostbyaddr(hadd,slen,styp); + if (hent == NULL) + { +/* perror("gethostbyaddr()"); */ + if (rc < 0) return rc; + else return -1; + } + strncpy(host,hent->h_name,HOST_BSZ); /* keep it */ + host[HOST_BSZ-1] = 0x00; /* safety net */ + +/* +(void) sprintf(temp,"HOST=%s (yours)",host); +(void) netline(2,temp); + */ + + /* try a little IDENT client/server action */ + (void) sprintf(temp,"%s:%d",host,IDENT_PORT); + sock = tcpopen(temp,0,0); + if (sock >= 0) + { + /* build and send the IDENT request */ + (void) sprintf(temp,"%d , %d",prmt,plcl); +/* (void) netline(sock,temp); */ + (void) tcpputs(sock,temp); +/* (void) getline(sock,temp,TEMP_BSZ); */ + (void) tcpgets(sock,temp,TEMP_BSZ); +/* (void) netline(1,temp); */ + + for (p = temp; *p != 0x00 && *p != ':'; p++); + if (*p == ':') + { + p++; + while (*p != 0x00 && *p <= ' ') p++; +/* (void) netline(2,p); */ + if (strncmp(p,"USERID",6) == 0) + { + while (*p != 0x00 && *p != ':') p++; + if (*p == ':') p++; + while (*p != 0x00 && *p != ':') p++; + if (*p == ':') p++; + while (*p != 0x00 && *p <= ' ') p++; + (void) strncpy(user,p,USER_BSZ); + } + } + } + + (void) sprintf(buff,"%s@%s",user,host); + +/* +(void) netline(2,"<<<<<<<<"); + */ + + return 0; + } + diff --git a/vmworkshop-vmarcs/1996/msg/tell.exec b/vmworkshop-vmarcs/1996/msg/tell.exec new file mode 100644 index 0000000..8ce6dbf --- /dev/null +++ b/vmworkshop-vmarcs/1996/msg/tell.exec @@ -0,0 +1,33 @@ +/* © Copyright 1995, Richard M. Troth, all rights reserved. <plaintext> + * + * Name: TELL EXEC + * an RSCS *and* TCP/IP based replacement for CMS TELL + * Author: Rick Troth, Houston, Texas, USA + * Date: 1992-May-27, Jun-05, Oct-27, Dec-09, 1993-Feb-24 + * 1995-May-02 + * + * Note: See RFC 1312 for details of the Message Send protocol. + * + * Co-reqs: TELL REXX, HOSTNAME EXEC, USERLIST REXX + */ + +Parse Upper Arg . at . + +If at = "AT" Then Do + Parse Arg user . node message + If message = "" Then , + 'PIPE CONSOLE ASYNCH | TELL' user 'AT' node '| CONSOLE' + Else , + 'PIPE VAR MESSAGE | TELL' user 'AT' node '| CONSOLE' + End /* If .. Do */ + +Else Do + Parse Arg user message + If message = "" Then , + 'PIPE CONSOLE ASYNCH | TELL' user '| CONSOLE' + Else , + 'PIPE VAR MESSAGE | TELL' user '| CONSOLE' + End /* Else Do */ + +Exit rc + diff --git a/vmworkshop-vmarcs/1996/msg/tell.helpcms b/vmworkshop-vmarcs/1996/msg/tell.helpcms new file mode 100644 index 0000000..f3c8426 --- /dev/null +++ b/vmworkshop-vmarcs/1996/msg/tell.helpcms @@ -0,0 +1,28 @@ +.cm Copyright 1993, Richard M. Troth +.cm + + TELL EXEC + + Use the TELL command to send interactive messages to other users + on this or other BITNET or InterNet connected computers. + + The format of the TELL command is: + +-------------------------------------+ + | | | + | TELL | user Ý[message]¨ | + | | | + +-------------------------------------+ + + where: + + user + is the user or nickname of a list of users + to whom you wish to send interactive messages + + message + is an optional one-line message + If the message is omitted, TELL puts your virtual machine + into "chat mode" such that all lines entered at the console + are sent to the specified user. Terminate by pressing ENTER + twice on a blank line (no input; Pipeline CONSOLE EOF). + diff --git a/vmworkshop-vmarcs/1996/msg/tell.rexx b/vmworkshop-vmarcs/1996/msg/tell.rexx new file mode 100644 index 0000000..fc0552d --- /dev/null +++ b/vmworkshop-vmarcs/1996/msg/tell.rexx @@ -0,0 +1,280 @@ +/* © Copyright 1995, Richard M. Troth, all rights reserved. <plaintext> + * + * Name: TELL REXX + * send interactive messages to other users + * Author: Rick Troth, Houston, Texas, USA + * Rick Troth, Houston, Texas, USA + * Date: 1993-Feb-24, and prior, 1993-Aug-27 + * 1995-May-02 + */ + +Parse Arg userlist +'CALLPIPE VAR USERLIST | USERLIST | STEM USER.' + +'CALLPIPE COMMAND IDENTIFY | VAR IDENTITY' +Parse Var identity userid . nodeid . rscsid . +'CALLPIPE VAR USERID | XLATE LOWER | VAR LOCALUSER' +localhost = hostname() + +Parse Value diag(08,'QUERY VIRTUAL CONSOLE') , + With . vaddr on type raddr term start . '15'x . +If on = "DISCONNECTED" Then localterm = "Not connected" + Else localterm = raddr + +'CALLPIPE COMMAND GLOBALV SELECT' "$" || Userid() , + 'LIST TELL | DROP | VAR OPTIONS' +Parse Var options . "MSGCMD" msg . +If msg = "" Then msg = "MSG" + +/* ---------------------------------------------------------------- TELL + */ +Do Forever + + 'PEEKTO MESSAGE' + If rc ^= 0 Then Leave + If Strip(message) = "." Then Leave + + Do i = 1 to user.0 + Parse Var user.i user '@' node + If user = "" Then Iterate + Select /* node */ + When node = "" Then Do + Upper user + Parse Value Diagrc(08, msg user message) , + With 1 rc 10 . 17 rs '15'x . + If rc ^= 0 & rs ^= "" Then 'OUTPUT' rs + End /* When .. Do */ + When Index(node,'.') = 0 Then Do + If user = '*' Then user = userid + If node = '*' Then node = nodeid + Upper user node + Parse Value Diagrc(08,'SMSG' rscsid 'MSG' , + node user message) With 1 rc 10 . 17 rs '15'x . + If rc ^= 0 & node = nodeid Then + Parse Value Diagrc(08, msg user message) , + With 1 rc 10 . 17 rs '15'x . + If rc ^= 0 & rs ^= "" Then 'OUTPUT' rs + End /* When .. Do */ + Otherwise Do + If user = '*' Then user = localuser + If node = '*' Then node = localhost + Call VIA_MSGD user, node, message + End /* Otherwise Do */ + End /* Select node */ + End /* Do For */ + + 'READTO' + + End /* Do Forever */ + +Exit rc * (rc ^= 12) + + + +/* ------------------------------------------------------------ VIA_MSGD + */ +VIA_MSGD: Procedure Expose localuser localterm +Parse Arg user, host, text +ver = 'B' +term = '*' +port = 18 + +/* + * Verify REXX/Sockets (RXSOCKET version 2). + */ +Parse Value Socket("VERSION") With rc . rv . +v1 = (rv < 2) + +/* + * Initialize RXSOCKET + */ +If v1 Then Do + maxdesc = Socket('Initialize', 'MessageC') + If maxdesc = "-1" Then Do + If errno ^= "ESUBTASKALREADYACTIVE" Then Do + Say tcperror() + Return -1 + End /* If .. Do */ + rc = Socket('Terminate') + maxdesc = Socket('Initialize', 'MessageC') + End /* If .. Do */ + If maxdesc = "-1" Then Do + Say tcperror() + Return -1 + End /* If .. Do */ + End /* If .. Do */ + +Else Do + Parse Value Socket("INITIALIZE", "MessageC") With rc errno maxdesc . + If rc ^= 0 Then Do + If errno ^= "ESUBTASKALREADYACTIVE" Then Do + Say tcperror() + Return rc + End /* If .. Do */ + Parse Value Socket("TERMINATE") With rc . + Parse Value Socket("INITIALIZE", "MessageC") With rc . maxdesc . + If rc ^= 0 Then Do + Say tcperror() + Return rc + End /* If .. Do */ + End /* If .. Do */ + End /* Else Do */ + +/* + * Get a socket descriptor (TCP protocol) + */ +If v1 Then Do + socket = Socket('Socket', 'AF_INET', 'Sock_Stream') + If socket = "-1" Then Return -1 + End /* If .. Do */ + +Else Do + Parse Value Socket("SOCKET", "AF_INET", "SOCK_STREAM") , + With rc socket . + If rc ^= 0 Then Do + Say tcperror() + Parse Value Socket("TERMINATE") With rc . + Return rc + End /* If .. Do */ + End /* Else Do */ + +/* + * Enable ASCII<->EBCDIC translation option + */ +If v1 Then Do + rc = Socket('SetSockOpt', socket, 'SOL_SOCKET', 'SO_EBCDIC', 1) + If rc = "-1" Then Return -1 + End /* If .. Do */ + +Else Do + Parse Value Socket("SETSOCKOPT", socket, "SOL_SOCKET", , + "SO_ASCII", "ON") With rc . + If rc ^= 0 Then Do + Say tcperror() + Parse Value Socket("CLOSE", socket) With rc . + Parse Value Socket("TERMINATE") With rc . + Return rc + End /* If .. Do */ + End /* Else Do */ + +/* + * Figure out the target host address + */ +If v1 Then Do + Parse Var host h1 '.' h2 '.' h3 '.' h4 '.' . + If Datatype(h1,'N') &, + Datatype(h2,'N') &, + Datatype(h3,'N') &, + Datatype(h4,'N') Then + hisaddr = d2c(h1) || d2c(h2) || d2c(h3) || d2c(h4) + Else Do + hisaddr = Socket('GetHostByName', host) + If hisaddr = "-1" Then Return -1 + End /* Else Do */ + End /* If .. Do */ + +Else Do + Parse Value Socket("RESOLVE", host) With rc hisaddr hisname . + If rc ^= 0 Then Do + Say tcperror() + Parse Value Socket("CLOSE", socket) With rc . + Parse Value Socket("TERMINATE") With rc . + Return rc + End /* If .. Do */ + End /* Else Do */ + +/* + * Connect to the MessageD server. + */ +If v1 Then Do + rc = Socket('Connect', socket, AF_INET || Htons(port) || hisaddr) + If rc = "-1" Then Return -1 + End /* If .. Do */ + +Else Do + Parse Value Socket("CONNECT", socket, "AF_INET" port hisaddr) , + With rc . + If rc ^= 0 Then Do + Say tcperror() + Parse Value Socket("CLOSE", socket) With . + Parse Value Socket("TERMINATE") With . + Return rc + End /* If .. Do */ + End /* Else Do */ + +/* + * Compose the message packet. + */ +data = ver || user || '00'x || term || '00'x || text || '00'x || , + localuser || '00'x || localterm || '00'x || , + Time('S') || '00'x || "?" '00'x + +/* + * Send the message. + */ +If v1 Then Do + bc = Socket('Write', socket, data) + If bc = "-1" Then Return -1 + End /* If .. Do */ + +Else Do + Parse Value Socket("WRITE", socket, data) With rc bc . + If rc ^= 0 Then Do + Say tcperror() + Parse Value Socket("CLOSE", socket) With rc . + Parse Value Socket("TERMINATE") With rc . + Return rc + End /* If .. Do */ + End /* Else Do */ + +/* + * Recover some response (if available). + */ +If v1 Then Do + bc = Socket('Read', socket, 'DATA') + If bc = "-1" Then Return -1 + End /* If .. Do */ + +Else Do + Parse Value Socket("READ", socket) With rc bc data + If rc ^= 0 Then Do + Say tcperror() + Parse Value Socket("CLOSE", socket) With rc . + Parse Value Socket("TERMINATE") With rc . + Return rc + End /* If .. Do */ + End /* Else Do */ + +/* + * Display the response (if any). + */ +If bc > 0 Then + If Left(data,1) ^= '+' Then Do + If Left(data,1) = '-' Then data = Substr(data,2) + Parse Var data data '00'x . + 'CALLPIPE VAR DATA | STRIP BOTH 25' , + '| XLATE *-* 25 15 | VAR DATA' + Say data + End /* If .. Do */ + +/* + * All done, relinquish our socket descriptor + */ +Parse Value Socket("CLOSE", socket) With rc . +If rc ^= 0 Then Do + Say tcperror() + Parse Value Socket("TERMINATE") With . + Return rc + End /* If .. Do */ + +/* + * Tell REXX/Sockets that we are done with this IUCV path. + */ +Parse Value Socket("TERMINATE") With rc . +If rc ^= 0 Then Do + Say tcperror() + Return rc + End /* If .. Do */ + +Return 0 + diff --git a/vmworkshop-vmarcs/1996/msg/userid.c b/vmworkshop-vmarcs/1996/msg/userid.c new file mode 100644 index 0000000..bd6e91c --- /dev/null +++ b/vmworkshop-vmarcs/1996/msg/userid.c @@ -0,0 +1,66 @@ +/* © Copyright 1995, Richard M. Troth, all rights reserved. <plaintext> + * + * Name: userid.c + * return the login name associated with this process + * Author: Rick Troth, Rice University, Information Systems + * Date: 1994-Jul-26 + * + * 1995-Apr-17: added useridg() function + */ + +#include <pwd.h> + +/* -------------------------------------------------------------- USERID + * return login name from the best of several usable sources + */ +char *userid() + { + char *u; + extern char *getenv(); + struct passwd *pwdent; + + /* first try effective uid key into passwd */ + pwdent = getpwuid(geteuid()); + if (pwdent) return pwdent->pw_name; + + /* next try real uid key into passwd */ + pwdent = getpwuid(getuid()); + if (pwdent) return pwdent->pw_name; + + /* thin ice, try USER env var */ + u = getenv("USER"); + if (u != 0x0000 && u[0] != 0x00) return u; + + /* last resort, try LOGNAME env var */ + u = getenv("LOGNAME"); + if (u != 0x0000 && u[0] != 0x00) return u; + + /* give up! */ + return ""; + } + +/* ------------------------------------------------------------- USERIDG + * "g" for GECOS field, return personal name string, if available + */ +char *useridg() + { + char *g; + extern char *getenv(); + struct passwd *pwdent; + + /* if the user set one, take that */ + g = getenv("NAME"); + if (g != 0x0000 && *g != 0x00) return g; + + /* next, try GECOS for effective uid key into passwd */ + pwdent = getpwuid(geteuid()); + if (pwdent) return pwdent->pw_gecos; + + /* next, try GECOS field for real uid key into passwd */ + pwdent = getpwuid(getuid()); + if (pwdent) return pwdent->pw_gecos; + + /* give up! */ + return userid(); + } + diff --git a/vmworkshop-vmarcs/1996/msg/userlist.rexx b/vmworkshop-vmarcs/1996/msg/userlist.rexx new file mode 100644 index 0000000..65ab3e2 --- /dev/null +++ b/vmworkshop-vmarcs/1996/msg/userlist.rexx @@ -0,0 +1,45 @@ +/* + * Name: USERLIST REXX + * generates a list of users from nickname input + * Author: Rick Troth, Houston, Texas, USA + * Date: 1992-Oct-02, Dec-09 + * + * Note: this does not presently support the TCPADDR hack + */ + +Parse Arg list '(' opts +Parse Source . . arg0 . + +If list ^= "" Then 'CALLPIPE VAR LIST |' arg0 '| *:' + +'ADDPIPE *: | CHANGE /@/ AT / | SPLIT | *.INPUT:' + +Do Forever + + 'READTO USER' + If rc ^= 0 Then Leave + If user = "" Then Iterate + + 'PEEKTO AT'; Upper at + If rc = 0 & at = "AT" Then Do + 'READTO' + 'READTO HOST' + If rc ^= 0 | host = "" Then 'OUTPUT' user + Else 'OUTPUT' user || '@' || host + End /* If .. Do */ + Else Do + nick = user + 'CALLPIPE CMS NAMEFIND :NICK' nick ':USERID :NODE :LIST' , + '| VAR USER | DROP | VAR HOST | DROP | VAR LIST' + If rc = 0 Then Do + If host = "" Then 'OUTPUT' user + Else 'OUTPUT' user || '@' || host + If list ^= "" Then 'CALLPIPE VAR LIST |' arg0 '| *:' + End /* If .. Do */ + Else 'OUTPUT' nick + End /* Else Do */ + + End /* Do Forever */ + +Exit rc * (rc ^= 12) + diff --git a/vmworkshop-vmarcs/1996/pf10pf11/pf10.xedit b/vmworkshop-vmarcs/1996/pf10pf11/pf10.xedit new file mode 100644 index 0000000..e429ea8 --- /dev/null +++ b/vmworkshop-vmarcs/1996/pf10pf11/pf10.xedit @@ -0,0 +1,107 @@ +/* PF10 */ +"REFRESH" +"EXTRACT /VERSHIFT/" +IF VERSHIFT.1<0 THEN "RIGHT "ABS(VERSHIFT.1) + ELSE DO + "EXTRACT /CMDLINE/CURSOR/" + IF CURSOR.1=CMDLINE.2 THEN DO + "EXTRACT /VERIFY/" + IF WORDS(VERIFY.2)=2 THEN DO + "PIPE VAR VERIFY.2", + "| SPLIT AT ANYOF / H/", + "| JOIN 1 / /", + "| STEM TABLE1." + IF VERSHIFT.1>0 THEN DO + "EXTRACT /LRECL/" + SELECT + WHEN LRECL.1<=WORD(TABLE1.1,2) THEN "LEFT "VERSHIFT.1 + WHEN LRECL.1<VERSHIFT.1+WORD(TABLE1.1,1) THEN "LEFT "VERSHIFT.1+WORD(TABLE1.1,2)-LRECL.1 + WHEN WORD(TABLE1.1,1)=WORD(TABLE1.1,2) THEN "LEFT 1" + WHEN LRECL.1<=VERSHIFT.1+WORD(TABLE1.1,2)-WORD(TABLE1.1,1) THEN "LEFT "WORD(TABLE1.1,2)-WORD(TABLE1.1,1)-(LRECL.1-VERSHIFT.1)+1 + WHEN VERSHIFT.1>=WORD(TABLE1.1,2)-WORD(TABLE1.1,1) THEN "LEFT "WORD(TABLE1.1,2)-WORD(TABLE1.1,1) + OTHERWISE "LEFT "VERSHIFT.1 + END + END + END + END + ELSE DO + "EXTRACT /SIZE/" + IF CURSOR.7=-1 |, + CURSOR.7>SIZE.1 |, + CURSOR.8=-1 THEN "CURSOR CMDLINE 1" + ELSE DO + "EXTRACT /LSCREEN/PREFIX/VERIFY/" + "PIPE VAR VERIFY.2", + "| SPLIT", + "| JOIN 1 / /", + "| STEM TABLE1." + IF PREFIX.1="ON" &, + PREFIX.2="LEFT" THEN COUNT1=6 + ELSE COUNT1=0 + DO COUNT2=1 FOR LSCREEN.1 + "CURSOR SCREEN "COUNT2" 1" + "EXTRACT /CURSOR/" + IF CURSOR.3=CURSOR.7 THEN LEAVE COUNT2 + END COUNT2 + COUNT3=LSCREEN.2*(CURSOR.5-CURSOR.1)+CURSOR.6-COUNT1 + COUNT4=0 + COUNT5=COUNT1+1 + DO COUNT6=1 FOR TABLE1.0 + IF SUBSTR(TABLE1.COUNT6,1,1)="H" THEN DO + TABLE1.COUNT6=TRANSLATE(TABLE1.COUNT6,,"H") + COUNT4=COUNT4+(WORD(TABLE1.COUNT6,2)-WORD(TABLE1.COUNT6,1)+1)*2 + COUNT7=2 + END + ELSE DO + COUNT4=COUNT4+WORD(TABLE1.COUNT6,2)-WORD(TABLE1.COUNT6,1)+1 + COUNT7=1 + END + IF COUNT4>=COUNT3 THEN LEAVE COUNT6 + COUNT5=COUNT5+WORD(TABLE1.COUNT6,2)-WORD(TABLE1.COUNT6,1)+1 + END COUNT6 + SELECT + WHEN VERSHIFT.1=0 THEN COUNT8=(CURSOR.8-WORD(TABLE1.COUNT6,1))*COUNT7 + WHEN WORD(TABLE1.COUNT6,1)=WORD(TABLE1.COUNT6,2) THEN DO + "LEFT 1" + COUNT8=0 + END + WHEN VERSHIFT.1<=WORD(TABLE1.COUNT6,2)-WORD(TABLE1.COUNT6,1) THEN DO + SELECT + WHEN CURSOR.8=VERSHIFT.1+WORD(TABLE1.COUNT6,2) THEN DO + "LEFT "VERSHIFT.1 + COUNT8=0 + END + WHEN CURSOR.8<=WORD(TABLE1.COUNT6,2) THEN DO + "LEFT "VERSHIFT.1 + COUNT8=-VERSHIFT.1*COUNT7 + END + OTHERWISE DO + "LEFT "VERSHIFT.1+WORD(TABLE1.COUNT6,2)-CURSOR.8 + COUNT8=-(VERSHIFT.1+WORD(TABLE1.COUNT6,2)-CURSOR.8)*COUNT7 + END + END + END + WHEN CURSOR.8=VERSHIFT.1+WORD(TABLE1.COUNT6,2) THEN DO + "LEFT "WORD(TABLE1.COUNT6,2)-WORD(TABLE1.COUNT6,1) + COUNT8=0 + END + OTHERWISE DO + "LEFT "VERSHIFT.1+WORD(TABLE1.COUNT6,2)-CURSOR.8 + COUNT8=-(VERSHIFT.1+WORD(TABLE1.COUNT6,2)-CURSOR.8)*COUNT7 + END + END + DO COUNT9=1 FOR LSCREEN.1 + "CURSOR SCREEN "COUNT9" 1" + "EXTRACT /CURSOR/" + IF CURSOR.3=CURSOR.7 THEN LEAVE COUNT9 + END COUNT9 + COUNT10=LSCREEN.2*(COUNT9-CURSOR.1)+COUNT3-COUNT8+COUNT1 + IF COUNT10//LSCREEN.2=0 THEN "CURSOR SCREEN "CURSOR.1+TRUNC((COUNT10-1)/LSCREEN.2)" "LSCREEN.2 + ELSE "CURSOR SCREEN "CURSOR.1+TRUNC((COUNT10-1)/LSCREEN.2)" "COUNT10//LSCREEN.2 + "EXTRACT /CURSOR/" + IF CURSOR.3=-1 |, + CURSOR.4=-1 THEN "CURSOR CMDLINE 1" + END + END +END +"REFRESH" diff --git a/vmworkshop-vmarcs/1996/pf10pf11/pf11.xedit b/vmworkshop-vmarcs/1996/pf10pf11/pf11.xedit new file mode 100644 index 0000000..acd096d --- /dev/null +++ b/vmworkshop-vmarcs/1996/pf10pf11/pf11.xedit @@ -0,0 +1,124 @@ +/* PF11 */ +"REFRESH" +"EXTRACT /VERSHIFT/" +IF VERSHIFT.1<0 THEN "RIGHT "ABS(VERSHIFT.1) + ELSE DO + "EXTRACT /CMDLINE/CURSOR/" + IF CURSOR.1=CMDLINE.2 THEN DO + "EXTRACT /VERIFY/" + IF WORDS(VERIFY.2)=2 THEN DO + "PIPE VAR VERIFY.2", + "| SPLIT AT ANYOF / H/", + "| JOIN 1 / /", + "| STEM TABLE1." + "EXTRACT /LRECL/" + IF LRECL.1/=VERSHIFT.1+WORD(TABLE1.1,2) THEN DO + SELECT + WHEN LRECL.1<=WORD(TABLE1.1,2) THEN IF VERSHIFT.1>0 THEN "LEFT "VERSHIFT.1 + WHEN LRECL.1<VERSHIFT.1+WORD(TABLE1.1,2) THEN "LEFT "VERSHIFT.1+WORD(TABLE1.1,2)-LRECL.1 + WHEN VERSHIFT.1<=LRECL.1-(WORD(TABLE1.1,2)*2-WORD(TABLE1.1,1)) THEN DO + IF WORD(TABLE1.1,1)=WORD(TABLE1.1,2) THEN "RIGHT 1" + ELSE "RIGHT "WORD(TABLE1.1,2)-WORD(TABLE1.1,1) + END + OTHERWISE "RIGHT "LRECL.1-VERSHIFT.1-WORD(TABLE1.1,2) + END + END + END + END + ELSE DO + "EXTRACT /SIZE/" + IF CURSOR.7=-1 |, + CURSOR.7>SIZE.1 |, + CURSOR.8=-1 THEN "CURSOR CMDLINE 1" + ELSE DO + "EXTRACT /LRECL/LSCREEN/PREFIX/VERIFY/" + "PIPE VAR VERIFY.2", + "| SPLIT", + "| JOIN 1 / /", + "| STEM TABLE1." + IF PREFIX.1="ON" &, + PREFIX.2="LEFT" THEN COUNT1=6 + ELSE COUNT1=0 + DO COUNT2=1 FOR LSCREEN.1 + "CURSOR SCREEN "COUNT2" 1" + "EXTRACT /CURSOR/" + IF CURSOR.3=CURSOR.7 THEN LEAVE COUNT2 + END COUNT2 + COUNT3=LSCREEN.2*(CURSOR.5-CURSOR.1)+CURSOR.6-COUNT1 + COUNT4=0 + COUNT5=COUNT1+1 + DO COUNT6=1 FOR TABLE1.0 + IF SUBSTR(TABLE1.COUNT6,1,1)="H" THEN DO + TABLE1.COUNT6=TRANSLATE(TABLE1.COUNT6,,"H") + COUNT4=COUNT4+(WORD(TABLE1.COUNT6,2)-WORD(TABLE1.COUNT6,1)+1)*2 + COUNT7=2 + END + ELSE DO + COUNT4=COUNT4+WORD(TABLE1.COUNT6,2)-WORD(TABLE1.COUNT6,1)+1 + COUNT7=1 + END + IF COUNT4>=COUNT3 THEN LEAVE COUNT6 + COUNT5=COUNT5+WORD(TABLE1.COUNT6,2)-WORD(TABLE1.COUNT6,1)+1 + END COUNT6 + SELECT + WHEN LRECL.1=VERSHIFT.1+WORD(TABLE1.COUNT6,2) THEN COUNT8=(CURSOR.8-VERSHIFT.1-WORD(TABLE1.COUNT6,1))*COUNT7 + WHEN LRECL.1<=WORD(TABLE1.COUNT6,2) THEN DO + IF VERSHIFT.1>0 THEN "LEFT "VERSHIFT.1 + COUNT8=(CURSOR.8-WORD(TABLE1.COUNT6,1)-VERSHIFT.1)*COUNT7 + END + WHEN LRECL.1<VERSHIFT.1+WORD(TABLE1.COUNT6,2) THEN DO + "LEFT "VERSHIFT.1+WORD(TABLE1.COUNT6,2)-LRECL.1 + COUNT8=-(VERSHIFT.1+WORD(TABLE1.COUNT6,2)-LRECL.1)*COUNT7 + END + WHEN WORD(TABLE1.COUNT6,1)=WORD(TABLE1.COUNT6,2) THEN DO + "RIGHT 1" + COUNT8=0 + END + WHEN VERSHIFT.1>LRECL.1-(WORD(TABLE1.1,2)*2-WORD(TABLE1.1,1)) THEN DO + SELECT + WHEN CURSOR.8=VERSHIFT.1+WORD(TABLE1.COUNT6,1) THEN DO + "RIGHT "LRECL.1-(VERSHIFT.1+WORD(TABLE1.COUNT6,2)) + COUNT8=0 + END + WHEN CURSOR.8<=VERSHIFT.1+LRECL.1-(VERSHIFT.1+WORD(TABLE1.COUNT6,2)) THEN DO + "RIGHT "CURSOR.8-VERSHIFT.1-WORD(TABLE1.COUNT6,1) + COUNT8=(CURSOR.8-VERSHIFT.1-WORD(TABLE1.COUNT6,1))*COUNT7 + END + OTHERWISE DO + "RIGHT "LRECL.1-(VERSHIFT.1+WORD(TABLE1.COUNT6,2)) + COUNT8=(LRECL.1-(VERSHIFT.1+WORD(TABLE1.COUNT6,2)))*COUNT7 + END + END + END + OTHERWISE DO + SELECT + WHEN CURSOR.8=VERSHIFT.1+WORD(TABLE1.COUNT6,1) THEN DO + "RIGHT "WORD(TABLE1.COUNT6,2)-WORD(TABLE1.COUNT6,1) + COUNT8=0 + END + WHEN CURSOR.8=VERSHIFT.1+WORD(TABLE1.COUNT6,2) THEN DO + "RIGHT "WORD(TABLE1.COUNT6,2)-WORD(TABLE1.COUNT6,1) + COUNT8=(WORD(TABLE1.COUNT6,2)-WORD(TABLE1.COUNT6,1))*COUNT7 + END + OTHERWISE DO + "RIGHT "CURSOR.8-VERSHIFT.1-WORD(TABLE1.COUNT6,1) + COUNT8=(CURSOR.8-VERSHIFT.1-WORD(TABLE1.COUNT6,1))*COUNT7 + END + END + END + END + DO COUNT9=1 FOR LSCREEN.1 + "CURSOR SCREEN "COUNT9" 1" + "EXTRACT /CURSOR/" + IF CURSOR.3=CURSOR.7 THEN LEAVE COUNT9 + END COUNT9 + COUNT10=LSCREEN.2*(COUNT9-CURSOR.1)+COUNT3-COUNT8+COUNT1 + IF COUNT10//LSCREEN.2=0 THEN "CURSOR SCREEN "COUNT9+TRUNC((COUNT10-1)/LSCREEN.2)" "LSCREEN.2 + ELSE "CURSOR SCREEN "COUNT9+TRUNC((COUNT10-1)/LSCREEN.2)" "COUNT10//LSCREEN.2 + "EXTRACT /CURSOR/" + IF CURSOR.3=-1 |, + CURSOR.4=-1 THEN "CURSOR CMDLINE 1" + END + END +END +"REFRESH" diff --git a/vmworkshop-vmarcs/1996/spbackup/README.md b/vmworkshop-vmarcs/1996/spbackup/README.md new file mode 100644 index 0000000..11c16a2 --- /dev/null +++ b/vmworkshop-vmarcs/1996/spbackup/README.md @@ -0,0 +1,11 @@ +# SPBACKUP + +Spool Backup System, using SPXTAPE +University of Illinois at Chicago +June 22, 1996 + + +SPBACKUP is a spool backup system which uses the new SPXTAPE command to back up the spool. It's purpose is to create an interface between the CP SPXTAPE command, and the VMTAPE tape system, and to create catalogs and indexes to facilitate restores. + +Roger Deschner University of Illinois at Chicago rogerd@uic.edu +Computer Center M/C 135, 1940 W. Taylor St., Room 124, Chicago, IL 60612 diff --git a/vmworkshop-vmarcs/1996/spbackup/abend.email b/vmworkshop-vmarcs/1996/spbackup/abend.email new file mode 100644 index 0000000..32c6a49 --- /dev/null +++ b/vmworkshop-vmarcs/1996/spbackup/abend.email @@ -0,0 +1,8 @@ +Subject: SPBACKUP Failure Today + +SPBACKUP reports a premature end. Please check its logs in SYSLOG and in +its reader to be sure it ran OK. + +We are going to attempt to run the WRAPUP step, however it might not +work. It may be necessary to run the WRAPUP step over again after +figuring out why the job failed. \ No newline at end of file diff --git a/vmworkshop-vmarcs/1996/spbackup/backmoun.exec b/vmworkshop-vmarcs/1996/spbackup/backmoun.exec new file mode 100644 index 0000000..114216e --- /dev/null +++ b/vmworkshop-vmarcs/1996/spbackup/backmoun.exec @@ -0,0 +1,28 @@ +/* BACKMOUN EXEC: +We are trapping the following two VMTAPE MSNGOH's: + +VMTMNT073I Volume 'MVS1' ready on 0181 (1882) R/W SL. +VMTBUF016I MOUNT completion code=0. + +MODIFICATION HISTORY: +02/13/96 - Roger Deschner - Original Version +*/ +ADDRESS COMMAND +PARSE ARG msgl +msgl = STRIP(msgl) +'GLOBALV SELECT SPBACKUP GET MODEMOUN' /* Were we recording already? */ +SELECT + WHEN (modemoun = 'RECORD') THEN DO /*Yes, we were recording already.*/ + 'PIPE VAR msgl | >> BACKMOUN SAVEMSGS A' /* Add to msg queue */ + IF (SUBSTR(msgl,1,10) = 'VMTBUF016I') THEN DO /* Done? */ + 'EXEC BACKUP MOUNTED' /* Doit toit */ + 'GLOBALV SELECT SPBACKUP SETL MODEMOUN NORMAL' /* Stop recoding */ + END + END + WHEN (SUBSTR(msgl,1,10) = 'VMTMNT073I') THEN DO + 'GLOBALV SELECT SPBACKUP SETL MODEMOUN RECORD' /* Start recording */ + 'PIPE VAR msgl | > BACKMOUN SAVEMSGS A' /* Start new msg queue */ + END + OTHERWISE NOP +END +EXIT diff --git a/vmworkshop-vmarcs/1996/spbackup/backtrap.exec b/vmworkshop-vmarcs/1996/spbackup/backtrap.exec new file mode 100644 index 0000000..ab3d8ea --- /dev/null +++ b/vmworkshop-vmarcs/1996/spbackup/backtrap.exec @@ -0,0 +1,67 @@ +/* BACKTRAP EXEC: +This routine collects CP console output. + +MODIFICATION HISTORY: +05/13/96 - Roger Deschner - Add trap for premature end +04/17/96 - Roger Deschner - Add more detailed trap for reader files +02/13/96 - Roger Deschner - Original Version +*/ +ADDRESS COMMAND +PARSE ARG msgl +msgl = STRIP(msgl) +'PIPE VAR msgl', /* DEBUG TRACE */ + '| SPECS !' || DATE('U') TIME() || '! 1', + '1-* NEXTWORD', + '| >> BACKTRAP LOG A' +/* '| CONSOLE' */ +'GLOBALV SELECT SPBACKUP GET MODETRAP' /* Were we recording already? */ +SELECT + WHEN (SUBSTR(msgl,1,9) = 'RDR FILE ') THEN DO + PARSE VAR msgl . . spid . . originid . + IF (originid = USERID()) THEN DO /* Did it come from ourselves? */ + +/* Sample output: +ORIGINID FILE CLASS RECORDS CPY HOLD DATE TIME NAME TYPE DIST +SPBACKUP 0078 T CON 00010985 001 NONE 04/17 03:06:47 0417D182 02184301 UICVM +*/ + + 'PIPE VAR msgl | >> BACKFILE SAVEMSGS A' + 'PIPE CP QUERY RDR *' spid 'ALL', + '| DROP FIRST 1', /* eliminate header */ + '| LOCATE 15-19 /T CON/', /* Just the ones we really want */ + '| LOCATE 58 /D/', /* Take just files from DUMP commands */ + '| NLOCATE 58-61 /DUMP/', /* Eliminate Cmd Summary logs */ + '| SPECS 54-71 1', /* Just the fileid */ + '| VAR spfileid', + '| COUNT LINES', /* See if we got one */ + '| VAR nspfileid' + IF (nspfileid = 1) THEN DO + SAY 'BACKTRAP: Sending unload signal. Received file' spfileid + 'EXEC BACKUP UNLOADED' spfileid + END + END + END + WHEN (modetrap = 'RECORD') THEN DO /*Yes, we were recording already. */ + 'PIPE VAR msgl | >> BACKTRAP SAVEMSGS A' /* Add to msg queue */ + IF (SUBSTR(msgl,1,12) = 'SPOOL PAGES:') THEN DO /* Done? */ + SAY 'BACKTRAP received a complete message from SPXTAPE:' + 'PIPE < BACKTRAP SAVEMSGS A | SPECS />/ 1 1-* 2 | CONSOLE' + /* Clear recording flag in case something comes during EOT. */ + 'GLOBALV SELECT SPBACKUP SETL MODETRAP NORMAL' /* Stop recoding */ + 'EXEC BACKUP EOT' /* Doit toit */ + END + END + WHEN ((SUBSTR(msgl,1,32) = 'SPXTAPE DUMP END-OF-TAPE ON VDEV'), + | (SUBSTR(msgl,1,31) = 'SPXTAPE DUMP COMPLETED ON VDEV'), + | (SUBSTR(msgl,1,39) = 'SPXTAPE DUMP COMMAND COMPLETED ON VDEV'), + | (SUBSTR(msgl,1,39) = 'SPXTAPE DUMP COMMAND ENDED ON VDEV'), + )THEN DO + 'GLOBALV SELECT SPBACKUP SETL MODETRAP RECORD' /* Start recording */ + 'PIPE VAR msgl | > BACKTRAP SAVEMSGS A' /* Start new msg queue */ + END + WHEN (SUBSTR(msgl,1,7) = 'DUMPING') THEN DO /* Save progress msg */ + 'GLOBALV SELECT SPBACKUP SETL PROGRESS' SUBSTR(msgl,20) + END + OTHERWISE NOP +END +EXIT diff --git a/vmworkshop-vmarcs/1996/spbackup/backup.exec b/vmworkshop-vmarcs/1996/spbackup/backup.exec new file mode 100644 index 0000000..d8c5b19 --- /dev/null +++ b/vmworkshop-vmarcs/1996/spbackup/backup.exec @@ -0,0 +1,1074 @@ +/* BACKUP EXEC: +This is a WAKEUP application which will start, modify, query, or cancel a +SPXTAPE spool backup. + +For users: + .--2--------. + >>--BACKUP--+--START--tapepool--+--ndrives--+--+-->< + +--QUERY---------------------------+ + +--DRIVES--ndrives-----------------+ + +--CANCEL--------------------------+ + +--DATA----------------------------+ + +--DUMP----------------------------+ + '--WRAPUP--hhmmss--tapepool--------' + +For IUCVTRAP action routine exits: + + >>--BACKUP--+--MOUNTED-------------------+-->< + +--EOT-----------------------+ + '--UNLOADED--spfileid--------+ + +...where hhmmss is the time stamp on the log files in the spool. + +TAPEPOOL is the filename of a CMS file (filetype TAPEPOOL) containing a +list of tape volsers. These tapes must be in the VMTAPE Catalog. This +file may contain comments with * in column one. + +The first tape in the tapepool is actually used last, to back up the +catalog database of this backup. + +DATA STRUCTURES (mostly stored in GLOBALV) + +(Debugging tip: GLOBALV SELECT SPBACKUP LIST) + +qbackup = 1 if a backup is running +qcomplete = 1 when we receive the first indication of SPXTAPE + completing on any drive. At that point, we refuse to start + any more new tapes that a sleeping operator woke up and + mounted. +vdev. - stem of virtual device addresses. +drivevol. - stem of which VOLSER is mounted on each member of vdev. +drivestat. - stem of status of each member of vdev. + IDLE - not in use at all + MOUNTING - VMTAPE MOUNT issued; no response yet + DUMPING - Dumping currently in process + DRAINING - Dump completed to this vol but can't DETACH + due to this is the last drive, and the Operator is asleep. + There should be some other drive in MOUNTING status. Once + the Operator wakes up, mounts the tape, and it goes + DUMPING, this one can be DETACHed and made IDLE. Volume + Log will likely arrive in the meantime, and if it does, + we accept it and say thank you and that's all. + UNLOADING - Dump completed to this vol but can't DETACH yet + because it is still rewinding and unloading. This must + wait until we get the Volume Log in our reader for this + tape. When it arrives, we can CP DETACH it. In the + meantime, we'll mount our next tape on another vdev. +ndrives - How many drives the operator wishes to use +nspxtape - how many drives are actually in use BY SPXTAPE +ninuse - how many drives are actually in use either mounting or dump + Note: ninuse - nspxtape should equal the number of pending mounts. +tapepool - CMS filename of the current tapepool +tapevol. - stem of tapes in <tapepool>. This is read over again for + each invocation. Therefore, the operator can add tapes to + the end of a tapepool if it runs out. +tapestat. - stem of status of each member of tapevol. + UNUSED - not yet written on + MOUNTING - Requested for mount but not yet written on + WRITING - In the process of being written upon + WRITTEN - Completed writing + RESERVED - ineligible for writing +tapevoli - pointer to last tape used in stem tapevol. +starttime - hhmmss time that dump was started + +SLEEPING OPERATOR CONDITION: The problem is that SPXTAPE must have at +least one drive at all times or else it terminates. Therefore, if the +Operator goes to sleep, or to lunch, or to other duties, long enough +for all mounted tapes to fill up, we must keep the last one active in +a waiting-for-next-tape condition. When the operator returns and mounts +any of the tapes whose mounts have been pending, we can then do the +SPXTAPE END and DETACH commands for that drive. + +PREREQUISITES: +WAKEUP - from the CMS Utilities/IPF set of tools. +GETFMADR - from the CMS Utilities/IPF set of tools. +External sorting program, such as PLSORT. Search on /LOCAL DEPEND/ to + find where you need to configure for your sort pgm. + +MODIFICATION HISTORY: +05/13/96 - Roger Deschner - Handle tape drive that is attached after we + no longer need it. Don't issue SPXTAPE DUMP command at that + point, or a second dump may start itself up, and get all + confused. +04/29/96 - Roger Deschner - When recovering from a sleeping-operator + condition, assume that the volume log has already arrived + by the time the operator wakes up and mounts the next tape. +04/23/96 - Back up only specific files to tape during WRAPUP. +04/22/96 - Roger Deschner - more bug fixes to detaching drive logic +04/18/96 - Roger Deschner - fix bugs in reading logs, detaching drives +04/17/96 - Roger Deschner - Change to a new method of waiting for the + log file to arrive in our reader to detach the drive. This may slow + the whole process down a little. +04/15/96 - Roger Deschner - Change tape disposition back to RUN due to + not getting our logs on time at end of job. APAR opened with IBM + about rewind timing problem. Change to searching spool for logs. + (file BACKFILE LOGMSGS no longer needed?) +04/12/96 - Roger Deschner - Changed tape disposition from RUN to REW to + help with tape-unloading timing problem. Also fix <nspxtape> bug in + Mounted: so that arithmetic is OK after recovering from a DRAINING + drive if the Operator went to sleep. +03/29/96 - Roger Deschner - Added CP REWIND to solve timing problems + wherein hardware errors would occur detaching a tape drive which was + fully unwound. VMTAPE would grab the drive and cause an error. +03/21/96 - Roger Deschner - Original Version + +*/ +ADDRESS COMMAND +/******************** begin configuration section *********************/ +/* Parameter string to be issued to SPXTAPE on initial invocation */ +/* spxparms = 'USER NOTISSRV STD ALL MODE NOCOMP RUN'/* debug trace */ */ +spxparms = 'SPOOL ALL MODE COMP RUN' /* Includes NSS, etc. */ + +/* String of consecutive virtual addresses to use for tapes */ +/* Must be expressed as 4-digit addresses. */ +vdevs = '0181 0182 0183 0184 0185 0186 0187 0188 0189 018A 018B 018C' + +/* Userid of the VMTAPE service virtual */ +vmtapeid = 'VMTAPE' +/********************* end configuration section **********************/ + +/* Self-configuration section */ +/* Turn above list into stem */ +'PIPE LITERAL' vdevs, + '| SPLIT', /* Cut apart into individual tokens */ + '| STEM vdev.' +/* Who are we, and where are we? */ +'PIPE COMMAND IDENTIFY | VAR answer' +PARSE VAR answer ourid . ournode . + +PARSE UPPER ARG action parms +finalrc = 0 +SELECT + WHEN (action = 'START') THEN CALL START + WHEN (action = 'EOT') THEN CALL EOT /* called by BACKTRAP */ + WHEN (action = 'UNLOADED') THEN CALL UNLOADED parms /* by BACKTRAP */ + WHEN (action = 'MOUNTED') THEN CALL MOUNTED /* called by BACKMOUN */ + WHEN (action = 'QUERY') THEN CALL QUERY + WHEN (action = 'DRIVES') THEN CALL DRIVES + WHEN (action = 'CANCEL') THEN CALL CANCEL + WHEN (action = 'NORMEND') THEN CALL NORMEND /* Called by BACKTRAP */ + WHEN (action = 'WRAPUP') THEN CALL WRAPUP parms /*Called by ACV AFTER*/ + WHEN (action = 'DUMP') THEN 'GLOBALV SELECT SPBACKUP LIST' + WHEN (action = 'DATA') THEN CALL DATA parms + OTHERWISE DO + SAY 'Invalid arguments to BACKUP.' + finalrc = 12 + END +END +EXIT finalrc + + +COMMONV: /* EXPOSE EVERYTHING */ +/**********************************************************************\ +* * +* COMMONV Minor Subroutine * +* * +\**********************************************************************/ +/* GET or PUT everything we know about current status of the program. */ +PARSE UPPER ARG direction . +IF (WORDPOS(direction,'GET PUT') < 1) THEN DO + SAY 'Internal error, COMMONV arg must be GET or PUT.' + EXIT 16 +END + +'GLOBALV SELECT SPBACKUP' direction 'DRIVEVOL.0' /* Stem drivevol. */ +DO i = 1 TO drivevol.0 /* Stem drivevol. */ + 'GLOBALV SELECT SPBACKUP' direction 'DRIVEVOL.'i /* Stem drivevol. */ +END /* Stem drivevol. */ +'GLOBALV SELECT SPBACKUP' direction 'DRIVESTAT.0' /* Stem drivestat. */ +DO i = 1 TO drivestat.0 /* Stem drivestat. */ + 'GLOBALV SELECT SPBACKUP' direction 'DRIVESTAT.'i /*Stem drivestat. */ +END /* Stem drivestat. */ +IF (direction = 'GET') THEN tapestat. = 'UNUSED' +'GLOBALV SELECT SPBACKUP' direction 'TAPESTAT.0' /* Stem tapestat. */ +DO i = 1 TO tapestat.0 /* Stem tapestat. */ + 'GLOBALV SELECT SPBACKUP' direction 'TAPESTAT.'i /* Stem tapestat. */ +END /* Stem tapestat. */ +'GLOBALV SELECT SPBACKUP' direction 'NDRIVES' +'GLOBALV SELECT SPBACKUP' direction 'NSPXTAPE' +'GLOBALV SELECT SPBACKUP' direction 'NINUSE' +'GLOBALV SELECT SPBACKUP' direction 'TAPEVOLI' +'GLOBALV SELECT SPBACKUP' direction 'QCOMPLETE' +IF (direction = 'GET') THEN DO + 'GLOBALV SELECT SPBACKUP GET TAPEPOOL' + /* Get the list of tapes to use */ + /* (Note that we reread the TAPEPOOL file here in case tapes were + added to the TAPEPOOL during the backup. This would be a thing to + do if a tapepool runs out partway through a backup. */ + 'PIPE <' tapepool 'TAPEPOOL *', + '| NFIND *' ||, /* Eliminate comments */ + '| SPECS 1-6 1', /* Just the volsers */ + '| STEM tapevol.' + tapestat.0 = tapevol.0 /* (added tapes will automatically have value */ + /* of UNUSED due to tapestat. = 'UNUSED') */ +END + +RETURN + + +Start: +/**********************************************************************\ +* * +* START subroutine * +* * +\**********************************************************************/ + + +/* Initialize stems */ +drivevol. = '' +drivevol.0 = vdev.0 +drivestat. = 'IDLE' +drivestat.0 = vdev.0 +tapevoli = 1 /* We start this at 1 so that it uses tapevol.2 first. */ + /* That is because tapevol.1 will contain the catalog. */ +ninuse = 0 +nspxtape = 0 + +PARSE VAR parms tapepool ndrives . +IF (ndrives = '') THEN ndrives = 2 +IF (tapepool = '') THEN DO + SAY 'BACKUP START Error: Tape pool name required.' + RETURN 16 +END + +/* Was a backup already started? */ +'GLOBALV SELECT SPBACKUP GET QBACKUP' +IF (qbackup = 1) THEN DO + SAY 'Error: Backup is apparently already started.' + EXIT 12 +END +qbackup = 1 /* It is now. */ + +/* Prepare a clean slate of tape drives */ +DO i = 1 TO vdev.0 + 'CP REWIND' vdev.i + 'PIPE CP DETACH' vdev.i '| HOLE' +END +'PIPE CMS VMTAPE CANCEL ALL | HOLE' + +/* VERY IMPORTANT - so we get the SPXTAPE logs: */ +'CP SPOOL CONS CLOSE' /* to whomever it was before */ +'CP SPOOL CONS TO *' +'PIPE COMMAND ERASE BACKFILE SAVEMSGS A | HOLE' + +/* Who invoked us? Remember for future use. */ +'PIPE VAR runuser 1 | VAR runuser' +'GLOBALV SELECT SPBACKUP PUT RUNUSER' +'GLOBALV SELECT SPBACKUP PUT STARTUSER' + +/* Get the list of tapes to use */ +'PIPE <' tapepool 'TAPEPOOL *', + '| NFIND *' ||, /* Eliminate comments */ + '| SPECS 1-6 1', /* Just the volsers */ + '| STEM tapevol.' +orc = rc +IF ((orc <> 0) | (tapevol.0 < ndrives)) THEN DO + SAY 'Error: Tape pool' tapepool 'contains fewer tapes than number', + 'of drives specified.' + finalrc = 12 + RETURN +END + +/* Initialize <tapestat> stem. */ +tapestat. = 'UNUSED' +tapestat.0 = tapevol.0 +tapestat.1 = 'RESERVED' /* Save first vol for restore catalog */ + +/* Initialize qcomplete */ +qcomplete = 0 + +/* Save everything we know */ +'GLOBALV SELECT SPBACKUP SETL QBACKUP 1' +'GLOBALV SELECT SPBACKUP PUT TAPEPOOL' + +/* Mount the tapes */ +CALL REMOUNT + +/* Save everything else, including what REMOUNT might have changed */ +CALL COMMONV 'PUT' + +RETURN + +Remount: PROCEDURE EXPOSE vdev. drivevol. drivestat. ndrives ninuse, + tapevoli nspxtape tapestat. +/**********************************************************************\ +* * +* REMOUNT Minor Subroutine * +* * +\**********************************************************************/ +/* Issue VMTAPE MOUNT commands for these tapes. If any MOUNT*/ +/* commands fail, bypass and go to the next tape volume. */ + + +/* Get everything we need to know */ +'GLOBALV SELECT SPBACKUP GET TAPEPOOL' +'GLOBALV SELECT SPBACKUP GET RUNUSER' +/* Get the list of tapes to use */ +/* (Note that we reread the TAPEPOOL file here in case tapes were + added to the TAPEPOOL during the backup. This would be a thing to + do if a tapepool runs out partway through a backup. */ +'PIPE <' tapepool 'TAPEPOOL *', + '| NFIND *' ||, /* Eliminate comments */ + '| SPECS 1-6 1', /* Just the volsers */ + '| STEM tapevol.' +tapestat.0 = tapevol.0 /* (added tapes will automatically have value */ + /* of UNUSED due to tapestat. = 'UNUSED') */ + +SAY 'REMOUNT called.' /* debug trace */ +SAY 'NDRIVES=' ndrives 'NINUSE=' ninuse, /* debug trace */ + 'NSPXTAPE=' nspxtape 'TAPEVOLI=' tapevoli /* debug trace */ +SAY 'virt real tape ' +SAY 'addr addr status volser' +SAY ' ' +DO i = 1 TO vdev.0 + IF (WORDPOS(drivestat.i,'DUMPING DRAINING UNLOADING') > 0) THEN, + 'PIPE CP Q V' vdev.i, + '| SPECS 19.4 1', + '| VAR rdev' + ELSE rdev = '----' + SAY vdev.i ' ' rdev ' ' drivestat.i ' ' drivevol.i +END + +DO FOREVER + + /* Have we accomplished our mission? */ + IF (ninuse >= ndrives) THEN LEAVE + + /* Do we have any more tapes? */ + tapevoli = 0 + DO i = 1 TO tapestat.0 + IF (tapestat.i = 'UNUSED') THEN DO + /* We have found what we were looking for */ + tapevoli = i + LEAVE + END + END + + IF (tapevoli = 0) THEN DO + ndrives = ninuse + /* We have run out of tapes. */ + yak = 'CP MSGNOH' runuser + yak 'Not enough tapes in:' tapepool 'TAPEPOOL. You should add more.' + yak ' ' + yak 'Until you do, we will continue running on only' ndrives, + 'drives.' + yak ' ' + yak 'You should add more tapes now. Here is the procedure:' + yak ' ' + yak 'New tapes must be in the VMTAPE catalog. (Use scratch tapes in', + 'emergency.)' + yak 'Get a MR link to' ourid '3E1, and XEDIT' tapepool, + 'TAPEPOOL.' + yak 'Add new volumes to the end of the file, file it, and release' + yak 'AND detach my minidisk. Then issue:' + yak ' ' + yak 'SMSG' ourid 'ACCESS 3E1 C' + yak ' ' + yak 'Then, to resume running on the full number of drives, issue:' + yak ' ' + yak 'SMSG' ourid 'DRIVES n' + ITERATE + END + + /* Find an unused vdev. Note range already checked elsewhere. */ + DO i = 1 TO vdev.0 + j = i + IF (drivestat.j = 'IDLE') THEN LEAVE + END + + SAY 'Mounting' tapevol.tapevoli 'on vdev' vdev.j ' J='j + 'PIPE CMS VMTAPE MOUNT' tapevol.tapevoli vdev.j '(WRITE NOWAIT', + '| CONSOLE', /* DEBUG TRACE */ + '| STEM errstem.' + orc = rc + IF (orc <> 0) THEN DO + 'PIPE LITERAL VMTAPE MOUNT failed. Possible TAPEPOOL error.', + '| APPEND STEM errstem.', + '| SPECS /MSGNOH' runuser'/ 1 1-* NEXTWORD', + '| CP', + '| CONSOLE' /* To see if any CP MSGs failed. */ + END + drivevol.j = tapevol.tapevoli + drivestat.j = 'MOUNTING' + tapestat.tapevoli = 'MOUNTING' + ninuse = ninuse + 1 +END +SAY 'exiting REMOUNT.' /* debug trace */ +SAY 'NDRIVES=' ndrives 'NINUSE=' ninuse, /* debug trace */ + 'NSPXTAPE=' nspxtape 'TAPEVOLI=' tapevoli /* debug trace */ +SAY 'virt real tape ' +SAY 'addr addr status volser' +SAY ' ' +DO i = 1 TO vdev.0 + IF (WORDPOS(drivestat.i,'DUMPING DRAINING UNLOADING') > 0) THEN, + 'PIPE CP Q V' vdev.i, + '| SPECS 19.4 1', + '| VAR rdev' + ELSE rdev = '----' + SAY vdev.i ' ' rdev ' ' drivestat.i ' ' drivevol.i +END +RETURN + + +Eot: +/**********************************************************************\ +* * +* EOT Major Subroutine * +* * +\**********************************************************************/ +/* Triggered by trapping an end-of-tape message from CP SPXTAPE. */ +/* In this routine, our runuser is ourself. (Should it be "SYSTEM"?) */ + +/* Get all the information */ +CALL COMMONV 'GET' + +/* Which drive ran out? Why did it run out? */ +'PIPE (ENDCHAR ?) < BACKTRAP SAVEMSGS A', + '| CONSOLE', + '| A: TAKE FIRST 1', + '| VAR enddrive', /* <enddrive> now has the whole msg */ + '| SPECS 14-* 1', /* Get what event this was */ + '| SPECS WORDS 1-2 1', /* Just enough to tell it apart */ + '| VAR endreason', + '?', /* This will only happen when ENDREASON=COMMAND */ + 'A:', /* TIME STARTED: 02:01:48 */ + '| FIND TIME STARTED:' ||, + '| SPECS WORDS 3 1', + '| SPECS 1-2 1 4-5 3 7-8 5', /* Remove ":" */ + '| VAR starttime' + +SAY 'Entering EOT.' /* debug trace */ +SAY 'STARTTIME VARIABLE=' starttime +SAY 'NDRIVES=' ndrives 'NINUSE=' ninuse, /* debug trace */ + 'NSPXTAPE=' nspxtape /* debug trace */ +SAY 'ENDDRIVE=' enddrive /* debug trace */ +SAY 'ENDREASON=' endreason ' QCOMPLETE=' qcomplete + +SELECT + WHEN (SUBWORD(endreason,1,1) = 'END-OF-TAPE') THEN DO + enddrive = SUBSTR(enddrive,34,4) + /* Qiuck! Get rid of it! */ + j = WORDPOS(enddrive,vdevs) + + /* Mark this tape volume as having been used */ + DO i = 1 TO tapevol.0 + IF (tapevol.i = drivevol.j) THEN DO + tapestat.i = 'WRITTEN' + LEAVE + END + END + + IF (nspxtape > 1) THEN DO /* Is the Operator asleep? */ + /* Operator is not asleep. Behave normally. */ + 'PIPE CP SPXTAPE END' enddrive /*'| HOLE'*/ '|console' /* debug */ + /* Do NOT detach yet - wait until it unloads. */ + ninuse = ninuse - 1 + nspxtape = nspxtape - 1 + /* Mark this vdev as still rewinding and unloading. It will be */ + /* changed to IDLE when its Volume Log arrives in our reader. */ + drivestat.j = 'UNLOADING' + drivevol.j = '' + END + ELSE DO + /* Operator is asleep. Can't unload this vdev or SPXTAPE ends. */ + drivestat.j = 'DRAINING' + END + + /* Mount next tape */ + CALL REMOUNT + END + WHEN (SUBWORD(endreason,1,1) = 'COMPLETED') THEN DO + /* This means that we're done with this tape drive, and SPXTAPE */ + /* does not want another tape. But it is still dumping on other */ + /* drives, so don't close the show down yet. */ + enddrive = SUBSTR(enddrive,33,4) + /* Qiuck! Get rid of it! */ + j = WORDPOS(enddrive,vdevs) + + /* The job is officially coming to its end */ + IF (qcomplete = 0) THEN DO + qcomplete = 1 + ADDRESS CMS 'VMTAPE CANCEL ALL' + END + + /* Mark this tape volume as having been used */ + DO i = 1 TO tapevol.0 + IF (tapevol.i = drivevol.j) THEN DO + tapestat.i = 'WRITTEN' + LEAVE + END + END + + IF (nspxtape > 1) THEN DO + /* We are not yet down to our last drive. */ + 'PIPE CP SPXTAPE END' enddrive '| HOLE' + /* Do NOT detach yet - wait until it unloads. */ + ninuse = ninuse - 1 /* Decrement what's being used */ + nspxtape = nspxtape - 1 + ndrives = ninuse /* Start shutting this thing down */ + /* Mark this vdev as still rewinding and unloading. It will be */ + /* changed to IDLE when its Volume Log arrives in our reader. */ + drivestat.j = 'UNLOADING' + drivevol.j = '' + END + ELSE DO + /* We are down to our last drive, and SPXTAPE is pretty sure it + has enough room for all remaining files. */ + drivestat.j = 'DRAINING' + END + END + WHEN (SUBWORD(endreason,1,1) = 'COMMAND') THEN DO + IF (SUBWORD(endreason,2,1) = 'ENDED') THEN DO /* Abnormal Ending! */ + 'EXEC TELL' runuser 'SPBACKUP ended abnormally. Check the logs.' + /* Note abendmsg below is a nickname from SPBACKUP NAMES. */ + 'EXEC EMAIL ABEND EMAIL * ( ABENDMSG' runuser '(NONOTEBOOK' + END + 'GLOBALV SELECT SPBACKUP PUT STARTTIME' + CALL NORMEND + END + OTHERWISE NOP +END +SAY 'Leaving EOT.' /* debug trace */ +SAY 'NDRIVES=' ndrives 'NINUSE=' ninuse, /* debug trace */ + 'NSPXTAPE=' nspxtape /* debug trace */ +SAY 'virt real tape ' +SAY 'addr addr status volser' +SAY ' ' +DO i = 1 TO vdev.0 + IF (WORDPOS(drivestat.i,'DUMPING DRAINING UNLOADING') > 0) THEN, + 'PIPE CP Q V' vdev.i, + '| SPECS 19.4 1', + '| VAR rdev' + ELSE rdev = '----' + SAY vdev.i ' ' rdev ' ' drivestat.i ' ' drivevol.i +END + +/* Save everything we know */ +CALL COMMONV 'PUT' + +RETURN + + +Unloaded: +/**********************************************************************\ +* * +* UNLOADED major subroutine * +* * +\**********************************************************************/ +/* Triggered by the arrival of a spool file which we suspect is a +SPXTAPE log file. We'll see if that is really the case... Note that if +it is not a SPXTAPE Volume Log file, or if it is not one that WE want, +then we do nothing. Anybody could send us a spool file for whatever +reason pleases them, and we can't let that upset us. */ + +/* Get all the information */ +CALL COMMONV 'GET' + +PARSE UPPER ARG spfn spft . +IF (SUBSTR(spfn,5,4) <> 'DUMP') THEN DO /* Vol or CmdSum log? */ + /* This is a Volume Log */ + donevdev = SUBSTR(spfn,6,3) + found = 0 + DO j = 1 TO vdev.0 + IF (donevdev = vdev.j) THEN DO + found = 1 + LEAVE + END + END + IF (found = 1) THEN DO + SELECT + WHEN (drivestat.j = 'UNLOADING') THEN DO + SAY 'Log file arrived for vdev' donevdev', and unload complete.' + 'CP DETACH' donevdev + drivestat.j = 'IDLE' + END + WHEN (drivestat.j = 'DRAINING') THEN DO /* Operator Asleep */ + SAY 'Log file arrived for vdev' donevdev', but it cannot be', + 'unloaded because it is the last tape. Waiting for Operator.' + END + OTHERWISE NOP /* We REALLY don't want to do anything! */ + END /* of SELECT */ + END /* of IF (found = 1) THEN DO */ + /* ELSE NOP - it's a Vol Log from some other SPXTAPE command. */ +END /* of /* This is a Volume Log */ */ +ELSE NOP /* Ignore Command Summary Log files */ + +/* Save all the information */ +CALL COMMONV 'PUT' + +RETURN + + +MOUNTED: +/**********************************************************************\ +* * +* MOUNTED Major Subroutine * +* * +\**********************************************************************/ +/* This is called when VMTAPE has completed a tape mount for us */ +/* BEWARE: In this routine, our "runuser" is actually VMTAPE. */ + +/* Get all the information */ +CALL COMMONV 'GET' +'GLOBALV SELECT SPBACKUP GET RUNUSER' + +SAY 'Entering MOUNTED:' /* debug trace */ +SAY 'NDRIVES=' ndrives 'NINUSE=' ninuse, /* debug trace */ + 'NSPXTAPE=' nspxtape /* debug trace */ +SAY 'QCOMPLETE=' qcomplete + +IF (qcomplete = 1) THEN DO /* Do we still want this tape? */ + SAY ' ' + SAY 'A tape was attached to us after we no longer needed it. It will' + SAY 'be ignored, and will be detached as the backup job ends.' + SAY ' ' +END +ELSE DO /* Yes, we want this tape. */ + /* Which tape was mounted? Was there more than one? */ + 'PIPE < BACKMOUN SAVEMSGS A', + '| FIND VMTMNT073I' ||, + '| STEM mounteds.', + '| CONSOLE' /* DEBUG TRACE */ + + DO i = 1 TO mounteds.0 + PARSE VAR mounteds.i . 'Volume' mntvolser 'ready on' mntvdev . + mntvolser = STRIP(mntvolser,'B',"'") /* Remove quotes */ + j = WORDPOS(mntvdev,vdevs) /* Which vdev is it? */ + drivestat.j = 'DUMPING' + + /* Mark this tape volume as being in active use */ + DO i = 1 TO tapevol.0 + IF (tapevol.i = drivevol.j) THEN DO + tapestat.i = 'WRITING' + LEAVE + END + END + + /* Bump number of drives SPXTAPE is using */ + nspxtape = nspxtape + 1 + + /* Is this the initial SPXTAPE command? */ + IF (nspxtape = 1) THEN DO /* It is the first one */ + 'PIPE CP SPXTAPE DUMP' vdev.j spxparms, + '| CONSOLE', + '| SPECS /MSGNOH' runuser'/ 1 1-* NEXTWORD', + '| CP', + '| CONSOLE' + END + ELSE DO /* It is a later one */ + k = vdev.0 + 'PIPE CP SPXTAPE DUMP' vdev.1 || '-' || vdev.k, + '| CONSOLE', + '| SPECS /MSGNOH' runuser'/ 1 1-* NEXTWORD', + '| CP', + '| CONSOLE' + END + + /* If there are now exactly two drives, does this mean we can now */ + /* safely get rid of a DRAINING drive? (i.e. Did a sleeping Operator*/ + /* finally wake up and mount the next tape?) */ + trace r + IF (nspxtape = 2) THEN DO + DO i = 1 TO drivevol.0 + IF (drivestat.i = 'DRAINING') THEN DO + SAY 'Our wait is over.' vdev.i 'can now be SPXTAPE END-ed', + 'and DETACH-ed.' + 'PIPE CP SPXTAPE END' vdev.i '| HOLE' + /* Mark this tape volume as having been used */ + DO k = 1 TO tapevol.0 + IF (tapevol.k = drivevol.j) THEN DO + tapestat.k = 'WRITTEN' + LEAVE + END + END + /* We assume the Volume Log for this tape already arrived, */ + /* while we were waiting for the sleeping operator to wake up. */ + /* 'CP REWIND' vdev.i */ /* DO NOT REWIND or INT REQ happens! */ + 'PIPE CP DETACH' vdev.i '| HOLE' /* Must detach */ + drivestat.i = 'IDLE' + drivevol.i = '' + ninuse = ninuse - 1 + nspxtape = 1 + CALL REMOUNT + LEAVE /* Only do this ONCE! */ + END + END + END + trace n + END +END /* of ELSE DO /* Yes, we want this tape. */ */ + +SAY 'leaving MOUNTED:' /* debug trace */ +SAY 'NDRIVES=' ndrives 'NINUSE=' ninuse, /* debug trace */ + 'NSPXTAPE=' nspxtape /* debug trace */ + +/* Save everything we know */ +CALL COMMONV 'PUT' + +RETURN + + +DRIVES: +/**********************************************************************\ +* * +* DRIVES Major Subroutine * +* * +\**********************************************************************/ +/* The operator wishes to change the number of drives in use. */ +/* The runuser here may be any of the operators. Might not be the same +one who started the backup. */ + +PARSE VAR parms newndrives . + +/* Get all the information */ +CALL COMMONV 'GET' +'GLOBALV SELECT SPBACKUP GET RUNUSER' + +oldndrives = ndrives +SAY 'The number of drives was' oldndrives'.' + +sign = SUBSTR(newndrives,1,1) +IF ((sign = '-') | (SIGN = '+')) THEN ndrives = ndrives + newndrives + ELSE ndrives = newndrives + +SAY 'Now it is set to' ndrives'.' + +'GLOBALV SELECT SPBACKUP PUT NDRIVES' + +SELECT + WHEN (ndrives > oldndrives) THEN DO + /* In case it was increased, mount more tapes. */ + CALL REMOUNT + END + WHEN (ndrives < oldndrives) THEN DO + /* See if there are any MOUNTING drives we can take away */ + DO i = 1 TO drivestat.0 + IF (drivestat.i = 'MOUNTING') THEN DO + ADDRESS CMS 'VMTAPE CANCEL' vdev.i + /* Mark this tape volume as having NOT been used */ + DO k = 1 TO tapevol.0 + IF (tapevol.k = drivevol.i) THEN DO + tapestat.k = 'UNUSED' + LEAVE + END + END + /* Mark this vdev as being idle, with nothing mounted on it */ + drivestat.i = 'IDLE' + drivevol.i = '' + ninuse = ninuse - 1 + IF (ninuse <= ndrives) THEN LEAVE /* Accomplished our mission */ + END + END + END + OTHERWISE NOP /* There was no change */ +END + +/* Save everything we know */ +CALL COMMONV 'PUT' + +RETURN + + +QUERY: +/**********************************************************************\ +* * +* QUERY Major Subroutine * +* * +\**********************************************************************/ +/* The runuser here may be any of the operators. Might not be the same +one who started the backup. */ + +'GLOBALV SELECT SPBACKUP GET QBACKUP' +IF (qbackup <> 1) THEN DO + SAY 'Backup job not active.' + RETURN +END + +/* Get everything we need to know */ +CALL COMMONV 'GET' +'GLOBALV SELECT SPBACKUP GET PROGRESS' +'GLOBALV SELECT SPBACKUP GET RUNUSER' + +SAY 'NDRIVES=' ndrives 'NINUSE=' ninuse, /* debug trace */ + 'NSPXTAPE=' nspxtape /* debug trace */ +SAY 'The backup was started by' runuser'.' +SAY 'You have resuested for backup to run on' ndrives 'drives.' +SAY 'Presently,' nspxtape 'are actually running,' +SAY ' and we are waiting for you to mount' (ninuse-nspxtape) 'tapes.' +SAY progress +SAY ' ' +SAY 'virt real tape ' +SAY 'addr addr status volser' +SAY ' ' +DO i = 1 TO vdev.0 + IF (WORDPOS(drivestat.i,'DUMPING DRAINING UNLOADING') > 0) THEN, + 'PIPE CP Q V' vdev.i, + '| SPECS 19.4 1', + '| VAR rdev' + ELSE rdev = '----' + SAY vdev.i ' ' rdev ' ' drivestat.i ' ' drivevol.i +END +SAY ' ' +SAY 'Status of tapes in Tapepool' tapepool':' +SAY ' ' +DO i = 1 TO tapevol.0 + SAY RIGHT(i,2) tapevol.i tapestat.i +END + +RETURN + + +DATA: +/**********************************************************************\ +* * +* DATA Major Subroutine * +* * +\**********************************************************************/ +/* This subroutine is meant to be invoked by a program running in some +user's virtual machine which wants to get information from us. It is +returned by SMSG. */ + +PARSE UPPER ARG varname . +/* Who asked us this question? */ +'PIPE VAR runuser 1 | VAR runuser' +'PIPE CMS GLOBALV SELECT SPBACKUP LIST' varname, + '| DROP FIRST 1', + '| APPEND LITERAL END OF RESPONSE', + '| SPECS /SMSG' runuser '/ 1 1-* NEXT', + '| CP' + +RETURN + + +CANCEL: +/**********************************************************************\ +* * +* CANCEL Major Subroutine * +* * +\**********************************************************************/ +/* End the whole show, right now. */ +/* The runuser here may be any of the operators. Might not be the same +one who started the backup. */ + +DO i = 1 TO vdev.0 + 'CP SPXTAPE CANCEL' vdev.i + 'CP REWIND' vdev.i + 'CP DETACH' vdev.i +END +'GLOBALV SELECT SPBACKUP SETL QBACKUP 0' +ADDRESS CMS 'VMTAPE CANCEL ALL' +finalrc = 0 +RETURN + + +NORMEND: +/**********************************************************************\ +* * +* NORMEND Major Subroutine * +* * +\**********************************************************************/ +/* Called from a TRAP when SPXTAPE reaches its normal end */ +/* We are the runuser here ourselves. */ + +/* Get all information */ +CALL COMMONV 'GET' +'GLOBALV SELECT SPBACKUP GET RUNUSER' +'GLOBALV SELECT SPBACKUP GET STARTTIME' + +/* Unload all the hardware */ +ADDRESS CMS 'VMTAPE CANCEL ALL' +DO i = 1 TO vdev.0 + 'PIPE CP DETACH' vdev.i '| HOLE' +END + +yak = 'CP MSGNOH' runuser +yak ' ' +yak 'BACKUP has finished writing the spool files to tape. Now we must' +yak 'write the logs of this backup to tape. This will take about 10' +yak 'minutes.' +yak ' ' +/* (Delay unnecessary here. All logs have already arrived.) */ +/* 'PIPE LITERAL +2:00', */ +/* '| DELAY', */ +/* '| SPECS /We have waited / 1 1-* NEXT', */ +/* '| CONSOLE' */ + +'PIPE < BACKTRAP SAVEMSGS A | CONSOLE' + +/* Prepare log file */ +logfid = tapepool 'TAPELOG A' +'PIPE COMMAND ERASE' logfid '| HOLE' +'RENAME BACKTRAP SAVEMSGS A' logfid +'PIPE LITERAL ', + '| APPEND LITERAL Tapepool status at end of job:', + '| >>' logfid +DO i = 1 TO tapevol.0 + 'PIPE LITERAL' RIGHT(i,2) RIGHT(tapevol.i,6) tapestat.i, + '| >>' logfid +END +/* Tell the guy who started the whole show */ +'PIPE <' logfid, + '| SPECS /MSGNOH' runuser'/ 1 1-* NEXTWORD', + '| CONSOLE', + '| CP' + +CALL COMMONV 'PUT' + +/* Wrap it up. */ + +CALL WRAPUP starttime tapepool +RETURN result + +Wrapup: +/**********************************************************************\ +* * +* WRAPUP Major Subroutine * +* * +\**********************************************************************/ +/* Post-process the logs */ + +/* Get all information */ +/* CALL COMMONV 'GET' */ /* DON'T re-get - we may be called standalone*/ +'GLOBALV SELECT SPBACKUP GET RUNUSER' +PARSE ARG starttime tapepool . +IF ((starttime = '') | (tapepool = '')) THEN DO + message = 'ARGUMENTS MISSING ON WRAPUP - NEED startime tapepool' + SAY message + RETURN 40 +END + +'PIPE CP 500000 QUERY RDR * ALL', /* Look at all our RDR files */ + '| LOCATE 1-8 /' || ourid || '/', /* That came from me */ + '| LOCATE 15-19 /T CON/', /* That look like SPBACKUP files */ + /* Note we include both Volume Logs and Command Summary Logs below*/, + '| LOCATE 58 /D/', /* That are Dump jobs */ + '| LOCATE 64-69 /' || starttime || '/', /* That are this job */ + '| SPECS 10-13 1', /* and just save the spids */ + '| STEM spids.' +orc = rc +IF (orc <> 0) THEN DO + SAY 'Error encountered locating logs in reader. RC=' orc + RETURN orc +END + +/* Read in the log files one at a time */ +SAY 'Reading console logs...' +'PIPE COMMAND ERASE' tapepool 'UNSORTED A | HOLE' +DO i = 1 TO spids.0 +/* A sample: +ORIGINID FILE CLASS RECORDS CPY HOLD DATE TIME NAME TYPE DIST +U12860 2537 T CON 00000033 001 NONE 01/25 13:01:28 0125DUMP 130128 UICVM +U12860 2536 T CON 00000020 001 NONE 01/25 13:19:28 0125D181 13012803 UICVM +*/ + + /* Get complete info on this spool file */ + 'PIPE CP QUERY RDR *' spids.i 'ALL', + '| TAKE LAST 1', + '| VAR spooldef' + PARSE VAR spooldef originid . class variety . . . . . spfn spft . + SAY 'Examining file' spid spfn spft + SELECT + WHEN (originid <> ourid) THEN NOP /* Ignore not from us */ + WHEN (variety <> 'CON') THEN NOP /* Ignore not CON file */ + WHEN (SUBSTR(spfn,5,4) = 'DUMP') THEN DO /* the main log */ + SAY ' Receiving Command Summary Log' spid spfn spft + ADDRESS CMS 'RECEIVE' spids.i tapepool 'SPXLOG A (REPLACE' + END + OTHERWISE DO /* Read this part in */ + SAY ' Receiving Volume Log' spid spfn spft + /* Spool rdr HOLD so we can read it again */ + 'CP SPOOL RDR NOCONT NOEOF NOKEEP CLASS * HOLD' + 'PIPE (ENDCHAR ?) READER FILE' spids.i, /* Read from reader */ + '| SPECS 2-* 1', /* Get rid of carriage control */ + '| TOLABEL USERID FILE QUEUE' ||, /* Up until detail list*/ + '| BANANA: NFIND TAPE NUMBER:' ||, /* ldev, seq */ + '| FIND Tape Volume ID:' ||, /* Get SL volser */ + '| SPECS 18.6 1', + '| VAR slvol', /* and save it */ + '?', + 'BANANA:', + '| SPECS 22-* 1', + '| VAR tapenum' /* Save ldev, seq */ + 'CP CLOSE READER' /* Rewind in order to reread */ + 'CP SPOOL RDR NOCONT NOEOF NOKEEP CLASS * NOHOLD' /* NOHOLD */ + 'PIPE READER FILE' spids.i, /* Read the real stuff this time */ + '| SPECS 2-* 1', /* Get rid of carriage control */ + '| FRLABEL USERID FILE QUEUE' ||, /* Now, start at detail */ + '| DROP FIRST 1', /* The header line itself. */ + '| SPECS /' || LEFT(slvol,6) || '/ 1', /* Spread the volser...*/ + '/' || LEFT(tapenum,8) || '/ 8', /*...and tapeseq...*/ + '1-* 17', /*...across all the detail records. */ + '| >>' tapepool 'UNSORTED A' /* Write to raw database */ + END + END +END + +/* Sort the records */ +SAY 'Sorting database...' +/* Build SORT control statements to +and put everything in order BY userid, spoolnum. */ +/* Note that these starting locations are +4 for green words */ +'PIPE LITERAL SORT FIELDS=(21,13,CH,A)', + '| PAD 80', /* PLSORT requires F 80 records */ + '| > SPBACKUP SORTCNTL A F 80' + +infid = tapepool 'UNSORTED A' +outfid = tapepool 'DATABASE A' +'PIPE CMS ERASE' outfid '| HOLE' +/************BEGIN LOCAL DEPENDENT CODE *****************************/ +/* Get access to the external sort, and sort the file */ +'EXEC GETDISK SORT' +ADDRESS CMS 'PLSORT' infid outfid 'SPBACKUP SORTCNTL A' +'EXEC GETDISK SORT (FREE' +/************ END LOCAL DEPENDENT CODE *****************************/ + +/* We're done with the unsorted version, and it's pretty big. */ +'ERASE' tapepool 'UNSORTED A' + +/* Build the database index file */ +SAY 'Building database index...' +'PIPE <' tapepool 'DATABASE A', + '| SPECS 17.8 1 RECNO 10', + '| UNIQUE 1-8 FIRST', + '| >' tapepool 'DBINDEX A' + +/* TAPE DUMP today's logs to tape. */ +SAY 'Writing database to tape...' +/* Mount the first tape */ +'GLOBALV SELECT SPBACKUP GET TAPEPOOL' +/* Get the list of tapes to use */ +'PIPE <' tapepool 'TAPEPOOL *', + '| NFIND *' ||, /* Eliminate comments */ + '| SPECS 1-6 1', /* Just the volsers */ + '| STEM tapevol.' +'PIPE CMS VMTAPE MOUNT' tapevol.1 181 '(WRITE WAIT', + '| STEM errstem.' +orc = rc +IF (orc <> 0) THEN DO + SAY 'Error occured trying to mount tape. TAPEPOOL error?' + 'PIPE STEM errstem. | CONSOLE' + finalrc = orc + RETURN +END + +/* Copy everything relevant to tape. */ +'TAPE REW' +'PIPE TAPE | CONSOLE' /* Skip over, and display, standard label */ +'TAPE REW' +'TAPE FSF 1' +'TAPE DUMP' tapepool 'SPXLOG A (COMP BLKSIZE 64K' +'TAPE DUMP' tapepool 'TAPELOG A (COMP BLKSIZE 64K' +'TAPE DUMP' tapepool 'DBINDEX A (COMP BLKSIZE 64K' +'TAPE DUMP' tapepool 'DATABASE A (COMP BLKSIZE 64K' +'TAPE WTM 2' +'TAPE REW' +'CP DETACH 181' + +'GLOBALV SELECT SPBACKUP SETL QBACKUP 0' +SAY 'Backup complete.' +yak = 'CP MSGNOH' runuser +yak ' ' +yak 'BACKUP has finished writing the restore catalog to tape. Spool' +yak 'backup is now complete. Thank you.' +yak ' ' +RETURN rc diff --git a/vmworkshop-vmarcs/1996/spbackup/email.exec b/vmworkshop-vmarcs/1996/spbackup/email.exec new file mode 100644 index 0000000..c0f7a9c --- /dev/null +++ b/vmworkshop-vmarcs/1996/spbackup/email.exec @@ -0,0 +1,83 @@ +/* Send a message as e-mail. The message is contained in the CMS file +whose name is passed as this program's arguments. The message will be +scanned for the change strings passed in the stack. + +SYNTAX: + +EXEC EMAIL fn ft fm (JOHNDOE (NONOTEBOOK + ||||||| |||||||||| + Recipient(s) NOTE cmd options + +FORMAT OF STACKED LINES: + +/&NAME/John Doe/ +/&SVMNAME/RSCS/ +!&SCP!VM/ESA! + +The message file should begin with the "Subject:" line, followed by a +single blank line, followed by the body of the message starting on line 3 + +When creating test and changes, be careful not to extend lines too long. + +THIS PROGRAM EXPLOITS THE STACK. It expects data for it to be on the +stack, and then it uses the stack internally. Calling programs should +not depend upon the state of the stack before or after this program. + +MODIFICATION HISTORY: +02/17/95 - Roger Deschner - Original version +*/ +PARSE UPPER ARG msgfn msgft msgfm '(' noteopts +/* Are we being called as an EXEC or as an XEDIT Profile? */ +IF (msgfn = ')PROFILE') THEN SIGNAL PROFILE + +/* Mainline code */ +ADDRESS COMMAND + +IF (msgfm = '') THEN msgfm = '*' +ADDRESS CMS 'ESTATE' msgfn msgft msgfm +IF (rc <> 0) THEN EXIT rc + +/* Pull changes off the stack; write pipeline stages. */ +IF (QUEUED() > 0) THEN DO + 'PIPE (STAGESEP \) STACK', + '\ SPECS /| CHANGE/ 1 1-* NEXTWORD', + '\ JOIN *', + '\ VAR changes' +END +ELSE DO + changes = '' +END + + +/* Read in the file and change it. */ + +QUEUE 'EXEC EMAIL )PROFILE' +'PIPE <' msgfn msgft msgfm, + changes, + '| SPECS /I / 1 1-* NEXT', /* Make into XEDIT INPUT commands */ + '| PAD 3', /* Minimum length for I command */ + '| STACK' +QUEUE 'SEND' +'EXEC NOTE' noteopts +EXIT + + +/**********************************************************************\ +* THIS IS AN XEDIT PROFILE: * +\**********************************************************************/ +PROFILE: +ADDRESS XEDIT +'SET CASE M I' +'EXTRACT /MSGMODE' +'SET MSGMODE OFF' +/* Get rid of Subject line and blank line after it, if present. */ +'TOP' +'FIND Subject:' +orc = rc +IF (orc = 0) THEN 'DELETE *' +/* Last line blank? */ +'BOTTOM' +'EXTRACT /CURLINE' +IF (curline.3 = ' ') THEN 'DELETE 1' +'SET MSGMODE' msgmode.1 msgmode.2 +EXIT diff --git a/vmworkshop-vmarcs/1996/spbackup/fri.tapepool b/vmworkshop-vmarcs/1996/spbackup/fri.tapepool new file mode 100644 index 0000000..b4a9802 --- /dev/null +++ b/vmworkshop-vmarcs/1996/spbackup/fri.tapepool @@ -0,0 +1,21 @@ +* This is a SPBACKUP tapepool for Friday morning jobs +RDFR00 +RDFR01 +RDFR02 +RDFR03 +RDFR04 +RDFR05 +RDFR06 +RDFR07 +RDFR08 +RDFR09 +RDFR10 +RDFR11 +RDFR12 +RDFR13 +RDFR14 +RDFR15 +RDFR16 +RDFR17 +RDFR18 +RDFR19 diff --git a/vmworkshop-vmarcs/1996/spbackup/install.memo b/vmworkshop-vmarcs/1996/spbackup/install.memo new file mode 100644 index 0000000..1e72ee3 --- /dev/null +++ b/vmworkshop-vmarcs/1996/spbackup/install.memo @@ -0,0 +1,94 @@ + S P B A C K U P + INSTALLATION INSTRUCTIONS + + Spool Backup System, using SPXTAPE + University of Illinois at Chicago + June 22, 1996 + + +SPBACKUP is a spool backup system which uses the new SPXTAPE command to +back up the spool. It's purpose is to create an interface between the CP +SPXTAPE command, and the VMTAPE tape system, and to create catalogs and +indexes to facilitate restores. + +Prerequisites: + + 1) VM/ESA Version 2 (2.1.0+) (See below if earlier VM) + 2) CMS/IPF Utilities Set + +To install SPBACKUP: + +Create a directory entry for it, similar to this: + + USER SPBACKUP password 5M 8M ABDGM 64 OFF OFF 16 OFF + INCLUDE SYSACCTM <-- usual for your installation + IPL CMS + OPTION MAXCONN 255 + IUCV ALLOW PRIORITY MSGLIMIT 255 + * 191: Work files, scratch files, RESTORE CATALOGS + MDISK 191 3390 1218 400 VM0935 MR + * 3E1: SVM's Executable code, configuration files, TAPEPOOL DEFINITIONS + * Note this is an RR link so you can get a M link and change stuff + MDISK 3E1 3390 1 1 VM0920 RR + +The size of the 191 minidisk will be determined by how many spool files +you will typically have in your system, and how many backup cycles you +are going to keep. The 400 cylinder size is about right for 200,000 spool +files, and 8 cycles (7 days plus one for emergency backups.) + +Insure that the 3E1 minidisk has access mode RR in the directory! This is +to allow you to reconfigure the server on the fly. + +Load all files onto the 3E1 minidisk, except for file PROFILE EXEC which +must be on the 191 minidisk, and file SPBACKUP EXEC which must be placed +on some minidisk that all Operators and Systems Programmers have access +to. End-users need not have access to SPBACKUP EXEC, but it won't hurt if +they do, as they are prevented from doing anything if they are not listed +in the CONFIG file. (below). Therefore, you could place it on your Y disk +if you have no other, more private, place. + +Edit file SPBACKUP CONFIG to define the list of users authorized to use +the program. + +If your Sterling VM:Tape Service Virtual is not named VMTAPE, you will +need to review all EXEC files to change it. Search for the string +CONFIGURATION SECTION in each one. It needs to be changed in only one +place in each EXEC file. + +Insure that the CMS Utilities are available to the SPBACKUP service +virtual. This may involve a directory LINK statement. + +Insure that an external file sorting program is available to the program, +such as PLSort or SyncSort. Edit file BACKUP EXEC, and do a string search +on LOCAL DEPEND to find where to modify the program to get access to your +sorting program and run it. If your sorting program can benefit from +additional storage, do it. + +If your tape drives do not support hardware compression, edit file BACKUP +EXEC, search for its CONFIGURATION SECTION, and edit the SPXTAPE options +string to remove the keyword COMP. Enter HELP SPXTAPE DUMP for details +about the COMP option. If in doubt about your tape hardware, try it first +with COMP; it really helps. + +If you are running a version of VM before ESA 2.1.0, you will need to +modify the code in BACKUP EXEC to trap the volser of the tape at the +point at which the Volume Log is returned. This may not be a trivial mod; +I didn't do it because I didn't need to. + +Edit the TAPEPOOL files, to contain the volsers of the sets of tapes you +want to use. Insure that those tapes are in the VMTAPE catalog, and that +the tapes actually exist in your rack, and are initialized with matching +OS Standard Labels. (Use TAPE WVOL1.) + +Compiling the code with the Rexx compiler will only help slightly. The +greatest performance gains can be achieved by experimenting with more or +fewer tape drives, and by training your operators to respond quickly to +VMTAPE tape mount requests. (See SYSOPTAP for something which may help +here.) + +Distribute copies of SPBACKUP OPERATE to your operators. + +SPBACKUP was written by: + +Roger Deschner University of Illinois at Chicago rogerd@uic.edu +Computer Center M/C 135, 1940 W. Taylor St., Room 124, Chicago, IL 60612 diff --git a/vmworkshop-vmarcs/1996/spbackup/ipl.tapepool b/vmworkshop-vmarcs/1996/spbackup/ipl.tapepool new file mode 100644 index 0000000..d2ac2f0 --- /dev/null +++ b/vmworkshop-vmarcs/1996/spbackup/ipl.tapepool @@ -0,0 +1,21 @@ +* This is a SPBACKUP tapepool for test and special use +RDIP00 +RDIP01 +RDIP02 +RDIP03 +RDIP04 +RDIP05 +RDIP06 +RDIP07 +RDIP08 +RDIP09 +RDIP10 +RDIP11 +RDIP12 +RDIP13 +RDIP14 +RDIP15 +RDIP16 +RDIP17 +RDIP18 +RDIP19 diff --git a/vmworkshop-vmarcs/1996/spbackup/mon.tapepool b/vmworkshop-vmarcs/1996/spbackup/mon.tapepool new file mode 100644 index 0000000..9ebb29a --- /dev/null +++ b/vmworkshop-vmarcs/1996/spbackup/mon.tapepool @@ -0,0 +1,21 @@ +* THIS IS A SPBACKUP TAPEPOOL FOR MONDAY MORNING JOBS +RDMO00 +RDMO01 +RDMO02 +RDMO03 +RDMO04 +RDMO05 +RDMO06 +RDMO07 +RDMO08 +RDMO09 +RDMO10 +RDMO11 +RDMO12 +RDMO13 +RDMO14 +RDMO15 +RDMO16 +RDMO17 +RDMO18 +RDMO19 diff --git a/vmworkshop-vmarcs/1996/spbackup/operate.memo b/vmworkshop-vmarcs/1996/spbackup/operate.memo new file mode 100644 index 0000000..b2dd294 --- /dev/null +++ b/vmworkshop-vmarcs/1996/spbackup/operate.memo @@ -0,0 +1,115 @@ + S P B A C K U P + + OPERATING INSTRUCTIONS + April 10, 1996 + + +SPBACKUP is a spool backup system which uses the new SPXTAPE command to +back up the spool. It's purpose is to create an interface between the CP +SPXTAPE command, and the VMTAPE tape system, and to create catalogs and +indexes to facilitate restores. It replaces the old SPTAPE command. + +SPBACKUP is a service virtual which is always logged on. You communicate +with it by the SPBACKUP exec, SPBACKUP EXEC prompts you for all the +information it needs, and then handles communications with the SPBACKUP +service virtual. + +It will send information about its progress to the userid who issued the +command to start it, however any authorized user may use the Query option +to request progress information. + +EXAMPLE: + +R; spbackup + SPBACKUP Spool Backup System + + Type a letter and press ENTER: + + Q QUERY current status of backup jobs + S START a backup job + D Change number of DRIVES currently in use for backup. + C CANCEL currently running backup job. + + ...or just press enter without typing anything to leave. + +The Q option will tell you if a spool backup job is currently running, +and if it is, which tapes are mounted on which drives, and how far along +(in %done) the job is. + +The S option will start a spool backup job. Once a SPBACKUP backup is +started, it will not allow a second one to be started. The S option will +issue prompts for tapepool name, and for the number of drives you wish to +use. + +START BACKUP JOB EXAMPLE: + + Enter tapepool name: SUN MON TUE WED THU FRI SAT IPL, + or press Enter for default MON - + + Enter number drives, from 2 to 12, or just press Enter to quit. + (3 to 5 drives usually provides best performance.) + 4 + + You have requested to start a spool backup using Tape Pool IPL + on 5 tape drives. This will overwrite and erase the previous + backup which was written on Tape Pool IPL. This backup will take + from 1.5 to 3 hours to run. Type "Y" to confirm and start this backup + or type anything else to quit now without starting anything. + + Start the backup now? (Y or N) - + y + +There are Tape Pools corresponding to each day of the week, plus one more +for special backups called IPL. + +Tape pools are defined on minidisk SPBACKUP 3E1, which you can get a +WRITE link to and edit to add tapes, etc. If you change something on +disk 3E1, the command SMSG SPBACKUP RLDDATA will make the server reaccess +its read-only link to this disk, so it will see your changes. + +SPBACKUP requires a minimum of two tape drives. This is so that the +backup can continue while you are mounting the next tape, after one tape +is filled. Of course, it runs faster with more drives - up to a point. +Early tests indicate that using more than 6 drives does not provide any +additional speed. Using fewer drives will result in using fewer total +tapes, because there will be fewer unfilled tapes when the job completes. +(Therefore, you may wish to reduce the number of drives to 2 as a job +nears completion, to minimize the number of unfilled tapes, but this is +not essential.) + +New tapes will be mounted one at a time as the previous ones are filled. +There is no need to reserve particular drives; VMTAPE is in full control +of the drives at all times, and will assign them to SPBACKUP just like to +any other user. + +You can start with any number of drives, and change this upwards and +downwards in the middle of the backup job, using the D (drives) option. + +If this is more than were being used before, it will immediately start +those drives and issue VMTAPE mounts for tapes to use on those new +drives. If this is fewer than were being used before, it will wait until +the next tape fills up, and then simply not mount another tape to replace +the one which filled up, until it gets down to the number of drives you +specified. (Minimum two drives.) + +SPBACKUP needs to use a minimum of two tape drives; it cannot work with +just one drive. + +The "C" (CANCEL) option will cancel an in-progress backup job before it +is done. IF YOU CANCEL, YOU WILL NEED TO RESTART THIS BACKUP FROM THE +BEGINNING. + +POST-PROCESSING: After the backup is complete, the monitor svm will +process the SPXTAPE log files into a database which will enable us to +restore easily, and then write that database to one of the tape pool +tapes with TAPE DUMP. While this post-processing is underway (about 10 +minutes) the service virtual will consume a lot of CPU time, and will +not respond to queries. When it finishes building the restore catalog +database and index, it will request one tape mount so it can back them +up too. + +RESTORES: At this point, restores must be handled manually by the +Systems Programming Staff. + +AUTHORIZATION: The list of users authorized to communicate with +SPBACKUP is contained in file SPBACKUP CONFIG on minidisk SPBACKUP 3E1. diff --git a/vmworkshop-vmarcs/1996/spbackup/process.exec b/vmworkshop-vmarcs/1996/spbackup/process.exec new file mode 100644 index 0000000..d470c38 --- /dev/null +++ b/vmworkshop-vmarcs/1996/spbackup/process.exec @@ -0,0 +1,163 @@ +/* PROCESS EXEC for SPBACKUP: + +Wait for IUCV's mostly, and occasionally set a timer in case something +needs to be waited for. + +This routine saves NOTHING in its ownm Rexx variable pool. All +information intended to be saved should be stored in GLOBALV. + +MODIFICATION HISTORY: +04/04/96 - Roger - Add RESTORE, DATA functions +02/13/96 - Roger - Original version (stolen from ZPRINTER) + +Wakeup Return Codes: + -2 First time invocation from CMS subset (WAKEUP cannot be + invoked from CMS subset) + 0 Nothing to wait for--all timer file options are done + 1 VMCF/SMSG received and stacked + 2 The specified time period has elapsed + 3 A time from the timer file has been reached + 4 A reader file of the proper class has arrived + 5 A message has arrived + 6 Interrupt from the virtual console + 7 I/O interrupt + 8 External interrupt + 100 Explanation complete (when '?' specified) + 101 Empty file in card reader, RDR option (RC from FSREAD) + 103 Unknown error from card reader, RDR option (RC from FSREAD) +*/ +ADDRESS COMMAND + +/*************** BEGIN CONFIGURATION SECTION **************************/ +/* Userid of the VMTAPE service virtual */ +vmtapeid = 'VMTAPE' +/***************** END CONFIGURATION SECTION **************************/ + +/* Read configuration information */ +'PIPE < SPBACKUP CONFIG *', /* Authorized userids */ + '| NFIND *' ||, /* Eliminate comment lines */ + '| SPECS WORDS 1 1', /* Just take first token */ + '| XLATE UPPER', /* Fold to uppercase */ + '| JOIN * / /', /* Make into one big string */ + '| VAR authusers' + + /* WAKEUP when the first of these occurs: + o A console interrupt occurs + o A spool file arrives containing a restore job + o An IUCV or SMSG interrupt occurs, which could be any of: + *MSG - CP MSG or MSGNOH command + *WNG - CP WNG command + *EMSG - SET EMSG IUCV + *IMSG - SET IMSG IUCV + *SMSG - SET SMSG IUCV + *CP - SET CPCONIO IUCV + *VM - SET VMCONIO IUCV + */ +'CP SET MSG IUCV' +'CP SET SMSG IUCV' +'CP SET CPCONIO IUCV' +DO FOREVER + SAY DATE('USA') TIME() 'At your service.' + 'WAKEUP (CONS IUCVMSG' + wakerc = rc + /* OK, who woke us up? What happened? Why? What's going on? */ + SELECT + WHEN ((wakerc = 1) | (wakerc = 5)) THEN DO + PARSE PULL msgtype runuser textline + SELECT + WHEN (msgtype = '*CP') THEN DO + SAY textline + ADDRESS COMMAND 'EXEC BACKTRAP' textline + orc = rc + END + WHEN ((msgtype = '*MSG') | (msgtype = '*SMSG')) THEN DO + IF (runuser = vmtapeid) THEN DO + SAY textline + ADDRESS COMMAND 'EXEC BACKMOUN' textline + END + ELSE DO + SAY textline + /* Somebody is trying to tell us something */ + PARSE VAR textline action parms + UPPER action + + /* Check for shortcut commands */ + IF (WORDPOS(action,'START QUERY DRIVES CANCEL DATA') > 0), + THEN DO + parms = textline + action = 'BACKUP' + END + + CALL SECURITY runuser action parms + IF (result <> 0) THEN DO + 'EXEC TELL' runuser 'Unauthorized command.' + END + ELSE DO /* This guy's OK. Do it. */ + SELECT + WHEN (action = 'BACKUP') THEN DO + 'PIPE COMMAND EXEC BACKUP' parms, + '| CONSOLE', + '| SPECS \CP MSGNOH' runuser '\ 1 1-* NEXT', + '| COMMAND', + '| CONSOLE' + finalrc = rc + END + WHEN (action = 'RESTORE') THEN DO + 'PIPE COMMAND EXEC RESTORER' parms, + '| CONSOLE', + '| SPECS \CP MSGNOH' runuser '\ 1 1-* NEXT', + '| COMMAND', + '| CONSOLE' + finalrc = rc + END + WHEN (action = 'RLDDATA') THEN DO + 'CP SET MSG ON' + 'CP SET SMSG ON' + 'CP SET CPCONIO OFF' + CALL VERYLAST + 'PIPE COMMAND ACCESS 3E1 C', + '| LITERAL' userid() 'has executed:', + '| CONSOLE', + '| SPECS /CP MSGNOH' runuser '/ 1 1-* NEXT', + '| CP', + '| CONSOLE' + 'CONWAIT' + 'DESBUF' + QUEUE 'EXEC PROCESS' + CALL EXIT 0 + END + OTHERWISE DO + 'EXEC TELL' runuser 'Unknown command:' action + END + END + END + END + END + OTHERWISE DO + SAY 'Unknown activity.' + END + END + END + OTHERWISE DO /* If something funny happened, leave.*/ + SAY 'Terminating due to console interrupt.', + 'Enter PROCESS to resume. WAKEUP rc' wakerc + /* 'WAKEUP RESET' */ /* turn messages from IUCV to ON */ + CALL EXIT 40 + END + END /* End of SELECT on type of WAKEUP interrupt */ +END + +EXIT: +PARSE ARG finalrc . +'CP SET MSG ON' +'CP SET SMSG ON' +'CP SET CPCONIO OFF' +EXIT finalrc + +SECURITY: PROCEDURE EXPOSE authusers +PARSE UPPER ARG runuser action . +IF (WORDPOS(runuser,authusers) > 0) THEN ok = 0; ELSE ok = 4 +RETURN ok + +/* To insure this entire program is in core when doing ACCESS */ +VERYLAST: RETURN diff --git a/vmworkshop-vmarcs/1996/spbackup/profile.exec b/vmworkshop-vmarcs/1996/spbackup/profile.exec new file mode 100644 index 0000000..81f68d1 --- /dev/null +++ b/vmworkshop-vmarcs/1996/spbackup/profile.exec @@ -0,0 +1,28 @@ +/* PROFILE EXEC for the SPBACKUP virtual machine. Place this on 191-A. +All other files go on the 3E1 minidisk. +See file PROCESS EXEC on minidisk 3E1 for everything else. + +MODIFICATION HISTORY: +04/19/96 - Roger Deschner - Add TERMINAL LINEND # to allow #CP DISC. +02/13/96 - Roger Deschner - Original version. +*/ +'CP TERMINAL LINEND #' +'CP SET PF06 RETRIEVE' +'CP SET PF18 RETRIEVE' +'CP LINK * 3E1 3E1 RR' /* Change this address if you wish */ +'ACCESS 3E1 C' /* Access this server's tailorable minidisk */ + +'GLOBALV SELECT SPBACKUP SETL QBACKUP 0' + +'PIPE CP QUERY USER' USERID() '| VAR qustring' +PARSE UPPER VAR qustring . . termaddr . +IF (termaddr ^= 'DSC') THEN DO + /* Tell the human user how to do our thingy */ + SAY 'Terminal session detected. Entering CMS.' + SAY 'Enter the command "PROCESS" to continue as though disconnected.' +END +ELSE DO + /* Do our thingy */ + PUSH 'EXEC PROCESS' +END +EXIT diff --git a/vmworkshop-vmarcs/1996/spbackup/sat.tapepool b/vmworkshop-vmarcs/1996/spbackup/sat.tapepool new file mode 100644 index 0000000..d554db1 --- /dev/null +++ b/vmworkshop-vmarcs/1996/spbackup/sat.tapepool @@ -0,0 +1,21 @@ +* THIS IS A SPBACKUP TAPEPOOL FOR SATURDAY MORNING JOBS +RDSA00 +RDSA01 +RDSA02 +RDSA03 +RDSA04 +RDSA05 +RDSA06 +RDSA07 +RDSA08 +RDSA09 +RDSA10 +RDSA11 +RDSA12 +RDSA13 +RDSA14 +RDSA15 +RDSA16 +RDSA17 +RDSA18 +RDSA19 diff --git a/vmworkshop-vmarcs/1996/spbackup/spbackup.config b/vmworkshop-vmarcs/1996/spbackup/spbackup.config new file mode 100644 index 0000000..e41e0f0 --- /dev/null +++ b/vmworkshop-vmarcs/1996/spbackup/spbackup.config @@ -0,0 +1,10 @@ +* SPBACKUP CONFIG +* +* (Comments are indicated by a * in column 1, like this line.) +* +* List of authorized users for SPBACKUP +* +* The systems guy: +MAINT +* The operator: +OPERATOR \ No newline at end of file diff --git a/vmworkshop-vmarcs/1996/spbackup/spbackup.exec b/vmworkshop-vmarcs/1996/spbackup/spbackup.exec new file mode 100644 index 0000000..d27db2e --- /dev/null +++ b/vmworkshop-vmarcs/1996/spbackup/spbackup.exec @@ -0,0 +1,289 @@ +/* SPBACKUP EXEC: +Driver routine to prompt you through all SPBACKUP operations. + +PREREQUISITES: +GETFMADR, from the CMS Utilities/IPF set of tools. + +MODIFICATION HISTORY: +04/01/96 - Roger Deschner - Original Version + +*/ +ADDRESS COMMAND + +tapepools = 'SUN MON TUE WED THU FRI SAT IPL' + +PARSE UPPER ARG ')' specialkey specialopts +finalrc = 0 +SELECT + WHEN (specialkey = '') THEN DO + 'VMFCLEAR' + DO FOREVER + SAY ' SPBACKUP Spool Backup System' + SAY ' ' + SAY 'Type a letter and press ENTER:' + SAY ' ' + SAY 'Q QUERY current status of backup jobs' + SAY 'S START a backup job' + SAY 'D Change number of DRIVES currently in use for backup.' + SAY 'C CANCEL currently running backup job.' + SAY 'R RESTORE one or more files for a user' + SAY ' ' + SAY '...or just press enter without typing anything to leave.' + SAY ' ' + PARSE UPPER PULL answer . + SELECT + WHEN (answer = '') THEN EXIT 0 + WHEN (answer = 'Q') THEN 'CP SMSG SPBACKUP BACKUP QUERY' + WHEN (answer = 'S') THEN CALL Starter + WHEN (answer = 'D') THEN CALL Driver + WHEN (answer = 'C') THEN CALL Canceller + WHEN (answer = 'R') THEN DO + SAY 'NOTE SYSTEMS, fully describing what you want restored.' + SAY 'Include: userid, last date backed up, spool file number', + 'or any other' + SAY 'identifying information. NOTICE: Spool backups are only', + 'kept for 7 days,' + SAY 'so if your file was backed up nearly that long ago,', + 'notify SYSTEMS _now_' + SAY 'in person or by paging, so that the backup', + 'tapes will not be' + SAY 'written over before your files can be restored.' + END + OTHERWISE DO + 'VMFCLEAR' + SAY ' ' + SAY '**ERROR** Invalid choice. Try again.' + SAY ' ' + ITERATE + END + END + LEAVE + END + END + OTHERWISE DO + SAY 'iNVALID KEYWORD.' + finalrc = 16 + END +END + + +RETURN finalrc + + +Qbackup: +/**********************************************************************\ +* FUNCTION SUBPROGRAM to determine if a backup is already running. * +\**********************************************************************/ +/* To call: xyzzy = QBACKUP() + + or: CALL QBACKUP + xyzzy = result + + Returns as its value: + 0 = backup is not running. No message issued. + 1 = backup is running. No message issued. + 55 = Server not responding. Message already issued. +*/ + +'CP SET SMSG IUCV' +'PIPE (ENDCHAR ?)', + ' STARMSG *MSG CP SMSG SPBACKUP DATA QBACKUP', + '| SPECS 17-* 1', /* strip starmsg and RSCS prefix */ + '| STEM response.', + '| FIND END OF RESPONSE', /* end of response */ + '| Stop: FANINANY', + '| SPECS /PIPMOD STOP/ 1', /* Stop pipeline */ + '| COMMAND', + '?', + ' LITERAL +15', /* specify delay */ + '| DELAY', /* timeout if no response*/ + '| Stop:' +src = rc +'CP SET SMSG OFF' +PARSE UPPER VAR response.1 vname '=' value . +IF (value = '') THEN DO + SAY 'Server not responding.' + result = 55 + RETURN +END +ELSE RETURN value + + +Starter: +/**********************************************************************\ +* Start a backup job * +\**********************************************************************/ + +CALL QBACKUP /* Ask server if a backup is running */ +SELECT + WHEN (result = 0) THEN NOP /* Goodness! */ + WHEN (result = 1) THEN DO + SAY 'Cannot start a backup because one is already running.' + SAY 'Use the Query option for more details.' + finalrc = 40 + RETURN + END + OTHERWISE DO /* Any other RESULT is an error code */ + finalrc = result + RETURN + END +END + +/* Set default tapepool to today: */ +dow = TRANSLATE(SUBSTR(DATE('W'),1,3)) + +SAY ' ' +SAY 'Enter tapepool name:' tapepools',' +SAY 'or press Enter for default' dow '-' +PARSE UPPER PULL tapepool . +IF (tapepool = '') THEN tapepool = dow +IF (WORDPOS(tapepool,tapepools) < 1) THEN DO + SAY 'Tape pool must be one of' tapepools + finalrc = 16 + RETURN +END +SAY 'Using tapepool' tapepool'.' + +SAY ' ' +SAY 'Enter number drives, from 2 to 12, or just press Enter to quit.' +SAY '(3 to 5 drives usually provides best performance.)' +PARSE PULL ndrives . + +IF (DATATYPE(ndrives,'W') <> 1) THEN DO + SAY 'Number of drives must be a whole number.' + finalrc = 16 + RETURN +END +IF ((ndrives < 2) | (ndrives > 12)) THEN DO + SAY 'Number of drives must be between 2 and 12.' + finalrc = 16 + RETURN +END + +'VMFCLEAR' +SAY ' ' +SAY 'You have requested to start a spool backup using Tape Pool' tapepool +SAY 'on' ndrives 'tape drives. This will overwrite and erase the', + 'previous' +SAY 'backup which was written on Tape Pool' tapepool'. This backup', + 'will take' +SAY 'from 1.5 to 3 hours to run. Type "Y" to confirm and start this', + 'backup,' +SAY 'or type anything else to quit now without starting anything.' +SAY ' ' +SAY 'Start the backup now? (Y or N) -' +PARSE UPPER PULL answer . +IF (answer = 'Y') THEN 'CP SMSG SPBACKUP BACKUP START' tapepool ndrives +finalrc = 0 +RETURN + + +Driver: +/**********************************************************************\ +* Change number of drives in use * +\**********************************************************************/ + +CALL QBACKUP /* Ask server if a backup is running */ +SELECT + WHEN (result = 1) THEN NOP /* Goodness! */ + WHEN (result = 0) THEN DO + SAY 'Cannot change number of drives because no backup is running.' + finalrc = 40 + RETURN + END + OTHERWISE DO /* Any other RESULT is an error code */ + finalrc = result + RETURN + END +END + +/* How many drives is it running with at the present? */ +'CP SET SMSG IUCV' +'PIPE (ENDCHAR ?)', + ' STARMSG *MSG CP SMSG SPBACKUP DATA NDRIVES', + '| SPECS 17-* 1', /* strip starmsg and RSCS prefix */ + '| STEM response.', + '| FIND END OF RESPONSE', /* end of response */ + '| Stop: FANINANY', + '| SPECS /PIPMOD STOP/ 1', /* Stop pipeline */ + '| COMMAND', + '?', + ' LITERAL +15', /* specify delay */ + '| DELAY', /* timeout if no response*/ + '| Stop:' +src = rc +'CP SET SMSG OFF' +PARSE UPPER VAR response.1 vname '=' value . +IF (value = '') THEN DO + SAY 'Server not responding.' + finalrc = 55 + RETURN +END + +SAY ' ' +SAY 'Backup is presently running with' value 'drives.' +SAY ' ' +SAY 'Enter new number of drives, or just press enter to do nothing -' +PARSE PULL ndrives . +IF (ndrives = '') THEN DO + finalrc = 0 + RETURN +END + +IF (DATATYPE(ndrives,'W') <> 1) THEN DO + SAY 'Number of drives must be a whole number.' + finalrc = 16 + RETURN +END +IF ((ndrives < 2) | (ndrives > 12)) THEN DO + SAY 'Number of drives must be between 2 and 12.' + finalrc = 16 + RETURN +END + +'CP SMSG SPBACKUP BACKUP DRIVES' ndrives + +finalrc = 0 +RETURN + + +Canceller: +/**********************************************************************\ +* Cancel a running BACKUP job * +\**********************************************************************/ + +CALL QBACKUP /* Ask server if a backup is running */ +SELECT + WHEN (result = 1) THEN NOP /* Goodness! */ + WHEN (result = 0) THEN DO + SAY 'Cannot cancel backup, because no backup is running.' + finalrc = 40 + RETURN + END + OTHERWISE DO /* Any other RESULT is an error code */ + finalrc = result + RETURN + END +END + +'VMFCLEAR' +SAY ' ' +SAY ' ' +SAY ' ' +SAY ' ' +SAY ' ' +SAY ' ' +SAY 'Are you really sure you want to cancel the Spool Backup Job?' +SAY ' ' +SAY 'Type "CANCEL" again now to verify, or anything else to not cancel:' +PARSE UPPER PULL answer . +IF (answer <> 'CANCEL') THEN DO + SAY 'Not cancelled.' + finalrc = 8 + RETURN +END + +'CP SMSG SPBACKUP BACKUP CANCEL' + +finalrc = 0 +RETURN diff --git a/vmworkshop-vmarcs/1996/spbackup/spbackup.names b/vmworkshop-vmarcs/1996/spbackup/spbackup.names new file mode 100644 index 0000000..7898b6d --- /dev/null +++ b/vmworkshop-vmarcs/1996/spbackup/spbackup.names @@ -0,0 +1 @@ +:nick.ABENDMSG :list.MAINT diff --git a/vmworkshop-vmarcs/1996/spbackup/sun.tapepool b/vmworkshop-vmarcs/1996/spbackup/sun.tapepool new file mode 100644 index 0000000..dc5a9ed --- /dev/null +++ b/vmworkshop-vmarcs/1996/spbackup/sun.tapepool @@ -0,0 +1,21 @@ +* THIS IS A SPBACKUP TAPEPOOL FOR SUNDAY MORNING JOBS +RDSU00 +RDSU01 +RDSU02 +RDSU03 +RDSU04 +RDSU05 +RDSU06 +RDSU07 +RDSU08 +RDSU09 +RDSU10 +RDSU11 +RDSU12 +RDSU13 +RDSU14 +RDSU15 +RDSU16 +RDSU17 +RDSU18 +RDSU19 diff --git a/vmworkshop-vmarcs/1996/spbackup/test.tapepool b/vmworkshop-vmarcs/1996/spbackup/test.tapepool new file mode 100644 index 0000000..74a060e --- /dev/null +++ b/vmworkshop-vmarcs/1996/spbackup/test.tapepool @@ -0,0 +1,7 @@ +* This is a SPBACKUP tapepool for development and testing. +MVS1 +MVS2 +MVS3 +MVS4 +MVS5 +MVS6 diff --git a/vmworkshop-vmarcs/1996/spbackup/thu.tapepool b/vmworkshop-vmarcs/1996/spbackup/thu.tapepool new file mode 100644 index 0000000..f70b8b5 --- /dev/null +++ b/vmworkshop-vmarcs/1996/spbackup/thu.tapepool @@ -0,0 +1,21 @@ +* This is a SPBACKUP tapepool for Thursday jobs +RDTH00 +RDTH01 +RDTH02 +RDTH03 +RDTH04 +RDTH05 +RDTH06 +RDTH07 +RDTH08 +RDTH09 +RDTH10 +RDTH11 +RDTH12 +RDTH13 +RDTH14 +RDTH15 +RDTH16 +RDTH17 +RDTH18 +RDTH19 diff --git a/vmworkshop-vmarcs/1996/spbackup/tue.tapepool b/vmworkshop-vmarcs/1996/spbackup/tue.tapepool new file mode 100644 index 0000000..ccf65ae --- /dev/null +++ b/vmworkshop-vmarcs/1996/spbackup/tue.tapepool @@ -0,0 +1,21 @@ +* THIS IS A SPBACKUP TAPEPOOL FOR TUESDAY MORNING JOBS +RDTU00 +RDTU01 +RDTU02 +RDTU03 +RDTU04 +RDTU05 +RDTU06 +RDTU07 +RDTU08 +RDTU09 +RDTU10 +RDTU11 +RDTU12 +RDTU13 +RDTU14 +RDTU15 +RDTU16 +RDTU17 +RDTU18 +RDTU19 diff --git a/vmworkshop-vmarcs/1996/spbackup/wed.tapepool b/vmworkshop-vmarcs/1996/spbackup/wed.tapepool new file mode 100644 index 0000000..1806560 --- /dev/null +++ b/vmworkshop-vmarcs/1996/spbackup/wed.tapepool @@ -0,0 +1,21 @@ +* THIS IS A SPBACKUP TAPEPOOL FOR WEDNESDAY MORNING JOBS +RDWE00 +RDWE01 +RDWE02 +RDWE03 +RDWE04 +RDWE05 +RDWE06 +RDWE07 +RDWE08 +RDWE09 +RDWE10 +RDWE11 +RDWE12 +RDWE13 +RDWE14 +RDWE15 +RDWE16 +RDWE17 +RDWE18 +RDWE19 diff --git a/vmworkshop-vmarcs/1996/sysoptap/README.md b/vmworkshop-vmarcs/1996/sysoptap/README.md new file mode 100644 index 0000000..3f4cb27 --- /dev/null +++ b/vmworkshop-vmarcs/1996/sysoptap/README.md @@ -0,0 +1,22 @@ +# SYSOPTAP +A Disconnected Service Virtual for Displaying VMTAPE mounts + +Version 1.2, May, 1996 +Roger Deschner (rogerd@uic.edu) +University of Illinois at Chicago + +SYSOPTAP runs disconnected, and drives any number of ATTACHED or DIALED displays, showing in large letters the tapes to be mounted for VMTAPE. These displays are constantly updated, and so can be located in various areas to tell operators and tape librarians what is being requested. + +SYSOPTAP also intercepts FOREIGN tape mounts and assumes that they are for Standard Labeled tapes which are being mounted by their internal label name, such as from the DMSTVI exit. Then it looks these up in the TMC and shows the slot number for the operator to find that tape. Such tapes must belong to the user requesting the mount, due to the possibility that there may be more than one tape in the system with the same internal label name. + +## REQUIREMENTS + +Sterling VM:Tape (of course) +WAKEUP from CMS Utilities (can be replaced by HMF or PIPE) +CMS Pipelines 1.0106 (CMS8) or later + +See file SYSOPTAP INSTALL for installation details. + +Even if you have no interest in tape mounting, SYSOPTAP is a working example of a server which runs disconnected, and which drives displays connected to it using DEDICATE, ATTACH, or DIAL commands. These are driven using the CMS Pipelines FULLSCREEN device driver. This is a superior method, avoiding most of the problems of attempting to use a virtual machine's console as an informational display. + +Roger Deschner University of Illinois at Chicago R.Deschner@uic.edu diff --git a/vmworkshop-vmarcs/1996/sysoptap/biglet5.rexx b/vmworkshop-vmarcs/1996/sysoptap/biglet5.rexx new file mode 100644 index 0000000..337fb60 --- /dev/null +++ b/vmworkshop-vmarcs/1996/sysoptap/biglet5.rexx @@ -0,0 +1,164 @@ +/* BIGLET REXX: This CMS Pipelines filter converts each line of input +into five output lines, containing the input translated to big 5x5 +characters. Beware that output lines will be 6 times as long as the +input, and that there will be 5 times as many of them. + +MODIFICATION HISTORY: */ +/* BIGM EXEC started Saturday, 17 Mar 1984 14:16:26 by MW9 */ +/* Exec to sent a big message - R. Kandhal */ +/* REVISED BY MSP 4/20/83 (quicker!) */ +/* Revised by K27 4/25/83 (Allow sEnd to a remote site) */ +/* Revised by MW9 3/17/84 (Translated into REXX) */ +/* (Takes nicknames!) */ +/* 3/20/84 (No need for 'BLOCKPS') */ +/* 3/21/84 (Lower case letters!) */ +/* getname proc courtesy of BSD */ +/* 02/12/91 - Roger Deschner, UIC - convert to Pipelines filter. */ +/* 04/02/93 - Roger Deschner, UIC - 5x5 letter version */ + +charstring = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789' +charstring = charstring||'~|@#$%^&*()-_=+!\:;''"{},./?<>' +charstring = charstring||'abcdefghijklmnopqrstuvwxyz' +bs.1 = ' A BBBB CCCC DDDD EEEEE ' +bs.2 = ' A A B B C D D E ' +bs.3 = 'A A BBBB C D D EEE ' +bs.4 = 'AAAAA B B C D D E ' +bs.5 = 'A A BBBB CCCC DDDD EEEEE ' + +bs.1 = bs.1||'FFFFF GGGG H H III J ' +bs.2 = bs.2||'F G H H I J ' +bs.3 = bs.3||'FFF G GG HHHHH I J ' +bs.4 = bs.4||'F G G H H I J J ' +bs.5 = bs.5||'F GGGG H H III JJJ ' + +bs.1 = bs.1||'K K L M M N N OOOOO ' +bs.2 = bs.2||'K K L MM MM NN N O O ' +bs.3 = bs.3||'KKK L M M M N N N O O ' +bs.4 = bs.4||'K K L M M N NN O O ' +bs.5 = bs.5||'K K LLLLL M M N N OOOOO ' + +bs.1 = bs.1||'PPPP QQQ RRRR SSSSS TTTTT ' +bs.2 = bs.2||'P P Q Q R R S T ' +bs.3 = bs.3||'PPPP Q Q Q RRRR SSSSS T ' +bs.4 = bs.4||'P Q QQ R R S T ' +bs.5 = bs.5||'P QQQQ R R SSSSS T ' + +bs.1 = bs.1||'U U V V W W X X Y Y ' +bs.2 = bs.2||'U U V V W W X X Y Y ' +bs.3 = bs.3||'U U V V W W W X Y ' +bs.4 = bs.4||'U U V V WW WW X X Y ' +bs.5 = bs.5||' UUU V W W X X Y ' + +bs.1 = bs.1||'ZZZZZ 000 1 222 33333 ' +bs.2 = bs.2||' Z 0 0 11 2 2 3 ' +bs.3 = bs.3||' Z 0 0 1 22 33 ' +bs.4 = bs.4||' Z 0 0 1 2 3 ' +bs.5 = bs.5||'ZZZZZ 000 111 22222 3333 ' +bs.1 = bs.1||' 4 55555 666 77777 888 ' +bs.2 = bs.2||' 44 5 6 7 8 8 ' +bs.3 = bs.3||' 4 4 5555 6666 7 888 ' +bs.4 = bs.4||'44444 5 6 6 7 8 8 ' +bs.5 = bs.5||' 4 5555 666 7 888 ' + +bs.1 = bs.1||' 999 ~ ~ | @@@@@ # # ' +bs.2 = bs.2||'9 9 ~ ~~ | @ @ @ ##### ' +bs.3 = bs.3||' 9999 | @ @@@ # # ' +bs.4 = bs.4||' 9 | @ ##### ' +bs.5 = bs.5||' 999 | @@@@ # # ' + +bs.1 = bs.1||'$$$$$ % % ^ &&& * * ' +bs.2 = bs.2||'$ $ % ^ ^ & & * * ' +bs.3 = bs.3||'$$$$$ % &&&& ***** ' +bs.4 = bs.4||' $ $ % & & * * ' +bs.5 = bs.5||'$$$$$ % % &&&&& * * ' + +bs.1 = bs.1||' ( ) ' +bs.2 = bs.2||' ( ) ===== ' +bs.3 = bs.3||' ( ) ----- ' +bs.4 = bs.4||' ( ) ===== ' +bs.5 = bs.5||' ( ) ' + +bs.1 = bs.1||' ! \ ' +bs.2 = bs.2||' + ! \ ' +bs.3 = bs.3||'+++++ ! \ ' +bs.4 = bs.4||' + \ ' +bs.5 = bs.5||' ! \ ' + +/* The following is NOT an error - double quotes to create single */ +bs.1 = bs.1||' ::: ;;; '''' " " {{{ ' +bs.2 = bs.2||' ::: ;;; '' { ' +bs.3 = bs.3||' { ' +bs.4 = bs.4||' ::: ;;; { ' +bs.5 = bs.5||' ::: ; {{{ ' + +bs.1 = bs.1||' }}} / ????? ' +bs.2 = bs.2||' } / ? ' +bs.3 = bs.3||' } / ?? ' +bs.4 = bs.4||' } ,, .. / ' +bs.5 = bs.5||' }}} , .. / ? ' + +bs.1 = bs.1||' < > aaa b ' +bs.2 = bs.2||' < > a b ccc ' +bs.3 = bs.3||'< > aaaa bbbb c ' +bs.4 = bs.4||' < > a a b b c ' +bs.5 = bs.5||' < > aaa dbbb ccc ' + +bs.1 = bs.1||' d ff ggg h ' +bs.2 = bs.2||' d eee f g g h ' +bs.3 = bs.3||' dddd eeeee fff gggg hhhh ' +bs.4 = bs.4||'d d e f g h h ' +bs.5 = bs.5||' dddd eee f gg h h ' + +bs.1 = bs.1||' i j k ll ' +bs.2 = bs.2||' k l mmmm ' +bs.3 = bs.3||' ii j k k l m m m ' +bs.4 = bs.4||' i j j kkk l m m m ' +bs.5 = bs.5||' iii jjj k kk lll m m m ' + +bs.1 = bs.1||' ' +bs.2 = bs.2||'nnnn ooo pppp qqqq rrrr ' +bs.3 = bs.3||'n n o o p p q q r ' +bs.4 = bs.4||'n n o o pppp qqqq r ' +bs.5 = bs.5||'n n ooo p q r ' + +bs.1 = bs.1||' ' +bs.2 = bs.2||' sss t u u v v w w ' +bs.3 = bs.3||' s ttt u u v v w w w ' +bs.4 = bs.4||' s t u u v v w w w ' +bs.5 = bs.5||' sss tt uuuu v w w ' + +bs.1 = bs.1||' ' +bs.2 = bs.2||'x x y y zzzzz ' +bs.3 = bs.3||' x.x y y zz ' +bs.4 = bs.4||' x^x y z ' +bs.5 = bs.5||'x x y zzzzz ' + +SIGNAL ON ERROR +DO FOREVER /* Do until EOF */ + 'READTO record' /* Suck from pipe */ + num = LENGTH(record) + ostr. = '' + pos = 0 + DO i = 1 TO num + letter = SUBSTR(record,i,1) + letnum = index(charstring,letter) + IF (letnum = 0) THEN DO /* Not found? Insert blank. */ + pos = pos + 6 + END + ELSE DO /* Move in letter. */ + ipos = (((letnum - 1) * 6 ) + 1) + DO j = 1 TO 5 + ostr.j = LEFT(ostr.j,pos) || SUBSTR(bs.j,ipos,6) + END + pos = pos + 6 + END + END + + /* Output the string */ + + DO j = 1 TO 5 + 'OUTPUT' ostr.j /* Blow into pipe */ + END +END + +ERROR: EXIT rc*(rc<>12) /* On normal eof, set rc=0 */ diff --git a/vmworkshop-vmarcs/1996/sysoptap/process.exec b/vmworkshop-vmarcs/1996/sysoptap/process.exec new file mode 100644 index 0000000..d79157a --- /dev/null +++ b/vmworkshop-vmarcs/1996/sysoptap/process.exec @@ -0,0 +1,31 @@ +/* This program waits for any MSG interupt and refreshes its displays. + +MODIFICATION HISTORY: +04/06/93 - Roger - Original Version. From example in WAKEUP help file. +*/ +/* Invoke WAKEUP first so it will be ready to receive msgs */ +/* This call also issues a 'SET MSG IUCV' command. */ + +"WAKEUP +0 (IUCVMSG" +call domsg uid,text /* paint first display */ + +/* In this loop, we wait for a message to arrive and */ +/* process it when it does. If the "operator" types on */ +/* the console (rc=6) then leave the exec. */ + +Do forever; + 'wakeup (iucvmsg' /* wait for a message */ + if rc /=5 then leave; /* Leave when its not a msg */ + parse pull type uid text /* get the msg details... */ + call domsg uid,text /* go process the command */ +end; + + /* when its time to quit, come here */ + xit: + + 'WAKEUP RESET'; /* turn messages from IUCV to ON */ + exit; + +DOMSG: +'EXEC QMOUNT' +RETURN diff --git a/vmworkshop-vmarcs/1996/sysoptap/profile.exec b/vmworkshop-vmarcs/1996/sysoptap/profile.exec new file mode 100644 index 0000000..aeb7aac --- /dev/null +++ b/vmworkshop-vmarcs/1996/sysoptap/profile.exec @@ -0,0 +1,10 @@ +/* This profile is for SYSOPTAP. It starts up the tape monitoring +process +*/ +'CP SET EMSG ON' +'CP SET PF06 RETRIEVE' +'CP SET PF18 RETRIEVE' +/* These are for future use by people issuing the DIAL command: */ +'CP DEFINE GRAF 4A1 3270' +'CP DEFINE GRAF 4A2 3270' +'EXEC PROCESS' diff --git a/vmworkshop-vmarcs/1996/sysoptap/qmount.exec b/vmworkshop-vmarcs/1996/sysoptap/qmount.exec new file mode 100644 index 0000000..a38813c --- /dev/null +++ b/vmworkshop-vmarcs/1996/sysoptap/qmount.exec @@ -0,0 +1,393 @@ +/* This program queries VMTAPE and displays any pending mounts in big +LETTERS ON THE SCREEN of all attached GRAF devices which are listed in +file QMOUNT CONFIG. Any devices listed in QMOUNT CONFIG which are not +actually attached and are GRAF devices, are ignored without causing an +error. Note that if none of the devices listed in QMOUNT CONFIG are +attached at the present time, this program is effectively a NOP. + +If (TEST is specified, output is written to this screen, which is +assumed to be 24x80. + +Devices may be attached by any of the following three methods: +o DEDICATE vdev rdev <-- in CP Directory for this uid +o CP ATTACH rdev uid vdev <-- from any priveleged ID +o CP DEFINE GRAF vdev 3270 <-- on this uid, and then... + DIAL uid vdev <-- ...from any terminal + +VMTAPE RESPONSES: (characters 4-6 may be any module name!) + +VMTQRY061I There are no mounts pending. +VMTMNT057A Mount LIBRARY volume '000058' on 1888, NO RING, for U52983 0181. +VMTMNT057A Mount FOREIGN volume 'IL336' on 0880, NO RING, for VMCENTER 0181. +VMTMNT057A Mount LIBRARY volume '000058' on 1889, RING IN, for U52983 0181. +VMTMNT057A Mount LIBRARY volume '000029' on 1882, RING IN, for U09046 0181. +VMTMNT057A Mount LIBRARY volume 'VMB510' on 1883, RING IN, for VMBACKUP 0320. +VMTMNT280A Mount selected COMPCTR SCRATCH volume 000342 on '188B', RING IN, for U52983 0181. +VMTDRV144I Waiting for a 18track XF BPI drive for VMBACKUP 0420 VXB510. +VMTVOL699I MOUNT BATCHA02 0181 waiting for volume N09018. +VMTDRV144I Waiting for a 9-track 1600 BPI drive for BATCHA01 0181 N09018. +VMTVOL699I MOUNT BATCHA02 0181 waiting for volume N09018. +VMTDRV144I Waiting for a 9-track 1600 BPI drive for BATCHA01 0181 N09018. +VMTMNT057A Mount LIBRARY volume 'VMA270' on 1882, NO RING, for VMBACKUP 0310. +VMTMNT057A Mount LIBRARY volume 'VMA326' on 1888, NO RING, for VMBACKUP 0510. +VMTMNT057A Mount LIBRARY volume 'VMA333' on 1889, NO RING, for VMBACKUP 0710. +VMTVOL699I MOUNT BATCHA02 0181 waiting for volume N09018. +VMTVOL701I MOUNT VMBACKUP 0610 waiting for volume VMA326 which is mounted on 1888. +VMTDRV144I Waiting for a 9-track 1600 BPI drive for BATCHA01 0181 N09018. +VMTMNT051T Mount IL336 0181 canceled by U52983. + +MODIFICATION HISTORY: +05/26/96 - Roger - Randomize location of "No Tape Mounts Waiting" message + to prevent screen burn-in +04/08/96 - Roger - Fix Rexx interrupt trying to issue err msg about + can't mount foriegn tape. +06/06/95 - Roger - Don't test module name in chars 4-6 of msgs +12/07/94 - Roger - fix tiny bug in mounting scratch tapes. +06/03/94 - Roger Deschner - Deal with SELECTED SCRATCH requests; look up + slots for FOREIGN tapes. +07/06/93 - Roger Deschner - Check for "NOT DIALED" response +04/13/93 - Roger Deschner - Deal with pending alloc messages +04/02/93 - Roger Deschner - Original version +*/ +ADDRESS COMMAND +operid = 'OPERATOR' /* Userid of system console operator */ +vmtapeid = 'VMTAPE' /* Userid of VM:Tape service virtual. */ +PARSE UPPER ARG '(' testparm . + +IF (testparm = 'TEST') THEN testparm = 1 + ELSE testparm = 0 +IF (testparm) THEN configft = 'CONFTEST' + ELSE configft = 'CONFIG' + +/* Find CONFIG file */ +configfn = USERID() +'PIPE LITERAL' configfn configft, + '| STATE NOFORMAT', + '| COUNT LINES', + '| VAR cfexists' +IF (cfexists < 1) THEN DO + configfn = 'QMOUNT' + 'PIPE LITERAL' configfn configft, + '| STATE NOFORMAT', + '| COUNT LINES', + '| VAR cfexists' + IF (cfexists < 1) THEN DO + SAY 'No CONFIG file found. Unable to continue' + EXIT 99 + END +END + +/* Read CONFIG file */ +'PIPE (ENDCHAR ?) <' configfn configft '*', + '| NFIND *' ||, /* Eliminate comments */ + '| FOREIGN: NFIND FOREIGN' ||, + '| STEM displays.', /* List of displays configured */ +'? FOREIGN:', + '| SPECS WORDS 2 1', + '| JOIN * / /', /* String 'em all together */ + '| VAR foreignids' /* List of users allowed to mount FOREIGN */ + +j = 0 +DO i = 1 TO displays.0 + PARSE UPPER VAR displays.i cfaddr + /* What's at that virtual address? */ + 'PIPE CP QUERY VIRTUAL' SUBWORD(displays.i,1,1) '| VAR cpresp' + orc = rc + /* Is it what we want? A valid defined GRAF? */ + PARSE VAR cpresp grafornot . dialed + IF ((orc = 0), + & ((grafornot = 'GRAF') | ((grafornot = 'CONS') & (testparm = 1))), + & (dialed <> 'NOT DIALED'), + ) THEN DO + j = j + 1 + PARSE UPPER VAR displays.i disaddr.j dislines.j discols.j . + END +END +disaddr.0 = j +dislines.0 = j +discols.0 = j + +IF (testparm) THEN DO /* This is a test */ + 'PIPE < QMOUNT TEST * | NFIND * | STEM mountr.' +END +ELSE DO /* This is not a test */ + 'PIPE CMS' vmtapeid 'QUERY | STEM mountr.' +END + +k = 0 +DO i = 1 TO mountr.0 + PARSE VAR mountr.i msgid 1 msg1 4 . 7 msg2 . + SELECT + /* Eliminate messages we are not interested in */ + WHEN ((msg1 = 'VMT') & (msg2 = '061I')) THEN NOP + WHEN ((msg1 = 'VMT') & (msg2 = '145I')) THEN NOP + WHEN ((msg1 = 'VMT') & (msg2 = '057A')) THEN DO + /* Regular mount request */ + /* Variable <mountid> is the userid who issued the MOUNT. But, + what if it is a BATCH job? In that case, we look up the ACIGROUP + and assign that to <originid>. Variable <originid> is always the + userid who instigated the request - whether by issuing a MOUNT on + his terminal, or by running a BATCH job containing a mount. */ + PARSE VAR mountr.i . . qforeign . volser . drive rwstat 'for' , + mountid vaddr . + volser = STRIP(volser,"B","'") /* Remove quotes */ + drive = STRIP(drive,'B',',') /* Remove comma */ + vaddr = STRIP(vaddr,'B','.') /* Remove period. */ + IF (rwstat = 'RING IN,') THEN rwstat = 'W' + ELSE rwstat = '' + IF (SUBSTR(mountid,1,5) = 'BATCH') THEN DO + /* Get userid who ran the batch job */ + 'PIPE CP QUERY ACIGROUP' mountid '| STEM answer.' + PARSE VAR answer.1 '=' originid . + IF (originid = '') THEN originid = mountid + END + ELSE DO + originid = mountid + END + IF (qforeign = 'FOREIGN') THEN DO + /* This defines VAR slotnum and STEM answer. */ + CALL GETSLOT volser originid + extlabrc = result + IF (extlabrc <> 0) THEN DO /* ERROR RECOVERY */ + /* No such tape, or duplicate tape */ + IF (FIND(foreignids,originid) > 0) THEN DO + /* Allowed to mount FOREIGN */ + k = k + 1 + screenline.k = LEFT(volser,6) LEFT(drive,4) rwstat + k = k + 1 + screenline.k = ' FOREIGN TAPE' + END + ELSE DO /* Not allowed to mount FOREIGN. Issue message. */ + IF (testparm) THEN DO + 'PIPE STEM answer.', + '| LITERAL OPERATOR: The following message was sent', + 'to user' mountid'. They may call:', + '| SPECS /MSGNOH' USERID() '/ 1 1-* NEXT', + '| CP' + END /* of IF (testparm) THEN DO */ + ELSE DO /* fer real */ + 'PIPE STEM answer.', + '| SPECS /MSGNOH' mountid '/ 1 1-* NEXT', + '| CP' + 'PIPE STEM answer.', + '| LITERAL OPERATOR: The following message was sent', + 'to user' originid'. They may call:', + '| SPECS /MSGNOH' operid '/ 1 1-* NEXT', + '| CP' + IF (mountid <> originid) THEN DO /* Tell HIM too */ + 'PIPE STEM answer.', + '| SPECS /MSGNOH' originid '/ 1 1-* NEXT', + '| CP' + END + ADDRESS CMS vmtapeid 'CANCEL' vaddr mountid + END /* of ELSE DO /* fer real */ */ + END /* of ELSE DO/* Not allowed to mount FOREIGN. Issue message. */ */ + END /* of IF (extlabrc <> 0) THEN DO /* ERROR RECOVERY */ */ + ELSE DO /* Good lookup by Internal Label. Add lines to screen */ + k = k + 1 + screenline.k = LEFT(volser,6) LEFT(drive,4) rwstat + k = k + 1 + screenline.k = ' Slot' slotnum + END + END + ELSE DO /* Not a foreign tape - add line to screen */ + k = k + 1 + screenline.k = LEFT(volser,6) LEFT(drive,4) rwstat + END + END + WHEN ((msg1 = 'VMT') & (msg2 = '280A')) THEN DO + /* Scratch mount request */ + PARSE VAR mountr.i . . . . . . volser . drive rwstat 'for' . + drive = STRIP(drive,'B',',') /* Remove comma */ + drive = STRIP(drive,"B","'") /* Remove quotes */ + IF (rwstat = 'RING IN,') THEN rwstat = 'W' + ELSE rwstat = '' + k = k + 1 + screenline.k = LEFT(volser,6) LEFT(drive,4) rwstat + END + /* Alloc pending */ + WHEN ((msg1 = 'VMT') & (WORDPOS(msg2,'699I 701I 144I') > 0)) THEN DO + k = k + 1 + screenline.k = 'Wait:' mountr.i + END + OTHERWISE DO /* Any other message */ + k = k + 1 + screenline.k = '*' mountr.i + END + END +END +screenline.0 = k +/* debug trace */ 'PIPE STEM screenline. | CONSOLE' + +IF (screenline.0 = 0) THEN DO + randomize = 'YES' + screenline.1 = 'No Tape' + screenline.2 = 'Mounts' + screenline.3 = 'Waiting' + screenline.0 = 3 +END +ELSE randomize = 'NO' + +DO j = 1 TO disaddr.0 + /* Build the screen image in stem <screen.> */ + + scnlines = TRUNC(dislines.j / 6) + screen.0 = 0 /* initialize stem for APPEND */ + IF (screenline.0 <= scnlines) THEN DO + /* There's room to build big letters */ + DO I = 1 TO screenline.0 + PARSE VAR screenline.i w1 wrest + /* Is it a line we need to catenate small letters to? */ + IF (WORDPOS(w1,'* Wait:') > 0) THEN DO + 'PIPE VAR w1 | BIGLET5 | STEM screen. APPEND' + lbigw1 = LENGTH(w1) * 6 + stcol = lbigw1 + 1 /* Column to begin placing stuff */ + lenstuff = (discols.j - lbigw1) - 1 /* 1 less for ctlchar */ + k1 = screen.0 - 4 + DO k = k1 TO screen.0 + /* Find last blank, starting at LENSTUFF+1 working backwards */ + m = lenstuff+1 + DO WHILE (SUBSTR(wrest,m,1) ^= ' ') + m = m - 1 + IF (m = 0) THEN m = lenstuff+1 /* Word too long? CHOP! */ + END + screen.k = LEFT(screen.k,lbigw1) LEFT(wrest,(m-1)) + wrest = SUBSTR(wrest,(m+1)) + IF (wrest = '') THEN LEAVE + END + END + ELSE DO + 'PIPE VAR screenline.i | BIGLET5 | STEM screen. APPEND' + END + /* Put blank line, if not last. */ + IF (i < screenline.0) THEN 'PIPE LITERAL | STEM screen. APPEND' + END + END + ELSE DO + /* Too many lines for this display. Use reduced format.*/ + 'PIPE LITERAL TAPE MOUNTS:|', + 'BIGLET5|', + 'APPEND LITERAL |', + 'APPEND STEM screenline.|', + 'STEM screen.' + END + /* Are we going to randomize the position of "No Tape Mounts Waiting" + to prevent screen burn-in? */ + IF (randomize = 'YES') THEN DO + 'PIPE LITERAL ', /* Make a blank record */ + '| DUPLICATE' RANDOM(0,6), /* Make 0-6 copies of it */ + '| APPEND STEM screen.', /* Add our stem */ + '| DROP FIRST 1', /* Kill the original blank */ + '| SPECS 1-*' RANDOM(1,38), /* Shift left */ + '| BUFFER', /* ooo la la */ + '| STEM screen.' + END + /* Write it out */ + IF (testparm) THEN DO + 'VMFCLEAR' + 'PIPE STEM screen. | CONSOLE' + END + ELSE DO + CALL WRIT3270 + END +END +RETURN + +WRIT3270: /* EXPOSE all vars */ +/**********************************************************************\ +Example 2: The following exec writes a data stream to a 3270 device at +virtual address specified by the argument. A read is not performed. + +MODIFICATION HISTORY: +04/03/93 - Roger - From IBM manual "CMS Pipelines reference" +\**********************************************************************/ +EraseWrite = 'C0'x /* Erase/Write command */ +WriteControlChar = '03'x /* Write Control Character */ +SetBufferAddress = '11'x /* Set Buffer Address order */ +InsertCursor = '13'x /* Insert Cursor order */ +StartField = '1D'x /* Start Field order */ +AttrProtect = '28'x /* Unprotected attribute byte */ +/* DataStreamOut = EraseWrite||WriteControlChar||SetBufferAddress||, */ +/* '0000'x||StartField||AttrProtect||'You have connected to', */ +/* userid()||SetBufferAddress||'0000'x||InsertCursor */ +DataStreamOut = EraseWrite||WriteControlChar +DO i = 1 TO screen.0 + /* Calculate 3270 "14-bit" screen address */ + scnpos = RIGHT(D2C((i-1)*discols.j),2,'00'x) + DataStreamOut = DataStreamOut ||, + SetBufferAddress || scnpos || StartField || AttrProtect || screen.i +END +DataStreamOut = DataStreamOut ||, + SetBufferAddress||'0000'x||InsertCursor + /* Build the data stream */ +'PIPE', + 'VAR DataStreamOut', /* Get outbound data stream */ + '| FULLSCREEN' disaddr.j 'NOREAD', /* Write it to device 0500 */ + '| HOLE' /* Discard the results */ +RETURN rc /* Exit */ + +GETSLOT: PROCEDURE EXPOSE slotnum answer. vmtapeid +/*********************************************************************\ +* * +* SUBROUTINE GETSLOT * +* * +\*********************************************************************/ +/* +List the external label of all tapes signed in for a user which have a +internal label specified. +*/ +PARSE UPPER ARG tapevol ownerid . +slotnum = '' +IF (ownerid = '*') THEN ownerid = USERID() +IF (ownerid = '') THEN RETURN 24 +IF (tapevol = '') THEN RETURN 24 + +/* Do this to avoid unnecessary error when asking about own tapes */ +IF (ownerid <> USERID()) THEN ownpart = 'OWNEDBY' ownerid + ELSE ownpart = '' + +'PIPE CMS' vmtapeid 'LIST (BIN' ownpart, + '| PAD 22', + '| LOCATE 17-22 /' || LEFT(tapevol,6) || '/', + '| STEM vols.' +vmtrc = rc + +SELECT + WHEN ((vols.0 < 1) | (vmtrc = 28)) THEN DO /* No such internal volser found */ + answer.1 = 'You have requested a mount for a tape with internal label' tapevol', however' + answer.2 = 'no such tape can be found belonging to' ownerid'. This MOUNT request has' + answer.3 = 'been cancelled. When mounting by internal label, the tape must belong to the' + answer.4 = 'ID requesting the mount. (For BATCH, that is the ID which scheduled the job.)' + answer.5 = 'The' vmtapeid 'LIST command may help you determine why this mount has failed. If' + answer.6 = 'you need further assistance with this, or if you do not know why you got' + answer.7 = 'this message, contact the ADN Computer Center.' + answer.0 = 7 + finalrc = 6 + END + WHEN (vmtrc <> 0) THEN DO /* Some VMTAPE error. */ + 'PIPE STEM vols. | STEM answer.' + finalrc = vmtrc /* Issue VMTAPE's rc */ + END + WHEN (vols.0 = 1) THEN DO /* This is goodness */ + PARSE VAR vols.1 slotnum . + answer.0 = 0 + finalrc = 0 + END + OTHERWISE DO /* PANIC! Several found. Data integrity exposure. */ + answer.1 = '***CAUTION*** User' ownerid 'owns more than one tape with internal label' + answer.2 = tapevol'. They are listed after this message. It is impossible to tell which is' + answer.3 = 'desired. This MOUNT has been cancelled to avoid the possibility of overwriting' + answer.4 = 'valuable data, or of reading the wrong data. To straighten this out, you' + answer.5 = 'should remove all the tapes listed below from the Computer Center tape' + answer.6 = 'racks, except for the one you want to use. The' vmtapeid 'LIST command may help' + answer.7 = 'you determine which you really want. You can also mount these tapes using' + answer.8 = 'the slot number to TAPEMAP them. If you need further assistance with' + answer.9 = 'this, or if you do not know why you got this message, contact the ADN' + answer.10 = 'Computer Center before proceeding.' + answer.11 = 'Slot--------Internal Label' + answer.0 = 11 + 'PIPE STEM vols. | STEM answer. APPEND' + finalrc = 12 + END +END +RETURN finalrc diff --git a/vmworkshop-vmarcs/1996/sysoptap/qmount.test b/vmworkshop-vmarcs/1996/sysoptap/qmount.test new file mode 100644 index 0000000..1fc4a94 --- /dev/null +++ b/vmworkshop-vmarcs/1996/sysoptap/qmount.test @@ -0,0 +1,38 @@ +* This file contains most possible responses from VMTAPE. Uncomment the +* one you want to test. +VMTQRY061I There are no mounts pending. +VMTQRY145I There are no allocations pending. +*VMTMNT057A Mount LIBRARY volume 'SDA156' on 0881, NO RING, for BATCHA02 0181. +*VMTMNT057A Mount LIBRARY volume 'VMD045' on 1881, NO RING, for VMBACKUP 0310. +*VMTMNT057A Mount LIBRARY volume '000058' on 1888, NO RING, for U52983 0181. +*VMTMNT057A Mount LIBRARY volume '000058' on 1889, RING IN, for U52983 0181. +*VMTMNT057A Mount LIBRARY volume 'O01029' on 1882, RING IN, for U09046 0181. +*VMTMNT057A Mount LIBRARY volume 'VMB510' on 1883, RING IN, for VMBACKUP 0320. +*VMTDRV144I Waiting for a 18track XF BPI drive for VMBACKUP 0420 VXB510. +*VMTXXXYYYI We're freaking out around here, and this long message to say it just proves it. I mean we can go on and o +*VMTVOL699I MOUNT BATCHA02 0181 waiting for volume N09018. +*VMTDRV144I Waiting for a 9-track 1600 BPI drive for BATCHA01 0181 N09018. +*VMTVOL699I MOUNT BATCHA02 0181 waiting for volume N09018. +*VMTDRV144I Waiting for a 9-track 1600 BPI drive for BATCHA01 0181 N09018. +*VMTMNT057A Mount LIBRARY volume 'VMA270' on 1882, NO RING, for VMBACKUP 0310. +*VMTMNT057A Mount LIBRARY volume 'VMA326' on 1888, NO RING, for VMBACKUP 0510. +*VMTMNT057A Mount LIBRARY volume 'VMA333' on 1889, NO RING, for VMBACKUP 0710. +*VMTVOL699I MOUNT BATCHA02 0181 waiting for volume N09018. +*VMTVOL701I MOUNT VMBACKUP 0610 waiting for volume VMA326 which is mounted on 1888. +*VMTDRV144I Waiting for a 9-track 1600 BPI drive for BATCHA01 0181 N09018. +*VMTMNT057A Mount FOREIGN volume 'IL336' on 0880, NO RING, for U52983 0181. +*VMTMNT057A Mount LIBRARY volume '000058' on 1889, RING IN, for U52983 0181. +*VMTMNT057A Mount LIBRARY volume '000029' on 1882, RING IN, for U09046 0181. +*VMTMNT057A Mount LIBRARY volume 'VMB510' on 1883, RING IN, for VMBACKUP 0320. +*VMTMNT280A Mount selected COMPCTR SCRATCH volume 000342 on '188B', RING IN, for U52983 0181. +*VMTDRV144I Waiting for a 18track XF BPI drive for VMBACKUP 0420 VXB510. +*VMTVOL699I MOUNT BATCHA02 0181 waiting for volume N09018. +*VMTDRV144I Waiting for a 9-track 1600 BPI drive for BATCHA01 0181 N09018. +*VMTVOL699I MOUNT BATCHA02 0181 waiting for volume N09018. +*VMTDRV144I Waiting for a 9-track 1600 BPI drive for BATCHA01 0181 N09018. +*VMTMNT057A Mount LIBRARY volume 'VMA270' on 1882, NO RING, for VMBACKUP 0310. +*VMTMNT057A Mount LIBRARY volume 'VMA326' on 1888, NO RING, for VMBACKUP 0510. +*VMTMNT057A Mount LIBRARY volume 'VMA333' on 1889, NO RING, for VMBACKUP 0710. +*VMTVOL699I MOUNT BATCHA02 0181 waiting for volume N09018. +*VMTVOL701I MOUNT VMBACKUP 0610 waiting for volume VMA326 which is mounted on 1888. +*VMTDRV144I Waiting for a 9-track 1600 BPI drive for BATCHA01 0181 N09018. diff --git a/vmworkshop-vmarcs/1996/sysoptap/sysoptap.abstract b/vmworkshop-vmarcs/1996/sysoptap/sysoptap.abstract new file mode 100644 index 0000000..691a6ef --- /dev/null +++ b/vmworkshop-vmarcs/1996/sysoptap/sysoptap.abstract @@ -0,0 +1,36 @@ +SYSOPTAP: a Disconnected Service Virtual for Displaying VMTAPE mounts + + Version 1.2, May, 1996 + Roger Deschner (rogerd@uic.edu) + University of Illinois at Chicago + + +SYSOPTAP runs disconnected, and drives any number of ATTACHED or DIALED +displays, showing in large letters the tapes to be mounted for VMTAPE. +These displays are constantly updated, and so can be located in various +areas to tell operators and tape librarians what is being requested. + +SYSOPTAP also intercepts FOREIGN tape mounts and assumes that they are +for Standard Labeled tapes which are being mounted by their internal +label name, such as from the DMSTVI exit. Then it looks these up in the +TMC and shows the slot number for the operator to find that tape. Such +tapes must belong to the user requesting the mount, due to the +possibility that there may be more than one tape in the system with the +same internal label name. + +SYSOPTAP REQUIRES: + + Sterling VM:Tape (of course) + WAKEUP from CMS Utilities (can be replaced by HMF or PIPE) + CMS Pipelines 1.0106 (CMS8) or later + +See file SYSOPTAP INSTALL for installation details. + +Even if you have no interest in tape mounting, SYSOPTAP is a working +example of a server which runs disconnected, and which drives displays +connected to it using DEDICATE, ATTACH, or DIAL commands. These are +driven using the CMS Pipelines FULLSCREEN device driver. This is a +superior method, avoiding most of the problems of attempting to use a +virtual machine's console as an informational display. + +Roger Deschner University of Illinois at Chicago R.Deschner@uic.edu diff --git a/vmworkshop-vmarcs/1996/sysoptap/sysoptap.config b/vmworkshop-vmarcs/1996/sysoptap/sysoptap.config new file mode 100644 index 0000000..8023396 --- /dev/null +++ b/vmworkshop-vmarcs/1996/sysoptap/sysoptap.config @@ -0,0 +1,25 @@ +* This file defines the screens which will receive tape mount info +* +* Lines which begin with * are comments. +* Each line defines one screen. It contains two tokens. First is the +* Virtual address of the screen. Second is its size in lines, and +* third is its width in columns. +* +* MODIFICATION HISTORY: +* 06/06/94 - Roger - Add "foreign". +* 05/10/94 - Roger - Change 4A0 from 32 lines to 24 lines. +* +4A0 24 80 +4A1 24 80 +4A2 24 80 +4B0 32 80 +4B1 32 80 +* +* Following list of userids are allowed to mount 'FOREIGN', even if +* the tape is not theirs. +* FORMAT: FOREIGN <userid> <comments, such as user's name> +* +FOREIGN VMCENTER Operator +FOREIGN U12860 Roger Deschner +FOREIGN U11154 Gao, Social Science Data Archive +FOREIGN U32472 Alan Hinds \ No newline at end of file diff --git a/vmworkshop-vmarcs/1996/sysoptap/sysoptap.conftest b/vmworkshop-vmarcs/1996/sysoptap/sysoptap.conftest new file mode 100644 index 0000000..6a5c639 --- /dev/null +++ b/vmworkshop-vmarcs/1996/sysoptap/sysoptap.conftest @@ -0,0 +1,19 @@ +* This file defines the screens which will receive tape mount info +* +* Lines which begin with * are comments. +* Each line defines one screen. It contains three tokens. First is the +* Virtual address of the screen. Second it its size in lines, and +* third is its width in columns. +* +* MODIFICATION HISTORY: +* 06/06/94 - Roger - TEST FILE +* +* Below line defines my own virtual console, for testing +009 24 80 +* +* Following list of userids are allowed to mount 'FOREIGN', even if +* the tape is not theirs. +* FORMAT: FOREIGN <userid> <comments, such as user's name> +* +FOREIGN U52983 Roger Deschner +FOREIGN VMCENTER Operator \ No newline at end of file diff --git a/vmworkshop-vmarcs/1996/sysoptap/sysoptap.install b/vmworkshop-vmarcs/1996/sysoptap/sysoptap.install new file mode 100644 index 0000000..e614a41 --- /dev/null +++ b/vmworkshop-vmarcs/1996/sysoptap/sysoptap.install @@ -0,0 +1,53 @@ +SYSOPTAP Installation June 22, 1996 + +To install SYSOPTAP, create a userid SYSOPTAP with a 1-cylinder 191 disk, +and CP class BG. You can use a different userid if you wish, but if you +do, you'll need to rename file SYSOPTAP CONFIG to be <userid> CONFIG. + +Load all the files to its A disk. + +Modify SYSOPTAP CONFIG to alter the list of displays which will be +attached, their virtual addresses, and their physical screen dimensions. +Also, alter the list of users who should be allowed to mount ANY foreign +tape, not just their own. Ideally, there will be nobody in this list +except system administration staff, as it represents a security hole. + +Give it OPERATOR privileges in VMTAPE. + +If you want to exploit its feature of looking up FOREIGN tape mounts, you +should allow any user to mount a FOREIGN tape by NOT using the EXIT1 exit +from VMTAPE. This can be done by removing/commenting out its line in +VMTAPE CONFIG. + +Use PROP or HMF or VMTAPE CONFIG to route all VMTAPE mount messages to +it. + +If you run batch jobs, review the code in QMOUNT EXEC which implements +the UIC local convention that all batch jobs run with the ACIGROUP set to +the user who submitted the job. + +Start it as a disconnected server. In your system startup (whether by HMF +or AUTOLOG1) you will need to ATTACH the displays you always want to come +up with every time. (Beware that you cannot ATTACH unless it is DISABLED, +and that the CP DISABLE command runs asynchronously and takes about 5 +seconds to complete. This restriction makes the use of directory DEDICATE +statements very difficult.) + +Otherwise, you can manually DIAL to it. When DIALing, if you have +different screen sizes defined at different virtual addresses, you'll +need to specify which you want to dial to. If the display is scrambled, +you have defined the physical screen sizes wrong. To undial, flip the +Test/Normal switch on the terminal. LDEVs work fine with DIAL to +SYSOPTAP, as long as you are following the above rules about screen sizes +matching. + +The QMOUNT EXEC which drives SYSOPTAP can be invoked with the (TEST +option to display mounts from file QMOUNT TEST on your own terminal, so +you can try it out without disrupting your normal operations. + +LEGAL NOTICE: SYSOPTAP is offered "as-is" without any warranty, including +any warranty of merchantibility or fitness for a particular purpose. + +VM:Tape is a trade mark of Sterling Software Inc. + +Roger Deschner University of Illinois at Chicago rogerd@uic.edu diff --git a/vmworkshop-vmarcs/1996/tar/README.md b/vmworkshop-vmarcs/1996/tar/README.md new file mode 100644 index 0000000..beeb452 --- /dev/null +++ b/vmworkshop-vmarcs/1996/tar/README.md @@ -0,0 +1,25 @@ +# CMS TAR + +Copyright 1995, Richard M. Troth, all rights reserved. + +This is the README file for CMS TAR 2.3 in plain text. There are some much needed enhancements to the translation (or not) selection logic that I had hoped to get in before the '96 Workshop, but time just seems to fly away. + +Copyright 1993, 1994, 1995, 1996 Richard M. Troth. This software may be freely distributed as long as copyright notice and header remain intact. There is no charge, although a substantial amount of personal time went into this effort. + +CMS TAR version 2 is a from-scratch 'tar' creator/extractor built upon the powerful CMS Pipelines. Files archived with CMS TAR version 2 can be extracted UNIX 'tar' and files archived with UNIX 'tar' can be extracted with CMS TAR. + +There also exists Rice CMS TAR version 1, which is C sourced and was written by Sean Starke. CMS TAR 1.0 is based on GNU TAR. This is NOT the same program or package. (although I have borrowed and modified Sean's HELP file) Changes to GNU TAR for CMS were returned to the Free Software Foundation. Extent of use or incorporation of those changes in the distribution GNU TAR package is unknown. Rice University DOES NOT SUPPORT THIS SOFTWARE. Don't ask them. + +Also included is a TARLIST EXEC. This tool allows you to "browse" a TAR archive and selectively view or extract files. It is NOT as functional as CMS FILELIST, which inspired it. Maybe more later. + +If you have any questions about this package, send e-mail to: + + Rick Troth <troth@casita.houston.tx.us> + +You can probably find updates at + + http://casita.houston.tx.us/~troth/software/tar.vmarc + or + http://ua1vm.ua.edu/~troth/software/tar.vmarc + + diff --git a/vmworkshop-vmarcs/1996/tar/a2e.rexx b/vmworkshop-vmarcs/1996/tar/a2e.rexx new file mode 100644 index 0000000..33a6fd8 --- /dev/null +++ b/vmworkshop-vmarcs/1996/tar/a2e.rexx @@ -0,0 +1,71 @@ +/* ----------------------------------------------------------------- ÆCS + * ASCII to EBCDIC and vice-versa code conversion tables. + * Tables included here are based on ASCII conforming to the ISO8859-1 + * Latin 1 character set and EBCDIC conforming to the IBM Code Page 37 + * Latin 1 character set (except for three pairs of characters in 037). + * + * Name: A2E REXX + * CMS Pipelines filter to translate ASCII to EBCDIC + * Author: Rick Troth, Houston, Texas, USA + * Date: 1992-Feb-27 for the filter, earlier for the table + * + * 1993-Aug-28: Thanks to Melinda Varian for helping me to + * correct some pipelining errors in this gem. + * + * Note: These tables are provided in source form so that you + * may modify them locally. I recommend that you not + * modify them just to make things look right on your + * screen. If you have an older terminal and there are + * not more than a dozen code-points that are wrong, + * then you're better off using CODEPAGE EXEC to set the + * CMS INPUT/OUTPUT translate tables. GOPHER EXEC + * *does respect* CMS' translate tables. + */ + + i = '000102030405060708090A0B0C0D0E0F'x + i = i || '101112131415161718191A1B1C1D1E1F'x + i = i || '202122232425262728292A2B2C2D2E2F'x + i = i || '303132333435363738393A3B3C3D3E3F'x + i = i || '404142434445464748494A4B4C4D4E4F'x + i = i || '505152535455565758595A5B5C5D5E5F'x + i = i || '606162636465666768696A6B6C6D6E6F'x + i = i || '707172737475767778797A7B7C7D7E7F'x + i = i || '808182838485868788898A8B8C8D8E8F'x + i = i || '909192939495969798999A9B9C9D9E9F'x + i = i || 'A0A1A2A3A4A5A6A7A8A9AAABACADAEAF'x + i = i || 'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF'x + i = i || 'C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF'x + i = i || 'D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF'x + i = i || 'E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF'x + i = i || 'F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF'x + + e = '00010203372D2E2F1605250B0C0D0E0F'x + e = e || '101112133C3D322618193F271C1D1E1F'x + e = e || '405A7F7B5B6C507D4D5D5C4E6B604B61'x + e = e || 'F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F'x + e = e || '7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6'x + e = e || 'D7D8D9E2E3E4E5E6E7E8E9ADE0BD5F6D'x + e = e || '79818283848586878889919293949596'x + e = e || '979899A2A3A4A5A6A7A8A9C04FD0A107'x + e = e || '202122232415061728292A2B2C090A1B'x + e = e || '30311A333435360838393A3B04143EFF'x + e = e || '41AA4AB19FB26AB5BBB49A8AB0CAAFBC'x + e = e || '908FEAFABEA0B6B39DDA9B8BB7B8B9AB'x + e = e || '6465626663679E687471727378757677'x + e = e || 'AC69EDEEEBEFECBF80FDFEFBFCBAAE59'x + e = e || '4445424643479C485451525358555657'x + e = e || '8C49CDCECBCFCCE170DDDEDBDC8D8EDF'x + +/* ----------------------------------------------------------------- A2E + * Translate ASCII to EBCDIC. + */ +Do Forever + 'PEEKTO LINE' + If rc ^= 0 Then Leave + 'OUTPUT' Translate(line,e,i) + If rc ^= 0 Then Leave + 'READTO' + End /* Do While */ + +Exit rc * (rc ^= 12) + diff --git a/vmworkshop-vmarcs/1996/tar/e2a.rexx b/vmworkshop-vmarcs/1996/tar/e2a.rexx new file mode 100644 index 0000000..7dd2120 --- /dev/null +++ b/vmworkshop-vmarcs/1996/tar/e2a.rexx @@ -0,0 +1,71 @@ +/* ----------------------------------------------------------------- ÆCS + * ASCII to EBCDIC and vice-versa code conversion tables. + * Tables included here are based on ASCII conforming to the ISO8859-1 + * Latin 1 character set and EBCDIC conforming to the IBM Code Page 37 + * Latin 1 character set (except for three pairs of characters in 037). + * + * Name: E2A REXX + * CMS Pipelines filter to translate EBCDIC to ASCII + * Author: Rick Troth, Houston, Texas, USA + * Date: 1992-Feb-27 for the filter, earlier for the table + * + * 1993-Aug-28: Thanks to Melinda Varian for helping me to + * correct some pipelining errors in this gem. + * + * Note: These tables are provided in source form so that you + * may modify them locally. I recommend that you not + * modify them just to make things look right on your + * screen. If you have an older terminal and there are + * not more than a dozen code-points that are wrong, + * then you're better off using CODEPAGE EXEC to set the + * CMS INPUT/OUTPUT translate tables. GOPHER EXEC + * *does respect* CMS' translate tables. + */ + + i = '000102030405060708090A0B0C0D0E0F'x + i = i || '101112131415161718191A1B1C1D1E1F'x + i = i || '202122232425262728292A2B2C2D2E2F'x + i = i || '303132333435363738393A3B3C3D3E3F'x + i = i || '404142434445464748494A4B4C4D4E4F'x + i = i || '505152535455565758595A5B5C5D5E5F'x + i = i || '606162636465666768696A6B6C6D6E6F'x + i = i || '707172737475767778797A7B7C7D7E7F'x + i = i || '808182838485868788898A8B8C8D8E8F'x + i = i || '909192939495969798999A9B9C9D9E9F'x + i = i || 'A0A1A2A3A4A5A6A7A8A9AAABACADAEAF'x + i = i || 'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF'x + i = i || 'C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF'x + i = i || 'D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF'x + i = i || 'E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF'x + i = i || 'F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF'x + + a = '000102039C09867F978D8E0B0C0D0E0F'x + a = a || '101112139D8508871819928F1C1D1E1F'x + a = a || '80818283840A171B88898A8B8C050607'x + a = a || '909116939495960498999A9B14159E1A'x + a = a || '20A0E2E4E0E1E3E5E7F1A22E3C282B7C'x + a = a || '26E9EAEBE8EDEEEFECDF21242A293B5E'x + a = a || '2D2FC2C4C0C1C3C5C7D1A62C255F3E3F'x + a = a || 'F8C9CACBC8CDCECFCC603A2340273D22'x + a = a || 'D8616263646566676869ABBBF0FDFEB1'x + a = a || 'B06A6B6C6D6E6F707172AABAE6B8C6A4'x + a = a || 'B57E737475767778797AA1BFD05BDEAE'x + a = a || 'ACA3A5B7A9A7B6BCBDBEDDA8AF5DB4D7'x + a = a || '7B414243444546474849ADF4F6F2F3F5'x + a = a || '7D4A4B4C4D4E4F505152B9FBFCF9FAFF'x + a = a || '5CF7535455565758595AB2D4D6D2D3D5'x + a = a || '30313233343536373839B3DBDCD9DA9F'x + +/* ----------------------------------------------------------------- E2A + * Translate EBCDIC to ASCII. + */ +Do Forever + 'PEEKTO LINE' + If rc ^= 0 Then Leave + 'OUTPUT' Translate(line,a,i) + If rc ^= 0 Then Leave + 'READTO' + End /* Do While */ + +Exit rc * (rc ^= 12) + diff --git a/vmworkshop-vmarcs/1996/tar/executar.xedit b/vmworkshop-vmarcs/1996/tar/executar.xedit new file mode 100644 index 0000000..ffbcab8 --- /dev/null +++ b/vmworkshop-vmarcs/1996/tar/executar.xedit @@ -0,0 +1,70 @@ +/* REXX */ + +Parse Upper Arg l . +Parse Arg . c + +Select /* l */ + + When l = "" Then Do + 'COMMAND EXTRACT/LINE' + 'COMMAND CURSOR CMDLINE' + 'LOCATE :' || line.1 + End /* When .. Do */ + + When l = "CURSOR" Then Do + 'COMMAND EXTRACT/LINE/CURSOR' + If cursor.3 = -1 Then Do + Address "COMMAND" 'XMITMSG 561 (CALLER TAR VAR' + Do i = 1 to message.0; 'EMSG' message.i; End + Exit 3 + End + Call EXECUTAR cursor.3 c + 'LOCATE :' || line.1 + End /* When .. Do */ + + When l = '*' Then Do + 'COMMAND EXTRACT/LINE/SIZE' + Do i = line.1 to size.1 + Call EXECUTAR i c + End /* Do For */ + 'LOCATE :' || line.1 + End /* When .. Do */ + + End /* Select l */ + +Exit + + + +EXECUTAR: Procedure +Parse Arg l c + +'LOCATE :' || l +'COMMAND EXTRACT/CURLINE' +Parse Var curline.3 81 skip name + +c2 = "" +Do While c ^= "" + Parse Var c c1 c + If c1 = '/' Then c1 = name + If c1 = '/N' Then c1 = name + If c1 = '/S' Then c1 = skip + c2 = c2 c1 + End /* Do While */ +c = c2 + +Parse Var c c1 c2 +Select /* c1 */ + When c1 = "X" Then + 'COMMAND CMS PIPE' xc c2 '| CONSOLE' + When c1 = "EXTRACT" Then + 'COMMAND CMS PIPE' xc c2 '| CONSOLE' + When c1 = "PEEK" Then + 'COMMAND CMS PIPE' xc c2 '(PEEK | CONSOLE' + Otherwise 'COMMAND CMS' c + End /* Select c1 */ + +'COMMAND REPLACE *' || Substr(curline.3,2) + +Return + diff --git a/vmworkshop-vmarcs/1996/tar/maketext.rexx b/vmworkshop-vmarcs/1996/tar/maketext.rexx new file mode 100644 index 0000000..b471c48 --- /dev/null +++ b/vmworkshop-vmarcs/1996/tar/maketext.rexx @@ -0,0 +1,227 @@ +/* © Copyright 1994, Richard M. Troth, all rights reserved. <plaintext> + * + * Name: MAKETEXT REXX + * VM TCP/IP Network Client and Server text converter + * Inspired by GOPCLITX, DROPDOTS, and other gems. + * Renamed from WEBTEXT because it's ubiquitous. + * Author: Rick Troth, Houston, Texas, USA + * Date: 1994-Feb-27, 1994-Oct-15 + * + * Replaces: A2E, E2A, TCPA2E, TCPE2A + */ + +/* ----------------------------------------------------------------- ÆCS + * ASCII to EBCDIC and vice-versa code conversion tables. + * Tables included here are based on ASCII conforming to the ISO8859-1 + * Latin 1 character set and EBCDIC conforming to the IBM Code Page 37 + * Latin 1 character set (except for three pairs of characters in 037). + */ + +Parse Upper Arg mode code . '(' . ')' . +If mode = "" Then mode = "LOCAL" + + i = '000102030405060708090A0B0C0D0E0F'x + i = i || '101112131415161718191A1B1C1D1E1F'x + i = i || '202122232425262728292A2B2C2D2E2F'x + i = i || '303132333435363738393A3B3C3D3E3F'x + i = i || '404142434445464748494A4B4C4D4E4F'x + i = i || '505152535455565758595A5B5C5D5E5F'x + i = i || '606162636465666768696A6B6C6D6E6F'x + i = i || '707172737475767778797A7B7C7D7E7F'x + i = i || '808182838485868788898A8B8C8D8E8F'x + i = i || '909192939495969798999A9B9C9D9E9F'x + i = i || 'A0A1A2A3A4A5A6A7A8A9AAABACADAEAF'x + i = i || 'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF'x + i = i || 'C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF'x + i = i || 'D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF'x + i = i || 'E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF'x + i = i || 'F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF'x + +If code ^= "" Then Do + 'CALLPIPE DISK' code 'TCPXLBIN | STEM XLT.' + If rc ^= 0 | xlt.0 < 3 Then code = "" + End /* If .. Do */ + +Select /* mode */ + When Abbrev("LOCAL",mode,3) Then Call LOCAL + When Abbrev("LCL",mode,3) Then Call LOCAL + When Abbrev("EBCDIC",mode,1) Then Call LOCAL + When Abbrev("NETWORK",mode,3) Then Call NETWORK + When Abbrev("ASCII",mode,1) Then Call NETWORK + When Abbrev("DOTTED",mode,3) Then Call DOTTED + When Abbrev("UNIX",mode,1) Then Call UNIX + Otherwise Do + Address "COMMAND" 'XMITMSG 3 MODE (ERRMSG' + rc = 24 + End /* Otherwise Do */ + End /* Select mode */ + +Exit rc * (rc ^= 12) + + +/* --------------------------------------------------------------- LOCAL + * Input: raw ASCII text + * Output: plain (EBCDIC) text + */ +LOCAL: + +'ADDPIPE *.OUTPUT: | STRIP TRAILING 0D | PAD 1 | *.OUTPUT:' +If rc ^= 0 Then Return + +If code = "" Then Do /* use the standard table */ + e = '00010203372D2E2F1605250B0C0D0E0F'x + e = e || '101112133C3D322618193F271C1D1E1F'x + e = e || '405A7F7B5B6C507D4D5D5C4E6B604B61'x + e = e || 'F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F'x + e = e || '7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6'x + e = e || 'D7D8D9E2E3E4E5E6E7E8E9ADE0BD5F6D'x + e = e || '79818283848586878889919293949596'x + e = e || '979899A2A3A4A5A6A7A8A9C04FD0A107'x + e = e || '202122232415061728292A2B2C090A1B'x + e = e || '30311A333435360838393A3B04143EFF'x + e = e || '41AA4AB19FB26AB5BBB49A8AB0CAAFBC'x + e = e || '908FEAFABEA0B6B39DDA9B8BB7B8B9AB'x + e = e || '6465626663679E687471727378757677'x + e = e || 'AC69EDEEEBEFECBF80FDFEFBFCBAAE59'x + e = e || '4445424643479C485451525358555657'x + e = e || '8C49CDCECBCFCCE170DDDEDBDC8D8EDF'x + End /* If .. Do */ +Else e = xlt.2 + +buff = "" +Do Forever + + 'PEEKTO DATA' + If rc ^= 0 Then Leave + + buff = buff || data + Do While Index(buff,'0A'x) > 0 + Parse Var buff line '0A'x buff + 'OUTPUT' Translate(line,e,i) + If rc ^= 0 Then Leave + End /* Do While */ + If rc ^= 0 Then Leave + + 'READTO' + If rc ^= 0 Then Leave + + End /* Do Forever */ + +If buff ^= "" Then 'OUTPUT' Translate(buff,e,i) + +Return + + +/* ------------------------------------------------------------- NETWORK + * Input: plain (EBCDIC) text + * Output: raw ASCII byte stream + */ +NETWORK: + +'ADDPIPE *.OUTPUT: | SPEC 1-* 1 x0D0A NEXT | *.OUTPUT:' +If rc ^= 0 Then Return + +If code = "" Then Do /* use the standard table */ + a = '000102039C09867F978D8E0B0C0D0E0F'x + a = a || '101112139D8508871819928F1C1D1E1F'x + a = a || '80818283840A171B88898A8B8C050607'x + a = a || '909116939495960498999A9B14159E1A'x + a = a || '20A0E2E4E0E1E3E5E7F1A22E3C282B7C'x + a = a || '26E9EAEBE8EDEEEFECDF21242A293B5E'x + a = a || '2D2FC2C4C0C1C3C5C7D1A62C255F3E3F'x + a = a || 'F8C9CACBC8CDCECFCC603A2340273D22'x + a = a || 'D8616263646566676869ABBBF0FDFEB1'x + a = a || 'B06A6B6C6D6E6F707172AABAE6B8C6A4'x + a = a || 'B57E737475767778797AA1BFD05BDEAE'x + a = a || 'ACA3A5B7A9A7B6BCBDBEDDA8AF5DB4D7'x + a = a || '7B414243444546474849ADF4F6F2F3F5'x + a = a || '7D4A4B4C4D4E4F505152B9FBFCF9FAFF'x + a = a || '5CF7535455565758595AB2D4D6D2D3D5'x + a = a || '30313233343536373839B3DBDCD9DA9F'x + End /* If .. Do */ +Else a = xlt.3 + +Do Forever + + 'PEEKTO LINE' + If rc ^= 0 Then Leave + + 'OUTPUT' Translate(line,a,i) + If rc ^= 0 Then Leave + + 'READTO' + If rc ^= 0 Then Leave + + End /* Do Forever */ + +Return + + +/* -------------------------------------------------------------- DOTTED + * Input: plain (EBCDIC) text + * Output: ASCII byte stream terminated by CR/LF/./CR/LF + */ +DOTTED: + +Call NETWORK + +'OUTPUT' Translate('.',a,i) + +Return + + +/* + * variables: + * xlt.0 should be "3", meaning three records read + * xlt.1 should be a comment + * xlt.2 should be our ASCII ---> EBCDIC table + * xlt.3 should be our EBCDIC ---> ASCII table + * i is set to the dummy input table + */ + + +/* ---------------------------------------------------------------- UNIX + * Input: plain (EBCDIC) text + * Output: ASCII byte stream with UNIX line convention (NL) + */ +UNIX: + +'ADDPIPE *.OUTPUT: | SPEC 1-* 1 x0A NEXT | *.OUTPUT:' +If rc ^= 0 Then Return + +If code = "" Then Do /* use the standard table */ + a = '000102039C09867F978D8E0B0C0D0E0F'x + a = a || '101112139D8508871819928F1C1D1E1F'x + a = a || '80818283840A171B88898A8B8C050607'x + a = a || '909116939495960498999A9B14159E1A'x + a = a || '20A0E2E4E0E1E3E5E7F1A22E3C282B7C'x + a = a || '26E9EAEBE8EDEEEFECDF21242A293B5E'x + a = a || '2D2FC2C4C0C1C3C5C7D1A62C255F3E3F'x + a = a || 'F8C9CACBC8CDCECFCC603A2340273D22'x + a = a || 'D8616263646566676869ABBBF0FDFEB1'x + a = a || 'B06A6B6C6D6E6F707172AABAE6B8C6A4'x + a = a || 'B57E737475767778797AA1BFD05BDEAE'x + a = a || 'ACA3A5B7A9A7B6BCBDBEDDA8AF5DB4D7'x + a = a || '7B414243444546474849ADF4F6F2F3F5'x + a = a || '7D4A4B4C4D4E4F505152B9FBFCF9FAFF'x + a = a || '5CF7535455565758595AB2D4D6D2D3D5'x + a = a || '30313233343536373839B3DBDCD9DA9F'x + End /* If .. Do */ +Else a = xlt.3 + +Do Forever + + 'PEEKTO LINE' + If rc ^= 0 Then Leave + If line = " " Then line = "" + + 'OUTPUT' Translate(line,a,i) + If rc ^= 0 Then Leave + + 'READTO' + If rc ^= 0 Then Leave + + End /* Do Forever */ + +Return + diff --git a/vmworkshop-vmarcs/1996/tar/proftlst.xedit b/vmworkshop-vmarcs/1996/tar/proftlst.xedit new file mode 100644 index 0000000..e54c3af --- /dev/null +++ b/vmworkshop-vmarcs/1996/tar/proftlst.xedit @@ -0,0 +1,74 @@ +/* + * Name: PROFTLST XEDIT + * Profile macro for TARLIST + * Copyright 1992, Richard M. Troth + */ + +Parse Arg fn ft fm . '(' . ')' tfn tft tfm . '(' . ')' . +Select + When tft ^= "" Then Do + lcmd = '<' tfn tft tfm '| tar tf - (TARLIST' + xcmd = '<' tfn tft tfm '| tar xf -' + End /* When .. Do */ + When Datatype(tfn,'N') Then Do + lcmd = 'tar ts' tfn '(TARLIST' + xcmd = 'tar xs' tfn + End /* When .. Do */ + When Left(tfn,3) = "TAP" & Datatype(Right(tfn,1),'N') , + Length(tfn) = 4 Then Do + lcmd = 'tar t' || Right(tfn,1) '(TARLIST' + xcmd = 'tar x' || Right(tfn,1) + End /* When .. Do */ + Otherwise Do + lcmd = 'tar tf' tfn '(TARLIST' + xcmd = 'tar xf' tfn + End /* Otherwise Do */ + End /* Select */ + +'COMMAND CMS GLOBALV SELECT TARLIST PUT XCMD' + +/* 'COMMAND SET CMDLINE BOTTOM' */ +'COMMAND SET SCALE OFF' +'COMMAND SET PREFIX OFF' +'COMMAND SET RESERVED 2 HIGH Cmd Filename Bytes Date Time' +'COMMAND SET RESERVED -5 HIGH 1= Help 2= Refresh 3= Quit 4= Sort(name) 5= Sort(date) 6= Sort(size)' +'COMMAND SET RESERVED -4 HIGH 7= Backward 8= Forward 9= Extract 10= 11= Peek 12=' +'COMMAND SET MSGLINE ON -3' +'COMMAND SET CURLINE ON 3' +'COMMAND SET TOFEOF OFF' +'COMMAND SET ENTER IGNORE MACRO EXECUTAR' + +'COMMAND SET CASE MIXED IGNORE' + +'COMMAND SET RECFM V' +'COMMAND SET LRECL *' +'COMMAND SET TRUNC *' + +'COMMAND SET SYNONYM LINEND / REFRESH' , + 'COMMAND PRES /' , + 'COMMAND SET MSGMODE OFF /' , + 'COMMAND :1 /' , + 'COMMAND DELETE * /' , + 'COMMAND CMS PIPE' lcmd '| XEDIT' fn ft fm '/' , + 'COMMAND :1 /' , + 'COMMAND REST' +'REFRESH' +'COMMAND SET ALT 0' + +'COMMAND SET PF1 HELP CMS TARLIST' +'COMMAND SET PF2 REFRESH#COMMAND CURSOR COLUMN' +'COMMAND SET PF3 QQUIT' + +'COMMAND SET PF4 SORT * A 7 52' /* SORT(NAME) */ +'COMMAND SET PF5 SORT * D 69 70 63 67 72 79' /* SORT(DATE) */ +'COMMAND SET PF6 SORT * D 54 61' /* SORT(SIZE) */ +/* asis 'SORT * D 81 88' */ +'COMMAND SET PF9 MACRO EXECUTAR CURSOR PIPE' xcmd '/ (SKIP /S' +'COMMAND SET PF10' +'COMMAND SET PF11 MACRO EXECUTAR CURSOR PIPE' xcmd '/ (SKIP /S PEEK' +'COMMAND SET PF12' + +'COMMAND CURSOR COLUMN' + +Exit + diff --git a/vmworkshop-vmarcs/1996/tar/tar.copyrigh b/vmworkshop-vmarcs/1996/tar/tar.copyrigh new file mode 100644 index 0000000..920df05 --- /dev/null +++ b/vmworkshop-vmarcs/1996/tar/tar.copyrigh @@ -0,0 +1,22 @@ +� Copyright 1993, 1995, 1996 + Richard M. Troth, all rights reserved. + <plaintext> + + This software may be freely distributed provided that this notice + and the code itself remain unchanged. The user (or programmer) + may make any private changes needed to accomodate local conventions. + This software is provided AS-IS with NO WARRANTY. Neither the author + (Richard M. Troth) nor any of his employers, supporters, or dependents + shall be held liable for any damages resulting from the use of this software. + + If you wish to support future development of this software, + contact the author: + + Rick Troth + Houston, Texas 77065 USA + troth@casita.houston.tx.us + + This software depends on other support programs, of which some + are freely distributable, others proprietary and/or licensed. + + diff --git a/vmworkshop-vmarcs/1996/tar/tar.exec b/vmworkshop-vmarcs/1996/tar/tar.exec new file mode 100644 index 0000000..b6048a3 --- /dev/null +++ b/vmworkshop-vmarcs/1996/tar/tar.exec @@ -0,0 +1,12 @@ +/* © Copyright 1992, 1996, Richard M. Troth, all rights reserved. + * (casita sourced) <plaintext> + * + * Name: TAR EXEC + * run CMS TAR from the command line + */ + +Parse Arg argstring +'pipe tar' argstring +Exit rc + + diff --git a/vmworkshop-vmarcs/1996/tar/tar.filelist b/vmworkshop-vmarcs/1996/tar/tar.filelist new file mode 100644 index 0000000..d5477db --- /dev/null +++ b/vmworkshop-vmarcs/1996/tar/tar.filelist @@ -0,0 +1,35 @@ +* © Copyright 1996, Richard M. Troth, all rights reserved. <plaintext> +* +* Name: TAR FILELIST +* this lists the files comprising CMS TAR v2 r3 m1 +* + TAR FILELIST * README "this file" 0 + TAR README * + TAR COPYRIGHT * +* +* CMS TAR: + TAR EXEC * + TAR REXX * + TARINDEX REXX * + TARREADC REXX * + TARPUNCH REXX * +* TARTAPER REXX * +* TARTAPEW REXX * + TARTAKE REXX * +* +* RXVMGROUP MODULE * +* RXVMGROUP HELPCMS * +* RXVMGROUP ASSEMBLE * +* + A2E REXX * + E2A REXX * + MAKETEXT REXX * +* + TAR HELPCMS * +* +* TARLIST: + TARLIST EXEC * + PROFTLST XEDIT * + EXECUTAR XEDIT * + TARLIST HELPCMS * +* diff --git a/vmworkshop-vmarcs/1996/tar/tar.helpcms b/vmworkshop-vmarcs/1996/tar/tar.helpcms new file mode 100644 index 0000000..e0a93d6 --- /dev/null +++ b/vmworkshop-vmarcs/1996/tar/tar.helpcms @@ -0,0 +1,73 @@ +.cm This file was created from file "TAR -HLPCMS" +.cm using version 1989-09-06 of the UCSF "HELPCONV" command. +.cm +.cm Author of this help file: Sean Starke +.cm +.cs 1 on + +¢|TAR EXEC¢% + + Use CMS TAR to store many files in an archive file on tape or disk. + CMS TAR can read UNIX TAR archives and archives created with CMS TAR + can be read by UNIX 'tar'. + +.cs 1 off +.cs 2 on + The format of the TAR command is: + +------------+-------------------------------------------------------------+ + | | | + | TAR | command [tar-file] [pattern] [(options...] | + | | | + +------------+-------------------------------------------------------------+ + +.cs 2 off +.cs 3 on +¢|where:¢% + +¢|command¢% is a combination of C, X, or T with M, V and F or 0..7, + C|X|T[M][V][S|F|0|1|2|3|4|5|6|7], signifying: + + C : create a new archive + X : extract files from an archive + T : list the files in an archive + (these are mutually exclusive) + + M : don't extract modification times + V : verbose + + S : working with a spool file + F : next argument is a disk resident archive + 01234567 : tape drive number, default is TAP1 (181) + (F, S, and numerics are mutually exclusive) + +¢|tar-file¢% is the filename of the disk resident archive, having a filetype of + TAR, if F was specified in the command. This can also be the + spoolid of the file when extracting a spool TAR file, or a target + user@node when creating a spool TAR file. + +¢|pattern¢% specifies what files to tar/untar. + CREATING AN ARCHIVE: When creating an archive, this pattern must + be specified in the form 'fn ft fm', like when using the LISTSILE + command. In addition to '*' and '%', periods (.) can be used as + wilcards (like in Unix) so that if you specify simply '.' as the + pattern, then all files on your 'A' disk will be archived. If the + pattern omitted, only files specified with the INCLUDE option will + be archived. + EXTRACTING AN ARCHIVE. If you want to extract only one file, put + it's name (exactly as it appears with the LIST command) here. If + this option is omitted, all files will be extracted from the + archive. + +.cs 3 off +.cs 4 on +¢|Options:¢% + +¢|INCLUDE fn + specifies a FILELIST file listing files to be included in an + archive being built. When building an archive file according to + the INCLUDE file, the name of each file as it will appear in the + archive may follow fn ft fm in the FILELIST, overriding the + default. + +.cs 4 off + diff --git a/vmworkshop-vmarcs/1996/tar/tar.rexx b/vmworkshop-vmarcs/1996/tar/tar.rexx new file mode 100644 index 0000000..ac8aacb --- /dev/null +++ b/vmworkshop-vmarcs/1996/tar/tar.rexx @@ -0,0 +1,689 @@ +/* © Copyright 1992, 1995, Richard M. Troth, all rights reserved. + * (casita sourced) <plaintext> + * + * Name: TAR REXX + * a from-scratch replacement for CMS 'tar' v1 + * Author: Rick Troth, Houston, Texas, USA + */ + +vrm = "2.3.0" + +dfmt = 'U' /* date format used by LISTFILE */ +tzoh = -6 /* timezone offset in hours */ +tzoh = tzoffset('H') +tzos = tzoh * 60 * 60 /* timezone offset in seconds */ +tzos = tzoffset('S') + +/* ASCII non-printables */ +a_nprint = '00010203040506FF'x +/* EBCDIC non-printables */ +e_nprint = '0001020304FF'x + +Parse Arg cmd args '(' opts ')' . +Upper cmd opts +Parse Source . . . . . arg0 . +argo = arg0 || ':' + +tc = "" /* primary operation (tar command) */ +tf = "" /* archive file (tar file) */ +td = "" /* archive device (disk, tape, or SPOOL) */ + +verbose = 0; modtime = 1; prompt = 0 +include = ""; tarlist = 0; skip = 0 +peek = 0; once = 0; replace = 0 + +Do While cmd ^= "" + Parse Var cmd 1 c 2 cmd + Select /* c */ + When c = '-' Then nop + When c = 'C' Then Do + If tc ^= "" Then Do + Address "COMMAND" 'XMITMSG 66 TC C (ERRMSG' + Say argo "multiple primary operations." + Exit 24 + End /* If .. Do */ + tc = c + End /* When Do */ + When c = 'X' Then Do + If tc ^= "" Then Do + Say argo "multiple primary operations." + Exit 24 + End /* If .. Do */ + tc = c + End /* When Do */ + When c = 'T' Then Do + If tc ^= "" Then Do + Say argo "multiple primary operations." + Exit 24 + End /* If .. Do */ + tc = c + End /* When Do */ + When c = 'R' Then Do + If tc ^= "" Then Do + Say argo "multiple primary operations." + Exit 24 + End /* If .. Do */ + tc = c + End /* When Do */ + When c = 'F' Then Do + If tf ^= "" Then Do + Say argo "multiple archives specified." + Exit 24 + End /* If .. Do */ + Parse Var args tf args + td = 'F' + End /* When Do */ + When c = 'S' Then Do + If tf ^= "" Then Do + Say argo "multiple archives specified." + Exit 24 + End /* If .. Do */ + Parse Var args tf args + td = 'S' + End /* When Do */ + When c = '0' | c = '1' | c = '2' | c = '3' , + c = '4' | c = '5' | c = '6' | c = '7' Then Do + If tf ^= "" Then Do + Say argo "multiple archives specified." + Exit 24 + End /* If .. Do */ + tf = "TAP" || c + td = 'T' + End /* When Do */ + When c = 'V' Then Do + verbose = 1 + Say "CMS TAR - Version" vrm "(piped)" + End /* When Do */ + When c = 'M' Then modtime = 0 + When c = 'W' Then prompt = 1 + Otherwise Do + Address "COMMAND" 'XMITMSG 3 C (ERRMSG' + Say argo "unrecognized command token" c + Exit 24 + End /* Otherwise Do */ + End /* Select c */ + End + +If tf = "" Then tf = "TAP1" +If td = "" Then td = "T" + +Do While opts ^= "" + Parse Var opts op opts + Select /* op */ + When Abbrev("TARLIST",op,4) Then tarlist = 1 + When Abbrev("NOTARLIST",op,3) Then tarlist = 0 + When Abbrev("INCLUDE",op,3) Then Parse Var opts include opts + When Abbrev("SKIP",op,1) Then Parse Var opts skip opts + When Abbrev("PEEK",op,2) Then Do; peek = 1; once = 1; End + When Abbrev("ONCE",op,1) Then once = 1 + When Abbrev("VERBOSE",op,1) Then verbose = 1 + When Abbrev("TERSE",op,5) Then verbose = 0 + When Abbrev("MODTIME",op,1) Then modtime = 1 + When Abbrev("NOMODTIME",op,3) Then modtime = 0 + When Abbrev("PROMPT",op,2) Then prompt = 1 + When Abbrev("NOPROMPT",op,3) Then prompt = 0 + When Abbrev("REPLACE",op,3) Then replace = 1 + When Abbrev("NOREPLACE",op,3) Then replace = 0 + Otherwise Do + Address "COMMAND" 'XMITMSG 3 OP (ERRMSG' +/* Say argo "unrecognized option" op */ + Exit 24 + End /* Otherwise Do */ + End /* Select op */ + End /* Do While */ + +Select /* tc */ + + When tc = 'C' Then Do + Select /* td */ + When td = 'F' Then Do + If tf ^= "-" Then Do + Parse Var tf tfn '.' tft '.' tfm '.' . + If tft = "" Then tft = "TAR" + If tfm = "" Then tfm = "A" + 'ADDPIPE *.OUTPUT: | >' tfn tft tfm 'F 512' + End /* If .. Do */ + Call CREATE + End /* When .. Do */ + When td = 'T' Then Do + 'ADDPIPE *.OUTPUT: | TAPE' tf + Call CREATE + End /* When .. Do */ + When td = 'S' Then Do + 'ADDPIPE *.OUTPUT: | TARPUNCH' tf + Call CREATE + End /* When .. Do */ + Otherwise Do + Say argo "internal error: unknown TAR target" td tf + End /* Otherwise Do */ + End /* Select td */ + End /* When .. Do */ + + When tc = 'X' Then Do + Select /* td */ + When td = 'F' Then Do + If tf ^= "-" Then Do + Parse Var tf tfn '.' tft '.' tfm '.' . + If tft = "" Then tft = "TAR" + 'ADDPIPE <' tfn tft tfm '| *.INPUT:' + End /* If .. Do */ + Call XTRACT + End /* When .. Do */ + When td = 'T' Then Do + 'CALLPIPE CMS TAPE REW (' tf /* not quite right */ + 'ADDPIPE TAPE' tf '| *.INPUT:' + Call XTRACT + 'CALLPIPE CMS TAPE REW (' tf /* not quite right */ + End /* When .. Do */ + When td = 'S' Then Do + 'ADDPIPE TARREADC' tf '| *.INPUT:' + Call XTRACT + End /* When .. Do */ + Otherwise Do + Say argo "internal error: unknown TAR source" td tf + End /* Otherwise Do */ + End /* Select td */ + End /* When .. Do */ + + When tc = 'T' Then Do + Select /* td */ + When td = 'F' Then Do + If tf ^= "-" Then Do + Parse Var tf tfn '.' tft + If tft = "" Then tft = "TAR" + 'ADDPIPE <' tfn tft '| *.INPUT:' + End /* If .. Do */ + Call LISTOC + End /* When .. Do */ + When td = 'T' Then Do + 'CALLPIPE CMS TAPE REW (' tf /* not quite right */ + 'ADDPIPE TAPE' tf '| *.INPUT:' + Call LISTOC + 'CALLPIPE CMS TAPE REW (' tf /* not quite right */ + End /* When .. Do */ + When td = 'S' Then Do + 'ADDPIPE TARREADC' tf '| *.INPUT:' + Call LISTOC + End /* When .. Do */ + Otherwise Do + Say argo "internal error: unknown TAR source" td tf + End /* Otherwise Do */ + End /* Select td */ + End /* When .. Do */ + + End /* Select tc */ + +Exit rc * (rc ^= 12) + + +/* --------------------------------------------------------------------- + * create or update + */ +CREATE: + +If include = "" Then 'ADDPIPE TARINDEX' args '| *.INPUT:' + Else 'ADDPIPE <' include 'FILELIST | *.INPUT:' + +userid = Userid() +groupid = "N/A" /* vmgroup(userid) */ +'CALLPIPE VAR USERID | XLATE LOWER | VAR USERID' +'CALLPIPE VAR GROUPID | XLATE LOWER | VAR GROUPID' + +Do Forever + + 'READTO RECORD' + If rc ^= 0 Then Leave + If Strip(record) = "" Then Iterate + + If Left(record,1) = '*' Then Iterate + If Left(record,1) = '#' Then Iterate + +/* + Parse Upper Var record fn ft fm . '(' opts ')' . + Parse Var record . . . name '(' . ')' . + */ + q1 = Index(record,"'"); q2 = Index(record,'"') + Select + When q1 = 0 & q2 = 0 Then , + Parse Var record fn ft fm name '05'x . '05'x type '05'x . + When q1 = 0 Then , + Parse Var record fn ft fm name '"' . '"' type + When q2 = 0 Then , + Parse Var record fn ft fm name "'" . "'" type + When q1 > q2 Then , + Parse Var record fn ft fm name '"' . '"' type + When q2 > q1 Then , + Parse Var record fn ft fm name "'" . "'" type + End /* Select */ + Upper fn ft fm + Parse Var name . '(' opts ')' . + name = Strip(name) + If name = "" Then , + 'CALLPIPE LITERAL' Strip(fn) || '.' || Strip(ft) , + '| XLATE LOWER | STRIP | VAR NAME' + 'CALLPIPE COMMAND LISTFILE' fn ft fm '(DATE | DROP | VAR FILESPEC' + Parse Var filespec . . fmode recfm lrecl . . date time . + fmode = Right(fmode,1) + Select /* fmode */ + When fmode = 0 Then perm = '600' + When fmode = 1 Then perm = '644' + When fmode = 2 Then perm = '644' + When fmode = 3 Then perm = '444' + When fmode = 4 Then perm = '644' + When fmode = 5 Then perm = '644' + When fmode = 6 Then perm = '666' + Otherwise perm = '644' + End /* Select fmode */ + + If recfm = 'V' Then lrecl = 0 + + 'CALLPIPE <' fn ft fm '| TAKE FIRST 1 | VAR SAMPLE' + If Verify(sample,e_nprint,'M') = 0 Then trans = 't' + Else trans = 'b' + + Select + When trans = 't' Then + pipe = '| STRIP TRAILING | E2A | SPEC 1-* 1 .0A. X2C NEXT' + When lrecl = 0 Then + pipe = '| BLOCK 512 CMS' + Otherwise + pipe = "" + End /* Select */ + + 'CALLPIPE <' fn ft fm pipe '| COUNT BYTES | VAR SIZE' + + Call MKTARENT + + 'CALLPIPE VAR TARENT | E2A | *:' + 'CALLPIPE <' fn ft fm pipe '| FBLOCK 512 00 | *:' + If verbose Then Say "a" name || "," size "bytes," trans lrecl + + End /* Do Forever */ + +/* a trailer of nulls */ +'OUTPUT' Copies('00'x,512) + +Return + + +/* --------------------------------------------------------------------- + * extract + */ +XTRACT: + +'ADDPIPE *: | FBLOCK 512 | *.INPUT:' +'CALLPIPE *: | TAKE' skip '| HOLE' + +Parse Var args xtf xfn xft xfm . +If xfn = "" Then xfn = "=" +If xft = "" Then xft = "=" +If xfm = "" Then xfm = "A" + +Do Forever + + 'PEEKTO' + If rc ^= 0 Then Leave + + 'CALLPIPE *: | TAKE 1 | A2E | VAR RECORD' + Call EXTARENT + If size = 0 & name = "" Then Leave + If size = 0 Then Iterate + If name ^= xtf & xtf ^= '*' & xtf ^= '' Then Do + 'CALLPIPE *: | TARTAKE' size '| HOLE' + Iterate + End /* If .. Do */ + + Parse Value Reverse(name) With basename '/' . + basename = Reverse(basename) + Parse Upper Var basename fn '.' ft '.' . + If fn = "" Then fn = Userid() + If xfn ^= "=" Then fn = xfn + If ft = "" Then ft = "$" + If xft ^= "=" Then ft = xft + fm = xfm + filespec = fn ft fm + + If ^peek Then Do + 'CALLPIPE STATE' filespec + If rc = 0 Then Do + If ^replace Then Do + If verbose Then , + Say "x" name || "," size "bytes," , + (size+511)%512 "tape blocks" + Address "COMMAND" 'XMITMSG 24 FILESPEC (CALLER TAR' + Leave + End /* If .. Do */ + Else Address "COMMAND" 'ERASE' filespec + End /* If .. Do */ + End /* If .. Do */ + + If trans ^= 'T' & trans ^= 'B' Then Do + 'PEEKTO RECORD' + If size < 512 Then record = Left(record,size) + If Verify(record,a_nprint,'M') = 0 Then Do + trans = 'T' + lrecl = 0 + End /* If .. Do */ + Else Do + trans = 'B' + If size < 65536 Then lrecl = size + Else lrecl = 512 + End /* Else Do */ + End /* If .. Do */ + + Select + When trans = 'T' & lrecl = 0 Then + pipe = 'DEBLOCK LINEND 0A | STRIP TRAILING 0D' , + '| DROP LAST | A2E | PAD 1' + When trans = 'T' & lrecl > 0 Then , + pipe = 'DEBLOCK LINEND 0A | STRIP TRAILING 0D' , + '| DROP LAST | A2E | PAD' lrecl + When trans = 'B' & lrecl = 0 Then , + pipe = 'DEBLOCK CMS' + When trans = 'B' & lrecl > 0 Then , + pipe = 'FBLOCK' lrecl '00' + When trans = 'V' Then , + pipe = 'DEBLOCK CMS' + End /* Select */ + + If lrecl = 0 Then fix = "" + Else fix = "FIXED" lrecl + + If verbose Then , + Say "x" name || "," size "bytes," , + (size+511)%512 "tape blocks, as" , + filespec || fmode trans fix + 'CALLPIPE' , + '*: | TARTAKE' size '|' pipe '| > TAR CMSUT1' fm || '3' fix + + If peek Then Do + Address "COMMAND" 'MAKEBUF' + Push "COMMAND MSG x" name || "," size "bytes," , + (size+511)%512 "tape blocks" + Push "COMMAND SET FN" fn + Push "COMMAND SET FT" ft + Push "COMMAND SET FM" fm || fmode + Address "COMMAND" 'XEDIT TAR CMSUT1' fm + Address "COMMAND" 'DROPBUF' + End /* If .. Do */ + Else Do + Address "COMMAND" 'RENAME TAR CMSUT1' fm filespec || fmode + Address "COMMAND" 'DMSPLU' filespec date time + End /* Else Do */ + + If once Then Leave + If xtf ^= '*' & xtf ^= '' Then Leave + + End /* Do Forever */ + +Return + + +/* --------------------------------------------------------------------- + * list table of contents + */ +LISTOC: + +'ADDPIPE *: | FBLOCK 512 | *.INPUT:' +'CALLPIPE *: | TAKE' skip '| HOLE' + +Do Forever + + 'PEEKTO' + If rc ^= 0 Then Leave + + 'CALLPIPE *: | TAKE 1 | A2E | VAR RECORD' + Call EXTARENT + If size = 0 & name = "" Then Leave + + If size > 0 Then Do + Select + When tarlist Then 'OUTPUT' " " || Left(name,46) , + Right(size,8) Right(date,8) Right(time,8) , + Right(skip,8) name +/* trans recfm lrecl fmode */ + When verbose Then 'OUTPUT' Left(name,42) '-' , + Right(date,8) Right(time,8) Right(size,8) "bytes." + Otherwise 'OUTPUT' name + End /* Select */ + + take = Trunc((size + 511) / 512) + 'CALLPIPE *: | TAKE' take '| HOLE' + skip = skip + take + End /* If .. Do */ + skip = skip + 1 + + If args ^= "" Then Leave + + End /* Do Forever */ + +Return + + +/* ------------------------------------------------------------ EXTARENT + * Extract TAR entry (directory info) values. + * Sets: size, and other variables. + */ +EXTARENT: +Parse Var record 1 name '00'x . +record = Translate(record,' ','00'x) +Parse Upper Var record 101 perm . , + 125 size date chksum trans lrecl fmode . , + 257 . , + 385 . +size = o2d(size) /* convert to decimal */ +If size > 0 Then Do + Parse Value sysdate(o2d(date)) With date time . + chksum = o2d(chksum) /* convert to decimal */ + lrecl = o2d(lrecl) /* convert to decimal */ + If lrecl = 0 Then recfm = 'V' + Else recfm = 'F' + If ^Datatype(fmode,'N') Then fmode = '1' + End /* If .. Do */ + +Return + + +/* ------------------------------------------------------------------ */ +O2D: Procedure /* Octal to Decimal conversion */ +Parse Arg o +d = 0 +Do While o ^= "" + Parse Var o 1 c 2 o + If Datatype(c,'N') Then d = d * 8 + c + End /* Do While */ +Return d + + +/* ------------------------------------------------------------------ */ +D2O: Procedure /* Decimal to Octal conversion */ +Parse Arg d +If ^Datatype(d,'N') Then d = 0 +d = trunc(d) +If d < 1 Then Return 0 +o = "" +Do While d ^= 0 + o = d // 8 || o + d = d % 8 + End /* Do While */ +Return o + + +/* ------------------------------------------------------------------ */ +DATEREAD: Procedure /* return textual date from octal */ +Parse Arg date + +year = 1970 +Do Forever + If year - (year % 4) * 4 = 0 Then days = 366 + Else days = 365 + If date < days Then Leave + date = date - days + year = year + 1 + End + +Return year || '.' || date + + +/* ------------------------------------------------------------------ */ +DATEMAKE: Procedure /* return octal date from textual */ +Parse Arg date + +_m.1 = 31; _m.2 = 28; _m.3 = 31; _m.4 = 30 +_m.5 = 31; _m.6 = 30; _m.7 = 31; _m.8 = 31 +_m.9 = 30; _m.10 = 31; _m.11 = 30; _m.12 = 31 + +year = 1970 +Do Forever + If year - (year % 4) * 4 = 0 Then days = 366 + Else days = 365 + If date < days Then Leave + date = date - days + year = year + 1 + End + +Return year || '.' || date + +/* +If yy // 4 = 0 & yy // 100 ^= 0 Then _m.2 = 29 + Else _m.2 = 28 + */ + + +/* ------------------------------------------------------------- TARDATE + */ +TARDATE: Procedure Expose dfmt tzos +Parse Arg date time . +Parse Var time hh ':' mm ':' ss +Parse Var date mo '/' dd '/' yy /* If dfmt = 'U' */ +ly = (yy // 4 = 0 & (yy // 100 ^= 0 | yy // 400 = 0)) +Select /* mo */ + When mo = 1 Then nop + When mo = 2 Then dd = dd + 31 + When mo = 3 Then dd = dd + 59 + ly + When mo = 4 Then dd = dd + 90 + ly + When mo = 5 Then dd = dd + 120 + ly + When mo = 6 Then dd = dd + 151 + ly + When mo = 7 Then dd = dd + 181 + ly + When mo = 8 Then dd = dd + 212 + ly + When mo = 9 Then dd = dd + 243 + ly + When mo = 10 Then dd = dd + 273 + ly + When mo = 11 Then dd = dd + 304 + ly + When mo = 12 Then dd = dd + 334 + ly + End /* Select mm */ +Do yy = yy - 1 to 70 by -1 + ly = (yy // 4 = 0 & (yy // 100 ^= 0 | yy // 400 = 0)) + dd = dd + 365 + ly + End /* Do For */ +dd = dd - 1 +Return dd*86400+hh*3600+mm*60+ss-tzos + + +/* ------------------------------------------------------------- SYSDATE + */ +SYSDATE: Procedure Expose dfmt tzos +Parse Arg base . +base = base + tzos +dd = base % 86400 + 1 +time = base // 86400 +yy = 70 +ly = (yy // 4 = 0 & (yy // 100 ^= 0 | yy // 400 = 0)) +Do While dd > 365 + ly + yy = yy + 1 + dd = dd - 365 - ly + ly = (yy // 4 = 0 & (yy // 100 ^= 0 | yy // 400 = 0)) + End /* Do While */ +Select /* mo */ + When dd <= 31 Then mm = 1 + When dd <= 59 + ly Then Do; mm = 2; dd = dd - 31; End + When dd <= 90 + ly Then Do; mm = 3; dd = dd - 59 - ly; End + When dd <= 120 + ly Then Do; mm = 4; dd = dd - 90 - ly; End + When dd <= 151 + ly Then Do; mm = 5; dd = dd - 120 - ly; End + When dd <= 181 + ly Then Do; mm = 6; dd = dd - 151 - ly; End + When dd <= 212 + ly Then Do; mm = 7; dd = dd - 181 - ly; End + When dd <= 243 + ly Then Do; mm = 8; dd = dd - 212 - ly; End + When dd <= 273 + ly Then Do; mm = 9; dd = dd - 243 - ly; End + When dd <= 304 + ly Then Do; mm = 10; dd = dd - 273 - ly; End + When dd <= 334 + ly Then Do; mm = 11; dd = dd - 304 - ly; End + Otherwise Do; mm = 12; dd = dd - 334 - ly; End + End /* Select dd */ +Return Right(mm,2,'0') || '/' || , + Right(dd,2,'0') || '/' || , + Right(yy,2,'0') , + Right(time%3600,2,'0') || ':' || , + Right((time//3600)%60,2,'0') || ':' || , + Right(time//60,2,'0') + + +/* ------------------------------------------------------------ MKTARENT + * Create a TAR entry (directory info) from values. + */ +MKTARENT: + +chksum = 0 + +tarent = Left(name,100,'00'x) || , + Right(perm,6) '00'x || , + " 1" '00'x || " 1" '00'x || , + Right(d2o(size),11) , + Right(d2o(tardate(date time)),11) , + Right(d2o(chksum),6) || '00'x || , + Right(trans,2) , + Right(d2o(lrecl),8) , + Right(fmode,1) || '00'x + +'CALLPIPE VAR TARENT | E2A | VAR TARENT' +Do i = 1 to Length(tarent) + chksum = chksum + c2d(Substr(tarent,i,1)) + End + +chksum = chksum + 16 + + +tarent = Left(name,100,'00'x) || , + Right(perm,6) '00'x || , + " 1" '00'x || " 1" '00'x || , + Right(d2o(size),11) , + Right(d2o(tardate(date time)),11) , + Right(d2o(chksum),6) || '00'x || , + Right(trans,2) , + Right(d2o(lrecl),8) , + Right(fmode,1) || '00'x + +tarent = Left(tarent,256,'00'x) +tarent = Left(tarent,512,'00'x) + +Return + +tarent02 = '00'x || "ustar" || '00'x || "00" || , + Left(userid,32,'00'x) || Left(groupid,32,'00'x) || , + "0000000" || '00'x || "0000000" || '00'x + +Return + + +/* ------------------------------------------------------------ TZOFFSET + * Compute timezone offset based on timezone string from 'CP Q TIME'. + * (we probably have a CSL routine to do this ... but maybe not) + */ +TZOFFSET: Procedure + +Parse Upper Arg denom . ',' . , . +Parse Upper Value Diag(08,'QUERY TIME') With . . . tz . + +Select /* tz */ + When tz = "CST" Then zo = -6 + When tz = "CDT" Then zo = -5 + When tz = "EST" Then zo = -5 + When tz = "EDT" Then zo = -4 + Otherwise zo = 0 + End /* Select tz */ + +denom = Left(denom,1) +Select /* denom */ + When denom = "S" Then Return zo * 60 * 60 /* offset in seconds */ + When denom = "M" Then Return zo * 60 /* offset in minutes */ + Otherwise Return zo + End /* Select denom */ + + diff --git a/vmworkshop-vmarcs/1996/tar/tarindex.rexx b/vmworkshop-vmarcs/1996/tar/tarindex.rexx new file mode 100644 index 0000000..8a2bc27 --- /dev/null +++ b/vmworkshop-vmarcs/1996/tar/tarindex.rexx @@ -0,0 +1,70 @@ +/* + * Name: TARINDEX REXX + * create a CMS TAR "include file" (FILELIST format) + * Author: Rick Troth, Houston, Texas, USA + * Date: 1992-Oct-01, 1993-Feb-01 + */ + +Parse Upper Arg fn ft fm fp . '(' . +Select + When fp ^= "" Then nop + When fn = '.' Then Do + fn = '*'; ft = '*' + fm = 'A'; fp = '.' + End + When fm = '.' Then Do + fm = 'A'; fp = '.' + End + Otherwise Do + If fn = "" Then fn = '*' + If ft = "" Then ft = '*' + If fm = "" Then fm = 'A' + 'CALLPIPE COMMAND QUERY DISK' fm '| DROP' , + '| SPEC 1.6 1 | STRIP | VAR FP' + If rc ^= 0 Then Exit rc + If fp = '-' Then fp = '.' + End /* Otherwise Do */ + End /* Select */ + +'ADDPIPE COMMAND LISTFILE' fn ft fm '(ALLOC ALLFILE NOHEADER | *.INPUT:' +If rc ^= 0 & rc ^= 28 Then , + 'ADDPIPE COMMAND LISTFILE' fn ft fm '| *.INPUT:' +If rc ^= 0 & rc ^= 28 Then Exit rc +If rc = 28 Then Exit 0 + +Parse Source . . arg0 . + +uc = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" +lc = "abcdefghijklmnopqrstuvwxyz" + +Do Forever + + 'PEEKTO FILEID' + If rc ^= 0 Then Leave + + Parse Var fileid _fn _ft _fm . + + If _fm = "DIR" Then Do + 'READTO' + If rc ^= 0 Then Leave + 'CALLPIPE COMMAND ACCESS +' || _ft || '.' || _fn _ft + If rc ^= 0 Then Iterate + _fp = Translate(fp || '/' || _fn, lc, uc) + 'OUTPUT' "*!mkdir" _fp + 'CALLPIPE' arg0 '* *' _ft _fp '| *:' + 'CALLPIPE COMMAND ACCESS -' || _ft _ft + Iterate + End /* If .. Do */ + + 'OUTPUT' " " _fn _ft _fm , + Translate(fp || '/' || _fn || '.' || _ft, lc, uc) + If rc ^= 0 Then Leave + + 'READTO' + If rc ^= 0 Then Leave + + End /* Do While */ + +Exit rc * (rc ^= 12) + + diff --git a/vmworkshop-vmarcs/1996/tar/tarlist.exec b/vmworkshop-vmarcs/1996/tar/tarlist.exec new file mode 100644 index 0000000..7dca4be --- /dev/null +++ b/vmworkshop-vmarcs/1996/tar/tarlist.exec @@ -0,0 +1,12 @@ +/* + * Name: TARLIST EXEC + * rather like FILELIST, but for TAR archives + * Copyright 1992, Richard M. Troth + */ + +Parse Arg fn ft fm args '(' opts ')' rest +If fn = "" Then fn = "TAP1" +'XEDIT' fn 'TARLIST A0 (WIDTH 240 PROFILE PROFTLST)' , + fn ft fm args '(' opts ')' rest +Exit rc + diff --git a/vmworkshop-vmarcs/1996/tar/tarlist.helpcms b/vmworkshop-vmarcs/1996/tar/tarlist.helpcms new file mode 100644 index 0000000..4093d9e --- /dev/null +++ b/vmworkshop-vmarcs/1996/tar/tarlist.helpcms @@ -0,0 +1,27 @@ +.cm This file was created by hand. +.cm +.cs 1 on + +¢|TARLIST EXEC¢% + + Use the TARLIST command to browse a TAR file similar to FILELIST. + +.cs 1 off +.cs 2 on + The format of the TARLIST command is: + +------------+-------------------------------------------------------------+ + | | | + | TARLIST | tar-file | + | | | + +------------+-------------------------------------------------------------+ + + Note: TARLIST is *not* well developed. The task of writing + a utility from scratch that functions like FILELIST + has been overwhelming. PF9 and PF11 work as listed, + but don't expect anything else. + +.cs 2 off +.cs 3 on +.cs 3 off +.cs 4 on +.cs 4 off diff --git a/vmworkshop-vmarcs/1996/tar/tarpunch.rexx b/vmworkshop-vmarcs/1996/tar/tarpunch.rexx new file mode 100644 index 0000000..54c15f0 --- /dev/null +++ b/vmworkshop-vmarcs/1996/tar/tarpunch.rexx @@ -0,0 +1,50 @@ +/* © Copyright 1995, Richard M. Troth, all rights reserved. <plaintext> + * + * Name: TARPUNCH REXX + * "punch" a tar "deck" to another user + * Copyright 1992, 1995, Richard M. Troth + */ + +Parse Arg target . '(' . ')' . + +/* if target is a dash, feed to punch w/o closing */ +If target = '-' Then Do + 'CALLPIPE *.INPUT: | FBLOCK 80 00 | PUNCH' + Exit rc + End /* If .. Do */ + +/* okay, so we really want to send this */ +'CALLPIPE COMMAND IDENTIFY | VAR IDENTITY' +Parse Var identity userid . hostid . rscsid . '15'x . +Parse Var target user '@' host +If user = "" Then user = userid +If host = "" Then host = hostid + +/* careful! this is a raw SIFT/UFT job */ +Address "COMMAND" 'STATE UFTCHOST REXX *' +If rc = 0 Then Do + 'ADDPIPE *.OUTPUT: | UFTCHOST' host '(TYPE I | *.OUTPUT:' + 'CALLPIPE VAR USERID | XLATE LOWER | VAR USERID' + 'OUTPUT FILE 0' userid '-' +/* 'OUTPUT USER' user || '@' || host */ + 'OUTPUT USER' user + 'OUTPUT TYPE I' + 'OUTPUT DATA' +/* 'SHORT' */ + 'CALLPIPE *: | *:' + End /* If .. Do */ + +/* that didn't work, so punt to RSCS */ +Else Do + Address "COMMAND" 'GETFMADR' + If rc ^= 0 Then Exit rc + Parse Pull . . tmp . + 'CALLPIPE CP DEFINE PUNCH' tmp + 'CALLPIPE CP TAG DEV' tmp host user '50' + 'CALLPIPE CP SPOOL' tmp 'TO' rscsid + 'CALLPIPE *.INPUT: | FBLOCK 80 00 | SPEC x41 1 1-* NEXT | URO' tmp + 'CALLPIPE CP DETACH' tmp + End /* Else Do */ + +Exit + diff --git a/vmworkshop-vmarcs/1996/tar/tarreadc.rexx b/vmworkshop-vmarcs/1996/tar/tarreadc.rexx new file mode 100644 index 0000000..5668981 --- /dev/null +++ b/vmworkshop-vmarcs/1996/tar/tarreadc.rexx @@ -0,0 +1,35 @@ +/* + * Name: TARREADC REXX + * read a tar "deck" in the reader + * Copyright 1992, Richard M. Troth + */ + +rdr = "00C" + +Parse Arg tf . '(' . ')' . + +'CALLPIPE CP QUERY VIRTUAL' rdr '| VAR READER' +Parse Var reader . . . . . hold . '15'x . +'CALLPIPE CP SPOOL' rdr 'HOLD' +'CALLPIPE CP CLOSE' rdr + +If tf ^= "-" Then Do + 'CALLPIPE CP ORDER READER' tf '| VAR RS' + If rc ^= 0 Then Do + orc = rc + 'OUTPUT' rs + 'CALLPIPE CP SPOOL' rdr hold + Exit orc + End /* If .. Do */ + End /* If .. Do */ + +'CALLPIPE READER' rdr , + '| NLOCATE 1-1 /' || '03'x || '/' , + '| SPEC 2-* 1 | PAD 80 40 | *:' + +'CALLPIPE CP CLOSE' rdr +'CALLPIPE CP SPOOL' rdr hold + +Exit + + diff --git a/vmworkshop-vmarcs/1996/tar/tartake.rexx b/vmworkshop-vmarcs/1996/tar/tartake.rexx new file mode 100644 index 0000000..55f1742 --- /dev/null +++ b/vmworkshop-vmarcs/1996/tar/tartake.rexx @@ -0,0 +1,25 @@ +/* + * Name: TARTAKE REXX + * pass an exact number of bytes + * while consuming an integral number of 512-byte records. + * Copyright 1993, Richard M. Troth + */ + +Parse Arg size . '(' . ')' . +If ^Datatype(size,'N') Then Exit +If size = 0 Then Exit + +full = size % 512 +'CALLPIPE *: | TAKE' full '| *:' +If rc ^= 0 Then Exit rc + +part = size // 512 +If part = 0 Then Exit +'PEEKTO RECORD' +'OUTPUT' Left(record,part) +'READTO' +If rc ^= 0 Then Exit rc + +Exit + + diff --git a/vmworkshop-vmarcs/2012/README.md b/vmworkshop-vmarcs/2012/README.md new file mode 100644 index 0000000..be53562 --- /dev/null +++ b/vmworkshop-vmarcs/2012/README.md @@ -0,0 +1,3 @@ +## Source + +Code from VMARCs distributed as part of the 2012 VM Workshop. diff --git a/vmworkshop-vmarcs/2012/qlabs/qlabs.exec b/vmworkshop-vmarcs/2012/qlabs/qlabs.exec new file mode 100644 index 0000000..d5fffa6 --- /dev/null +++ b/vmworkshop-vmarcs/2012/qlabs/qlabs.exec @@ -0,0 +1,105 @@ +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ +/* This exec is intended to list VOL1 and CMS1 label enteries from a */ +/* formatted disk. */ +/* */ +/* One parameter is required and may be entered either */ +/* at invocation or in response to a prompt. */ +/* It is: 1) unit address */ +/* An option is available to specify a range of cylinders to scan */ +/* .. useful to limit the scope of the label search */ +/* */ +/* FORMAT: QLABS vdev (startcyl endcyl */ +/* DEFAULTS: startcyl = 0 */ +/* endcyl = startcyl */ +/* NOTE: endcyl may be entered as * or END to scan to the end of the */ +/* volume */ +/* */ +/* *** for these examples assume MAINT 123 linked as 123 *** */ +/* EXAMPLE: QLABS 123 see the volume label for 123 */ +/* EXAMPLE: QLABS 123 (39 should show MNTCF1 (z/VM 6.2) */ +/* EXAMPLE: QLABS 123 (39 1000 show all labels on 123 between */ +/* cylinders 39 and 1000 */ +/* EXAMPLE: QLABS 123 (0 END show all labels on 123 between */ +/* cylinders 0 thru the last cylinder */ +/* */ +/* Dependencies and pre-reqs: */ +/* */ +/* The pipe stage 'trackread' is used which is available in the */ +/* Princeton University pipelines package. */ +/* http://vm.marist.edu/~pipeline/index.html#Runtime */ +/* */ +/* PICKPIPE which can be downloaded from IBM's VM download page. */ +/* http://www.vm.ibm.com/download/packages/ */ +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ + + parse source . . exname . /* get the EXEC name for displays */ + arg unit . '(' start end . /* parse out the args */ + if unit = '' then do /* do we have the unit addr? */ + say 'CUU -- START & END cylinders' /* no.. ask for it */ + pull unit start end . /* get the response */ + end + if start = '' then start = 0 /* if not specified start on cyl 0 */ + if end = '' then end = start /* if not specified end on the start cyl */ + rrc = 0 /* initialize */ + ncms = 0 /* initialize */ + ycms = 0 /* initialize */ + 'pipe query version | spec 1-3 1 | var pipelevel' + if pipelevel ¬= 'PIP' then, /* do we have correct pipes?*/ + pickpipe u '(quiet' /* no then load the UPLEVEL pipes */ + if rc ¬= 0 then /* was pipe load successful? */ + call msg 16, 'An uplevel pipe package is not available-- 'exname ' cannot continue' + + 'pipe devinfo' unit '| var temp' /* get device characteristics */ + if rc ¬= 0 then /* device error */ + call msg 20, 'Device error trying to access ' unit '--' exname 'cannot continue' + parse var temp cuu clas dvtyp cutyp cyls trkpc trklen . /* parse it out to vars */ + + if dvtyp ¬= '3390' then /* device type must be 3390 */ + call msg 24, 'Device' cuu 'is not a supported device type' dvtyp '¬= 3390' + + if end = '*' | end = 'END' then end = cyls -1 /* calculate the end cylinder */ + + if end < start then /* verify cylinder range */ + call msg 26, 'END less than START on' unit ' --' exname 'cannot continue' + + if end > cyls -1 then /* verify cylinder range */ + call msg 28, 'END ('end') > last cylinder ('cyls -1') on' unit ' --' exname 'cannot continue' + + sscan = start /* start scan cylinder */ + escan = end /* end scan cylinder */ + do start = start by 1 until start = end /* loop read specified cylinders */ + 'PIPE (endchar ? )', /* start the pipe */ + '| trackread' unit start '0 ', /* read a track */ + '| trackdeblock ', /* deblock the track */ + '| drop first 4', /* ... possible label */ + '| specs 09-28 1 ', /* extract the label TYPE & NAME */ + '| var r3vol ' /* save TYPE and NAME for later */ + if rc ¬= 0 then /* device error? */ + call msg 30, 'Device error see previous messages --' exname 'cannot continue' + + select; + when substr(r3vol,1,4) = 'VOL1' then do /* is this a non-CMS formatted extent */ + call msg 00, 'VOLUME label for' unit 'at cylinder' start 'is' substr(r3vol,9,6) + ncms = ncms +1 /* count the non-CMS labels */ + end + when substr(r3vol,1,4) = 'CMS1' then do /* is this a CMS formatted extent? */ + call msg 00, 'CMS label for' unit 'at cylinder 'start 'is ' substr(r3vol,5,6) + ycms = ycms +1 /* count the CMS labels */ + end + otherwise; + end /* return and read the next track */ + end + call msg 00, exname 'scanned cylinders' sscan 'through' escan + call msg 00, exname 'Finished normally and detected' ncms 'non-CMS labels and 'ycms' CMS labels' +signal finish + +msg: /* messages */ + parse arg rrc, txt /* parse the message into its parts */ + say txt /* display the message */ + if rrc = 0 then return + signal finish /* wrap it up and exit */ + +finish: + if pipelevel ¬= 'PIP' then, /* did we start with modern pipes? */ + pickpipe cms '(quiet' /* no .. put back CMS pipes */ +exit rrc /* exit */ diff --git a/vmworkshop-vmarcs/2012/splcksum/splcksum.exec b/vmworkshop-vmarcs/2012/splcksum/splcksum.exec new file mode 100644 index 0000000..563b8b1 --- /dev/null +++ b/vmworkshop-vmarcs/2012/splcksum/splcksum.exec @@ -0,0 +1,52 @@ +/*----------------------------------------*/ +/* Display the checksum on an NSS or DCSS */ +/* */ +/* Syntax: */ +/* SPLCKSUM <nss_name> */ +/* <dcss_name> */ +/* */ +/* */ +/* */ +/*----------------------------------------*/ + +parse upper arg infile rest +If rest <> '' then + Do + say 'ERROR: Extra parameter was specified -- 'rest + exit 4 + End + +'pipe CP QUERY PRIVCLAS ', +' | drop first 1 ', +' | drop last 2 ', +' | spec w2 1 ', +' | var pclass ' +Do l = 1 to length(pclass) + If substr(pclass,l,1) = 'E' then leave + If l = length(pclass) then + Do + say 'ERROR: Privilege class E is required.' + say ' You have only the following classes -- 'pclass + exit 8 + End +End + +'pipe CP Q NSS | spec w2 1 w8 10 | stem outrec.' + +Do i = 2 to outrec.0 + spid = word(outrec.i,1) + name = word(outrec.i,2) + If name = infile then leave + If i = outrec.0 then + Do + say 'ERROR: Requested NSS or DCSS was not found -- 'infile + exit 12 + End +End + +'pipe CP LOCATE SPFBK *NSS 'spid ' | drop first 1 | spec w4 | var spf@' +spfsha1s@ = d2x(x2d(spf@) + 112) +'pipe CP DISPLAY HL' || spfsha1s@ || '.20 ', +' | join 1 | spec w2 1 w3 10 w4 19 w5 28 w8 37 | var cksm' +say infile ' checksum: 'cksm +exit 0