********************************************************************** * COPYRIGHT 1995 THE UNIVERSITY OF DELAWARE. ALL RIGHTS RESERVED. * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * TITLE......: /* STRING INSURANCE */ 1 #DATAPARM (A128) 1 REDEFINE #DATAPARM 2 #DATP (A1 / 1:128) *********** **1 #HOST (A20) /* ?? moved to be like gopher servers **1 #HOSTPORT (A5) /* ?? * 1 #NATSVP (A45) INIT 1 REDEFINE #NATSVP 2 #HPORT (A5) /* master listening port 2 NUL01 (A1) /* INIT 2 #TPORT (A2) /* real port for current exchange 2 REDEFINE #TPORT 3 #XTPORT (I2) 2 NUL02 (A1) /* INIT 2 #IPADDR (A4) /* ip address of client machine 2 REDEFINE #IPADDR 3 #XIPADDR (B4) 2 REDEFINE #IPADDR 3 #IPADDR-B (B1 /1:4) 2 NUL03 (A1) /* INIT 2 #CTYPE (A1) /* C=close,L=last,M=more,R=read,W=write 2 NUL04 (A1) /* INIT 2 #HOST (A20) /* our server machine ip address 2 REDEFINE #HOST 3 #HOSTCH (A1/1:20) /* moved 2/3/95 2 #HOSTPORT (A5) /* master listener port = #HPORT 2 #NATSVP-FILLER (A4) /* added 2/3/95 2 REDEFINE #NATSVP-FILLER 3 #NATSVPARM-TRACE (A1) * *************************************************************** 1 #PROGRAMN (A8) 1 REDEFINE #PROGRAMN 2 #MFUTYPE (A3) /* 1/20/95 MFU 2 #MFUNUM (A4) /* 1/20/95 #### * 1 #SUBPNAME (A8) /* used with MFN9999 to get for module 1 #SUBPFOUND (I1) /* 1 = found 0 = not found * 1 #DATN (N8) 1 REDEFINE #DATN 2 #DATN-CC (A2) 2 #DATN-YY (A2) 2 #DATN-MM (A2) 2 #DATN-DD (A2) 1 REDEFINE #DATN 2 #DATN-A (A8) 1 #TIMN (N7) 1 REDEFINE #TIMN 2 #TIMN-A (A7) 1 #IPADDRPRINT 2 #XIP1 (N3) 2 #XIP2 (N3) 2 #XIP3 (N3) 2 #XIP4 (N3) 1 REDEFINE #IPADDRPRINT 2 #XIP1A (A3) 2 #XIP2A (A3) 2 #XIP3A (A3) 2 #XIP4A (A3) * * 1 #BLANK (A1) INIT /* ASCII * 1 #TAB (A1) INIT /* ASCII * 1 #CRLF (A2) INIT /* ASCII * 1 #EOM (A4) INIT /* ASCII * 1 #LF (A1) INIT /* ASCII 1 #LF (A1) INIT /* EBCDIC 1 #BLANK (A1) INIT /* EBCDIC 1 #TAB (A1) INIT /* EBCDIC 1 #CRLF (A2) INIT /* EBCBIC 1 #EOM (A4) INIT /* EBCIDC 1 #CR (A1) INIT 1 #NULL (A1) INIT 1 #FWDFROM (A110) /* 5/18/95 1 REDEFINE #FWDFROM 2 #FWD (A1 / 1:110) 1 #I (N4) /* 5/18/95 1 #J (N4) /* 5/18/95 1 #DBCLOSE (B2) /* 7/21/95 1 #RETC (B2) /* 7/21/95 ************************** 1 SISSATTB VIEW OF SIS-STUDENT-ATTRIBUTES /* -10 2 AA002 /* STUDENT ID = SSN A9 * 1 CT-VIEW VIEW OF CENTRALTABLES-RO 2 TBL-KEY * ************************************************************* 1 #ERROR-DATA (A20) 1 REDEFINE #ERROR-DATA 2 #ERROR-TYPE (A1) 2 #ERROR-PROGRAM (A08) 2 #ERROR-LINE (N04) 2 #ERROR-CODE (N07) END-DEFINE ********************************************************************* ********************************************************************* FORMAT LS=120 /* 4/27/95 FORMAT (1) LS=132 /* 4/27/95 REPEAT UNTIL #PROGNM = 'SIQUITS' RESET #SCRIPT(*) #CTYPE #IPADDR #TPORT /* moved 7/26/95 COMPRESS '128.175.13.24' #TAB INTO #HOST LEAVING NO SPACE IF *APPLIC-ID = 'MF-DEV' MOVE '26222' TO #HPORT #HOSTPORT * MOVE 'X' TO #NATSVPARM-TRACE ELSE /* MF-PRD MOVE '26322' TO #HPORT #HOSTPORT END-IF MOVE 20 TO #DBCLOSE /* set dbid to send close to CALL 'N2CLOSE' #DBCLOSE #RETC /* CLOSE CMD empties UQE 7/21/95 MOVE 10 TO #DBCLOSE /* set dbid to send close to CALL 'N2CLOSE' #DBCLOSE #RETC /* CLOSE CMD empties UQE 7/21/95 MOVE ' ' TO #CTYPE /* do a listen CALL 'NATSVAL' #HPORT #TPORT #IPADDR #CTYPE #SCRIPT(*) * MOVE *DATN TO #DATN MOVE *TIMN TO #TIMN MOVE #IPADDR-B(1) TO #XIP1 /* for U of D 128 MOVE #IPADDR-B(2) TO #XIP2 /* for U of D 175 MOVE #IPADDR-B(3) TO #XIP3 /* subnet MOVE #IPADDR-B(4) TO #XIP4 /* machine ID on the subnet ******** FOR DEBUG ************************************************ WRITE #HPORT (EM=H(4)) #TPORT (EM=H(2)) #IPADDR (EM=H(4)) #CTYPE WRITE #LINE(1) (AL=78) * WRITE #LINE(1) (EM=H(38)) ******************************************************************* * * IF #HTTP-GET = 'GET /' /* requesting file/form MOVE #HTTP-GETP TO #PROGRAMN MOVE #HTTP-GETPRM TO #DATAPARM ELSE IF #HTTP-POST = 'POST /' /* returning form answers MOVE #HTTP-POSTP TO #PROGRAMN MOVE #HTTP-POSTPRM TO #DATAPARM ELSE IF #HTTP-TYP = '0http:' /* html from a GOPHER menu ?? MOVE #HTTP-PROGNM TO #PROGRAMN MOVE #HHTP-DATAIN TO #DATAPARM ELSE /* old GOPHER stuff MOVE #PROGNM TO #PROGRAMN MOVE #DATAIN TO #DATAPARM END-IF END-IF END-IF *********** debugging print WRITE(1) 'MFN0000' #XIP1A '.' #XIP2A '.' #XIP3A '.' #XIP4A ' :' #XTPORT ' ' #DATN-A #TIMN-A *********** logging ?? * WRITE(2) 'MFN0000' #XIP1A '.' #XIP2A '.' #XIP3A '.' #XIP4A ' :' * #XTPORT ' ' #DATN-A #TIMN-A ************ *** look for { xxxx } before 1st #CR if forwarded by bluecrab ************ IF #IPADDR = H'80AF3C5B' /* 128.175.60.91 bluecrab MOVE 14 TO #I /* point past 'xxxx /MFx#### ' MOVE 1 TO #J RESET #FWDFROM REPEAT UNTIL #I > 1000 /* normally 200 would be plenty ADD 1 TO #I IF #SCRIPT(#I) = #NULL /* end of all data ESCAPE BOTTOM END-IF IF #SCRIPT(#I) = #CR /* end of pre MIME header stuff ESCAPE BOTTOM END-IF IF #SCRIPT(#I) NE '{' AND #J = 1 /* start of msg = { ESCAPE TOP END-IF MOVE #SCRIPT(#I) TO #FWD(#J) IF #J GT 109 /* max 110 chars to be printed ESCAPE BOTTOM END-IF ADD 1 TO #J /* receiver field pointer END-REPEAT IF #J > 1 * WRITE(2) 'forwarded from ' #FWDFROM WRITE(1) 'forwarded from ' #FWDFROM /* debugging only END-IF END-IF ************ IF #PROGNM = 'SIQUITS' AND #IPADDR = H'80AF3C41' /* 128.175.60.65 Bruce OR = H'80AF3C1D' /* 128.175.60.29 John OR = H'80AF3C2E' /* 128.175.60.46 LOBSTER.MIS OR = H'80AF0D39' /* 128.175.13.57 PAD.NSS OR = H'80AF0D18' /* 128.175.13.24 MVS INPUT (AD=O) 'RC=0 STOP COMMAND ISSUED' * RESET #SCRIPT(*) MOVE 'OK - TERMINATING SERVER' TO #LTEXT(5) MOVE #CRLF TO #NEWLINE(5) MOVE #EOM TO #LTEXT(6) /* . PLUS NULL MOVE ALL #NULL TO #LTEXT(7) /* . PLUS NULL MOVE 'L' TO #CTYPE /* DEFAULT ONE PASS BACK CALL 'NATSVAL' #HPORT #TPORT #IPADDR #CTYPE #SCRIP01 * RESET #SCRIPT(*) MOVE 'C' TO #CTYPE /* close master server CALL 'NATSVAL' #HPORT #TPORT #IPADDR #CTYPE #SCRIP01 * TERMINATE /* TERMINATE THE ENDLESS LOOP END-IF ************ 2/2/95 IF #PROGNM = 'SIALIVE' /* hang off the gopher stay alive loop READ (1) SISSATTB END-READ READ (1) CT-VIEW END-READ * RESET #SCRIP01 MOVE 'L' TO #CTYPE /* 5/23/95 send ok and close COMPRESS 'OK' #CRLF #EOM INTO #SCRIP01 LEAVING NO SPACE CALL 'NATSVAL' #HPORT #TPORT #IPADDR #CTYPE #SCRIP01 ESCAPE TOP /* loop to the top and hang a listen * END-IF **************** IF #PROGNM = 'SIERROR' AND #CTYPE = 'N' /* NON-FATAL ERROR INPUT (AD=O) / 'WARNING NON-FATAL ERROR' / *PROGRAM (IP=OFF) '=' #HPORT '=' #TPORT (EM=HH) '=' #IPADDR (EM=HHHH) '=' #CTYPE #DATN (IP=OFF) #TIMN (IP=OFF) / *PROGRAM (IP=OFF) '=' #TYP '=' /* #PROGNM '=' #PARMIN ESCAPE TOP END-IF * IF #PROGNM = 'SIERROR' OR #IPADDR = ' ' INPUT (AD=O) 'RC=8 ERROR ENCOUNTERED - TERMINATING' #IPADDR INPUT (AD=O) / *PROGRAM (IP=OFF) '=' #HPORT '=' #TPORT (EM=HH) '=' #IPADDR (EM=HHHH) '=' #CTYPE #DATN (IP=OFF) #TIMN (IP=OFF) / *PROGRAM (IP=OFF) '=' #TYP '=' /* #PROGNM '=' #PARMIN / #LTEXT(1) / #LTEXT(2) / #LTEXT(3) TERMINATE 8 END-IF * ********** check for existance of requested item and call it * IF #MFUTYPE = 'MFU' OR = 'mfu' MOVE 'MFU' TO #MFUTYPE /* help prevent nat 0082 errs * REPEAT UNTIL #SUBPFOUND EQ 1 /* 3/16/95 no repeat loop MOVE #PROGRAMN TO #SUBPNAME MOVE 0 TO #SUBPFOUND CALLNAT 'MFN9999' #SUBPNAME #SUBPFOUND /* ? req object exists ? * IF #SUBPFOUND NE 9 /* on a 3009 just retry * ESCAPE BOTTOM /* otherwise kick out * END-IF * END-REPEAT IF #SUBPFOUND EQ 0 /* not found in this library MOVE 'L' TO #CTYPE /* response send and close 3/14/95 MOVE ' REQUESTED ITEM IS NOT PRESENT ' TO #LTEXT(1) COMPRESS #LTEXT(1) ' ' #PROGRAMN INTO #LTEXT(1) COMPRESS #CRLF #EOM INTO #LTEXT(2) LEAVING NO SPACE ELSE /* replace with validate routine .. later .. CALLNAT #PROGRAMN #SCRIPT(*) #DATAPARM #NATSVP END-IF ELSE MOVE 'ich nicht vorstaten .. sprechen sie MOSAIC' TO #LTEXT(1) COMPRESS #LTEXT(1) ' ' #PROGRAMN INTO #LTEXT(1) COMPRESS #CRLF #EOM INTO #LTEXT(2) LEAVING NO SPACE END-IF ** MOVE ' INVALID PROGRAM NAME PREFIX ' TO #LTEXT(1) ** COMPRESS #CRLF #EOM INTO #LTEXT(2) LEAVING NO SPACE MOVE 'L' TO #CTYPE /* FORCE a L type call here 7/26/95 CALL 'NATSVAL' #HPORT #TPORT #IPADDR #CTYPE #SCRIP01 END-REPEAT STOP *********************************************************************** ON ERROR MOVE *DATN TO #DATN MOVE *TIMN TO #TIMN WRITE '*'(55) #DATN-A #TIMN-A / *APPLIC-ID *PROGRAM ' ERROR:' *ERROR ' AT:' *ERROR-LINE '=' #TYP '=' #PROGRAMN * MOVE #TYP TO #ERROR-TYPE MOVE #PROGRAMN TO #ERROR-PROGRAM * RESET #SCRIPT(*) * * WRITE '=' #ERROR-TYPE '=' #HOST '=' #HOSTPORT * / '=' #HOST (EM=H(20)) '=' #HOSTPORT (EM=H(5)) **IF #ERROR-TYPE = '0' /* FILE MOVE #CRLF TO #NEWLINE(1) IF *ERROR = 82 COMPRESS 'A NON-EXISTANT PROGRAM WAS CALLED:' #ERROR-PROGRAM INTO #LTEXT(5) ** MOVE 'L' TO #CTYPE /* DEFAULT ONE PASS BACK ** CALL 'NATSVAL' #HPORT #TPORT #IPADDR #CTYPE #SCRIP01 ** MOVE 'C' TO #CTYPE /* close master server ** CALL 'NATSVAL' #HPORT #TPORT #IPADDR #CTYPE #SCRIP01 ** STACK TOP 'MFN0000' ** STOP ** FETCH 'MFN0001' /* sleep 3 minutes then fetch MFN0000 ELSE IF *ERROR = 932 /* version change COMPRESS 'The version of program:' #ERROR-PROGRAM 'has changed' '...backout and try again.' INTO #LTEXT(5) ELSE IF *ERROR = 3148 MOVE 'THE ADABAS DATABASE IS CURRENTLY NOT ACTIVE' TO #LTEXT(5) ELSE COMPRESS 'AN ERROR HAS OCCURED IN:' *APPLIC-ID ',' #ERROR-PROGRAM ' ERROR:' *ERROR ' AT:' *ERROR-LINE INTO #LTEXT(5) LEAVING NO SPACE END-IF END-IF END-IF MOVE #CRLF TO #NEWLINE(5) MOVE #EOM TO #LTEXT(6) /* . PLUS NULL **END-IF * MOVE 'L' TO #CTYPE /* DEFAULT ONE PASS BACK CALL 'NATSVAL' #HPORT #TPORT #IPADDR #CTYPE #SCRIP01 * **IF NOT( *ERROR = 82 OR = 932 ) MOVE 'C' TO #CTYPE /* close master server CALL 'NATSVAL' #HPORT #TPORT #IPADDR #CTYPE #SCRIP01 TERMINATE 4 **ELSE ** FETCH 'MFN0000' #HOSTPORT **END-IF * END-ERROR *************** END