PROGRAM XRB C----------------------------------------------------------------------* C PROGRAM: XRB * C----------------------------------------------------------------------* C LANGUAGE: VAX-11 FORTRAN V2.4 * C SYSTEM: VAX-11/780 VAX/VMS V2.4 * C MOSTEK CORPORATION * C COMPUTER AIDS TO DESIGN DEPARTMENT * C 1215 WEST CROSBY ROAD * C CARROLLTON, TEXAS 75006 * C (214) 323-8813 * C----------------------------------------------------------------------* C PROGRAMMER: KEVIN KLUGHART * C----------------------------------------------------------------------* C DATE: 04-30-82 @ 13:00 CDST * C----------------------------------------------------------------------* C PURPOSE: THIS PROGRAM IS DESIGNED AS A NON-PRIVILEGED * C UTILITY TO ENABLE ORDINARY USERS TO QUEUE FILES * C FOR SUBMISSION ON ONE NODE ON THE DECNET NETWORK * C TO A REMOTE CDC HOST. IN ADDITION TO THIS ABILITY * C THE USER IS CAPABLE OF ENTERING A DIALOGUE WITH * C THE REMOTE HOST AS A WORKSTATION CONSOLE. THIS * C CAPABILITY IS PROVIDED THROUGH A LOCAL LINK TO * C THE REMOTE SERVER NODE. THIS PROGRAM REQUIRES THE * C NETMBX AND TMPMBX PRIVILEGES FOR PROPER OPERATION. * C----------------------------------------------------------------------* C NOTES: DEFINE THE FOLLOWING SYMBOL IN THE SYSTEM USER * C LOGIN COMMAND PROCEDURE: * C * C $ XRB :== $XRB * C * C THIS WILL ENABLE USER SYNTAX OF THE FORM: * C * C $ XRB command [cmd-data] [/HOST=host] * C * C WHERE host IS THE REMOTE HOST TO WHICH THE FILE * C IS TO BE SUBMITTED, filespec IS THE FILE TO BE * C SUBMITTED. NO QUALIFIERS ARE ALLOWED. EXAMPLE: * C * C $ XRB SUBMIT TEST.RJE /HOST=203 * C * C THE ABOVE COMMAND LINE QUEUES THE FILE TEST.RJE * C FOR SUBMISSION TO REMOTE HOST "203". * C----------------------------------------------------------------------* C COMMANDS: VALID COMMANDS ARE AS FOLLOWS: * C * C TALK /HOST=host - Enter dialogue mode with * C remote host * C * C SUBMIT filespec - Submit file to remote host * C /DELETE - delete job deck * C /HOST=host - specify remote host * C /ROUTE - route file back to user disk * C /SPOOL - spool file on server node * C----------------------------------------------------------------------* C EXTERNALS: STRING LIBRARY * C----------------------------------------------------------------------* C PARAMETERS * C----------------------------------------------------------------------* PARAMETER BATCH_UNIT = 1 ! REMOTE BATCH FILE UNIT PARAMETER BLANK = ' ' ! DEFINE SPACE CHARACTER PARAMETER BYTCNT = 2 ! I/O STATUS BLOCK BYTE CNT PARAMETER COMMA = ',' ! UIC SEPARATOR PARAMETER DELETE_SWITCH = '/DELETE' ! DELETE JOB DECK PARAMETER FIVE = 5 ! USEFUL CONSTANT PARAMETER FOUR = 4 ! USEFUL CONSTANT PARAMETER FULL = '0000000F'X ! FULL MESSAGE DISPLAY PARAMETER HOST_PREFIX = 'XRB$' ! SERVER NODE PREFIX PARAMETER HOST_DEFAULT = 'HOST' ! DEFAULT HOST ID NAME PARAMETER HOST_SWITCH = '/HOST=' ! HOST ID PARAMETER PARAMETER IOSTAT = 1 ! I/O STATUS BLOCK STATUS PARAMETER LEFT = '[' ! LEFT BRACKET (DIRECTORY) PARAMETER LOCAL_NODE = 'SYS$NODE' ! DEFINED IF DECNET RUNNING PARAMETER MAX = 255 ! MAXIMUM INPUT RECORD PARAMETER NETNOD = '::' ! INDICATES NETWORK NODE PARAMETER ONE = 1 ! USEFUL CONSTANT PARAMETER PERIOD = '.' ! FILE EXTENSION DELIMITER PARAMETER PRINTER = 'LP:' ! LIST FILE OUTPUT DEFAULT PARAMETER PROMPT = '> ' ! HOST TALK PROMPT PARAMETER RIGHT = ']' ! RIGHT BRACKET (DIRECTORY) PARAMETER RJE_MSG_TASK = '"TASK=RJEMSG"'! RJE MESSAGE TASK NAME PARAMETER RJE_UIC = '[200,140]' ! BATCH INPUT UIC PARAMETER ROUTE = -1 ! ROUTE FLAG OFFSET PARAMETER ROUTE_EXTENSION = 'RJO' ! ROUTE FILE EXTENSION PARAMETER ROUTE_SWITCH = '/ROUTE' ! ROUTE FILE BACK TO USER PARAMETER SEMICOLON = ';' ! SEMICOLON (VERSION) PARAMETER SPOOL = -2 ! SPOOL FLAG OFFSET PARAMETER SPOOL_FLAG = '*' ! INDICATES SPOOLED LIST FILE PARAMETER SPOOL_SWITCH = '/SPOOL' ! SPOOL LISTING PARAMETER THREE = 3 ! USEFUL CONSTANT PARAMETER TWO = 2 ! USEFUL CONSTANT PARAMETER WID = 080 ! MAXIMUM NAME LENGTH PARAMETER ZERO = 0 ! USEFUL CONSTANT C----------------------------------------------------------------------* C STATUS DEFINITIONS * C----------------------------------------------------------------------* C QIO FUNCTION CODES * C----------------------------------------------------------------------* EXTERNAL IO$_READVBLK EXTERNAL IO$_WRITEVBLK C----------------------------------------------------------------------* C JPI JOB PROCESS INFORMATION PARAMETERS * C----------------------------------------------------------------------* EXTERNAL JPI$_UIC EXTERNAL JPI$_USERNAME C----------------------------------------------------------------------* C RMS STATUS CODES * C----------------------------------------------------------------------* EXTERNAL RMS$_EOF EXTERNAL RMS$_FNF EXTERNAL RMS$_NMF EXTERNAL RMS$_NORMAL C----------------------------------------------------------------------* C SYSTEM SERVICES STATUS CODES * C----------------------------------------------------------------------* EXTERNAL SS$_NORMAL EXTERNAL SS$_REMOTE C----------------------------------------------------------------------* C CHARACTER * C----------------------------------------------------------------------* CHARACTER*(MAX) BATCH_FILE CHARACTER*(MAX) ERRMSG CHARACTER*(MAX) FILE CHARACTER*(MAX) HOST CHARACTER*(MAX) LINE CHARACTER*(MAX) LIST CHARACTER*(WID) NODE CHARACTER*(WID) SERVER CHARACTER*(MAX) STRING CHARACTER*(WID) USER CHARACTER*(WID) VUIC C----------------------------------------------------------------------* C INTEGER*2 * C----------------------------------------------------------------------* INTEGER*2 IO_STATUS (FOUR) INTEGER*2 MSG_STATUS (FOUR) INTEGER*2 UICVAL (TWO) C----------------------------------------------------------------------* C INTEGER*4 * C----------------------------------------------------------------------* INTEGER*4 BATLEN INTEGER*4 ERRLEN INTEGER*4 FILLEN INTEGER*4 FIRST INTEGER*4 HSTLEN INTEGER*4 IO$_READVBLK INTEGER*4 IO$_WRITEVBLK INTEGER*4 JPI$_UIC INTEGER*4 JPI$_USERNAME INTEGER*4 LENGTH INTEGER*4 LIB$DO_COMMAND INTEGER*4 LIB$GET_FOREIGN INTEGER*4 LIB$GET_INPUT INTEGER*4 LIB$PUT_OUTPUT INTEGER*4 LIMIT INTEGER*4 LINLEN INTEGER*4 LSTFLG INTEGER*4 LSTLEN INTEGER*4 MSG_CHANNEL INTEGER*4 MSG_DESCRIPTOR (TWO) INTEGER*4 MSGLEN INTEGER*4 NODLEN INTEGER*4 POINTER INTEGER*4 RMS$_EOF INTEGER*4 RMS$_FNF INTEGER*4 RMS$_NMF INTEGER*4 RMS$_NORMAL INTEGER*4 RMS$PARSE INTEGER*4 RMS$SEARCH INTEGER*4 SRVLEN INTEGER*4 SS$_NORMAL INTEGER*4 SS$_REMOTE INTEGER*4 STATUS INTEGER*4 SYS$ASSIGN INTEGER*4 SYS$DASSGN INTEGER*4 SYS$GETMSG INTEGER*4 SYS$JPI INTEGER*4 SYS$QIOW INTEGER*4 SYS$TRNLOG INTEGER*4 UICGRP INTEGER*4 UICLEN INTEGER*4 UICMEM INTEGER*4 USRLEN C----------------------------------------------------------------------* C LOGICAL * C----------------------------------------------------------------------* LOGICAL*4 DELETE_FLAG LOGICAL*1 MSG_BUFFER (MAX) C----------------------------------------------------------------------* C * C NETWORK MESSAGE COMMON BLOCK * C * C----------------------------------------------------------------------* COMMON / NETMSG / MSG_BUFFER COMMON / NETMSG / MSG_CHANNEL COMMON / NETMSG / MSG_DESCRIPTOR COMMON / NETMSG / MSG_STATUS C----------------------------------------------------------------------* C SECTION 000 * C----------------------------------------------------------------------* C * C INITIALIZATION * C * C----------------------------------------------------------------------* C DETERMINE LOCAL NODE NAME AND ABORT IF NETWORK IS DOWN * C----------------------------------------------------------------------* STATUS=SYS$TRNLOG(LOCAL_NODE,NODLEN,NODE,,,) IF (STATUS .NE. %LOC(SS$_NORMAL)) GO TO 800 CALL DELETE_CONTROL(NODE) NODLEN=LENGTH(NODE) C----------------------------------------------------------------------* C DETERMINE DEFAULT HOST NAME * C----------------------------------------------------------------------* STATUS=SYS$TRNLOG(HOST_PREFIX//HOST_DEFAULT,HSTLEN,HOST,,,) IF (STATUS .NE. %LOC(SS$_NORMAL)) GO TO 800 CALL DELETE_CONTROL(HOST) HSTLEN=LENGTH(HOST) C----------------------------------------------------------------------* C DETERMINE USER IDENTIFICATION (ALPHANUMERIC USERNAME) * C----------------------------------------------------------------------* STATUS=SYS$JPI(,,%LOC(JPI$_USERNAME),USER,USRLEN) IF (STATUS .NE. %LOC(SS$_NORMAL)) GO TO 800 CALL DELETE_CONTROL(USER) USRLEN=LENGTH(USER) C----------------------------------------------------------------------* C DETERMINE USER IDENTIFICATION (LONGWORD UIC) * C----------------------------------------------------------------------* STATUS=SYS$JPI(,,%LOC(JPI$_UIC),UICVAL,) IF (STATUS .NE. %LOC(SS$_NORMAL)) GO TO 800 UICMEM=UICVAL(ONE) UICGRP=UICVAL(TWO) CALL OCTFMT(UICGRP,VUIC,THREE) CALL OCTFMT(UICMEM,STRING,THREE) VUIC=LEFT//VUIC(ONE:THREE)//COMMA//STRING(ONE:THREE)//RIGHT UICLEN=LENGTH(VUIC) C----------------------------------------------------------------------* C CREATE REMOTE BATCH FILENAME * C----------------------------------------------------------------------* C FILENAME IS OF THE FORM: USERNAME.NOD * C----------------------------------------------------------------------* POINTER=USRLEN IF (POINTER .GT. 9) POINTER=9 BATCH_FILE=USER(ONE:POINTER)//'.'//NODE((NODLEN-4):(NODLEN-2)) BATLEN=LENGTH(BATCH_FILE) C----------------------------------------------------------------------* C SECTION 100 * C----------------------------------------------------------------------* C * C REQUEST COMMAND LINE OF FORM: $XRB command cmd-data [/HOST=host]* C * C----------------------------------------------------------------------* C ENTER SUBSYSTEM COMMAND * C----------------------------------------------------------------------* 100 CONTINUE STATUS=LIB$GET_FOREIGN(LINE,' Type HELP for assistance: ',LINLEN) IF (STATUS .EQ. %LOC(RMS$_EOF)) GO TO 900 IF (STATUS .NE. %LOC(SS$_NORMAL)) GO TO 800 CALL DELETE_CONTROL(LINE) CALL UPPER_CASE(LINE) LINLEN=LENGTH(LINE) IF (LINLEN .EQ. ZERO) GO TO 100 C----------------------------------------------------------------------* C PARSE OUT REMOTE HOST NAME IF USER HAS OVERRIDDEN DEFAULT * C----------------------------------------------------------------------* POINTER=INDEX(LINE,HOST_SWITCH) IF (POINTER .EQ. ZERO) GO TO 110 STRING=LINE(POINTER:) CALL GET_WORD(STRING,HOST) HSTLEN=LENGTH(HOST) IF (HSTLEN .EQ. LEN(HOST_SWITCH)) GO TO 840 LINE(POINTER:)=LINE((POINTER+HSTLEN):) HOST=HOST((LEN(HOST_SWITCH)+ONE):) HSTLEN=LENGTH(HOST) C----------------------------------------------------------------------* C TRANSLATE LOGICAL HOST NAME TO PHYSICAL SERVER NODE * C----------------------------------------------------------------------* 110 CONTINUE STATUS=SYS$TRNLOG(HOST_PREFIX//HOST(ONE:HSTLEN),SRVLEN,SERVER,,,) IF (STATUS .NE. %LOC(SS$_NORMAL)) GO TO 800 CALL DELETE_CONTROL(SERVER) SRVLEN=LENGTH(SERVER) C----------------------------------------------------------------------* C * C * C HELP COMMAND - SUPPLY OPERATIONAL HELP ON USE OF XRB * C * C * C----------------------------------------------------------------------* C CLEAR SCREEN AND DISPLAY HELP PAGE * C----------------------------------------------------------------------* 200 CONTINUE IF (LINE(ONE:THREE) .NE. 'HEL') GO TO 300 PRINT 2000 GO TO 900 C----------------------------------------------------------------------* C SECTION 300 * C----------------------------------------------------------------------* C * C * C SUBMIT COMMAND - SUBMIT FILE TO REMOTE HOST * C * C * C----------------------------------------------------------------------* C CHECK FOR PROPER COMMAND * C----------------------------------------------------------------------* 300 CONTINUE IF (LINE(ONE:THREE) .NE. 'SUB') GO TO 400 C----------------------------------------------------------------------* C PARSE JOB DELETION SWITCH IF USER HAS ENABLED JOB DELETION * C----------------------------------------------------------------------* POINTER=INDEX(LINE,DELETE_SWITCH) IF (POINTER .EQ. ZERO) THEN DELETE_FLAG=.FALSE. ELSE DELETE_FLAG=.TRUE. LINE(POINTER:)=LINE((POINTER+LEN(DELETE_SWITCH)):) ENDIF C----------------------------------------------------------------------* C PARSE ROUTING SWITCH IF USER HAS ENABLED ROUTEBACK * C----------------------------------------------------------------------* LSTFLG=ZERO POINTER=INDEX(LINE,ROUTE_SWITCH) IF (POINTER .EQ. ZERO) GO TO 310 LSTFLG=ROUTE ! ENABLE ROUTEBACK FLAG LINE(POINTER:)=LINE((POINTER+LEN(ROUTE_SWITCH)):) C----------------------------------------------------------------------* C PARSE SPOOL SWITCH IF USER HAS ENABLED LOCAL FILE SPOOLING * C----------------------------------------------------------------------* 310 CONTINUE POINTER=INDEX(LINE,SPOOL_SWITCH) IF (POINTER .EQ. ZERO) GO TO 320 LSTFLG=SPOOL ! ENABLE SPOOL FLAG LINE(POINTER:)=LINE((POINTER+LEN(SPOOL_SWITCH)):) C----------------------------------------------------------------------* C NOW PARSE OUT FILE SPECIFICATION * C----------------------------------------------------------------------* 320 CONTINUE CALL GET_WORD(LINE,FILE) CALL GET_WORD(LINE,FILE) FILLEN=LENGTH(FILE) STATUS=%LOC(RMS$_FNF) IF (FILLEN .EQ. ZERO) GO TO 800 C----------------------------------------------------------------------* C PARSE THE FILE SPECIFICATION IN PREPARATION FOR WILDCARD SEARCH * C----------------------------------------------------------------------* STATUS=RMS$PARSE(FILE(ONE:FILLEN)) IF (STATUS .NE. %LOC(RMS$_NORMAL)) GO TO 800 C----------------------------------------------------------------------* C SEARCH FOR FIRST FILE SPECIFICATION IN WILDCARD SEARCH * C----------------------------------------------------------------------* STATUS=RMS$SEARCH(FILE) FILLEN=LENGTH(FILE) CALL LIB$PUT_OUTPUT(BLANK) CALL LIB$PUT_OUTPUT(' Submit via server node '// 1 SERVER(ONE:SRVLEN)//' to host '//HOST(ONE:HSTLEN)) CALL LIB$PUT_OUTPUT(' File '//FILE(ONE:FILLEN)// 1 ' on node '//NODE(ONE:NODLEN)) IF (STATUS .NE. %LOC(RMS$_NORMAL)) GO TO 800 C----------------------------------------------------------------------* C CONSTRUCT ROUTEBACK LISTING FILE NAME * C----------------------------------------------------------------------* IF (LSTFLG .EQ. ZERO) GO TO 350 LIST=PRINTER LSTLEN=LENGTH(LIST) POINTER=INDEX(FILE,RIGHT) IF (POINTER .LE. ZERO) GO TO 350 LSTLEN=POINTER+INDEX(FILE(POINTER:),PERIOD)-ONE LIST=FILE(ONE:LSTLEN)//ROUTE_EXTENSION LSTLEN=LENGTH(LIST) IF (LSTFLG .EQ. SPOOL) LIST(ONE:ONE)=SPOOL_FLAG C----------------------------------------------------------------------* C SECTION 350 * C----------------------------------------------------------------------* C * C OPEN BATCH COMMAND FILE ON REMOTE HOST * C * C----------------------------------------------------------------------* C OPEN FILE WITH LIST CARRIAGE CONTROL * C----------------------------------------------------------------------* 350 CONTINUE OPEN (UNIT=BATCH_UNIT, 1 NAME=HOST_PREFIX//HOST(ONE:HSTLEN)//NETNOD//RJE_UIC// 2 BATCH_FILE(ONE:BATLEN), 3 CARRIAGECONTROL='LIST',TYPE='NEW',ERR=820) INQUIRE (UNIT=BATCH_UNIT,NAME=BATCH_FILE) CALL DELETE_CONTROL(BATCH_FILE) BATLEN=LENGTH(BATCH_FILE) C----------------------------------------------------------------------* C BUILD REMOTE RJE BATCH COMMAND PROCEDURE * C----------------------------------------------------------------------* WRITE (BATCH_UNIT,3000) '.ENABLE GLOBAL' WRITE (BATCH_UNIT,3000) '.ENABLE QUIET' WRITE (BATCH_UNIT,3000) '.ENABLE SUBSTITUTION' WRITE (BATCH_UNIT,3000) '.SETS $USER "'//USER(ONE:USRLEN)//'"' WRITE (BATCH_UNIT,3000) '.SETS $VUIC "'//VUIC(ONE:UICLEN)//'"' WRITE (BATCH_UNIT,3000) '.SETS $HOST "'//HOST(ONE:HSTLEN)//'"' WRITE (BATCH_UNIT,3000) '.SETS $NODE "'//NODE(ONE:NODLEN)//'"' WRITE (BATCH_UNIT,3000) '.SETS $FILE "'//FILE(ONE:FILLEN)//'"' IF (LSTFLG .NE. ZERO) WRITE (BATCH_UNIT,3000) 1 '.SETS $LIST "'//LIST(ONE:LSTLEN)//'"' IF (DELETE_FLAG) WRITE (BATCH_UNIT,3000) '.SETT $KILL' WRITE (BATCH_UNIT,3000) '@LB:'//RJE_UIC//'XRB' C----------------------------------------------------------------------* C CLOSE REMOTE BATCH COMMAND FILE AND REPORT QUEUE REQUEST TO USER * C----------------------------------------------------------------------* CLOSE (UNIT=BATCH_UNIT) CALL LIB$PUT_OUTPUT(BLANK) CALL LIB$PUT_OUTPUT(' Job '//BATCH_FILE(ONE:BATLEN)// 1 ' queued to server node') C----------------------------------------------------------------------* C SUBMIT THE REMOTE BATCH COMMAND PROCEDURE * C----------------------------------------------------------------------* STATUS=LIB$DO_COMMAND('$SUBMIT '//BATCH_FILE(ONE:BATLEN)// 1 ' /REMOTE') GO TO 800 C----------------------------------------------------------------------* C SECTION 400 * C----------------------------------------------------------------------* C * C * C TALK COMMAND: LINK TO REMOTE HOST AND ENTER TALK MODE * C * C * C----------------------------------------------------------------------* C CHECK FOR VALID COMMAND * C----------------------------------------------------------------------* 400 CONTINUE IF (LINE(ONE:THREE) .NE. 'TAL') GO TO 830 C----------------------------------------------------------------------* C OPEN DECNET COMMUNICATIONS CHANNEL TO REMOTE RSX SERVER NODE * C----------------------------------------------------------------------* STATUS=SYS$ASSIGN(SERVER(ONE:SRVLEN)//RJE_MSG_TASK, 1 MSG_CHANNEL,,) IF (STATUS .NE. %LOC(SS$_REMOTE)) GOTO 850 C----------------------------------------------------------------------* C PRIME RJE NETWORK MESSAGE READ PROCESSOR * C----------------------------------------------------------------------* C ISSUE INITIAL NETWORK READ TO GET MESSAGES FROM THE REMOTE SERVER* C----------------------------------------------------------------------* CALL XRB_GET_MSG C----------------------------------------------------------------------* C GET USER COMMAND AND TRANSMIT IT TO THE REMOTE RSX SERVER NODE * C----------------------------------------------------------------------* 410 CONTINUE STATUS=LIB$GET_INPUT(LINE,HOST(ONE:HSTLEN)//PROMPT,LINLEN) IF ((STATUS .NE. %LOC(SS$_NORMAL)) .AND. 1 (STATUS .NE. %LOC(RMS$_EOF))) GO TO 800 CALL UPPER_CASE(LINE) C----------------------------------------------------------------------* C IF COMMAND LENGTH IS ZERO OR USER HAS REQUESTED EXIT THEN QUIT * C----------------------------------------------------------------------* IF ((LINLEN .NE. ZERO) .AND. (INDEX(LINE,'EXI') .EQ. ZERO)) 1 GO TO 420 STATUS=SYS$DASSGN(%VAL(MSG_CHANNEL)) IF (STATUS .NE. %LOC(SS$_NORMAL)) GO TO 800 GO TO 900 C----------------------------------------------------------------------* C TRANSMIT MESSAGE TO REMOTE RSX SERVER NODE (MESSAGE PROCESSOR) * C----------------------------------------------------------------------* 420 CONTINUE STATUS=SYS$QIOW(,%VAL(MSG_CHANNEL), 1 %VAL(%LOC(IO$_WRITEVBLK)),IO_STATUS,,, 2 %REF(LINE),%VAL(LENGTH(LINE)),,,,) IF (STATUS .NE. %LOC(SS$_NORMAL)) GO TO 850 STATUS=IO_STATUS(IOSTAT) IF (STATUS .EQ. %LOC(SS$_NORMAL)) GO TO 410 GO TO 850 C----------------------------------------------------------------------* C SECTION 800 * C----------------------------------------------------------------------* C ERROR TRAP: DISPLAY SYSTEM ERROR MESSAGE AND ABORT EXECUTION * C----------------------------------------------------------------------* 800 CONTINUE CALL LIB$PUT_OUTPUT(' *** Fatal Error Encountered ***') 810 CONTINUE CALL SYS$GETMSG(%VAL(STATUS),MSGLEN,ERRMSG,%VAL(FULL),) CALL LIB$PUT_OUTPUT(BLANK//BLANK//ERRMSG(ONE:MSGLEN)) GO TO 900 C----------------------------------------------------------------------* C ERROR TRAP: PREPROCESS FILE ACCESS ERRORS * C----------------------------------------------------------------------* 820 CONTINUE CALL LIB$PUT_OUTPUT(' *** Fatal File Error Encountered ***') CALL ERRSNS(,STATUS,,,) GO TO 810 C----------------------------------------------------------------------* C ERROR TRAP: INVALID SUBSYSTEM COMMAND * C----------------------------------------------------------------------* 830 CONTINUE CALL LIB$PUT_OUTPUT(' *** Invalid subsystem command ***') GO TO 900 C----------------------------------------------------------------------* C ERROR TRAP: COMMAND SYNTAX ERROR * C----------------------------------------------------------------------* 840 CONTINUE CALL LIB$PUT_OUTPUT(' *** Command syntax error ***') GO TO 900 C----------------------------------------------------------------------* C ERROR TRAP: REMOTE SERVER MESSAGE LOGICAL LINK ERROR * C----------------------------------------------------------------------* 850 CONTINUE CALL LIB$PUT_OUTPUT(' *** DECNET Network I/O error ***') GO TO 810 C----------------------------------------------------------------------* C SECTION 900 * C----------------------------------------------------------------------* C PROGRAM TERMINATION * C----------------------------------------------------------------------* 900 CONTINUE C----------------------------------------------------------------------* C FORMATS * C----------------------------------------------------------------------* 2000 FORMAT('0 XRB - Extended Remote Batch Subsystem V01.04'/// 1 ' The XRB subsystem has the following commands:'// 2 ' 1. XRB HELp'/ 3 ' Types this display'// 2 ' 2. XRB SUBmit filespec [/DELETE] [/HOST=host]'/ 3 ' [/ROUTE] [/SPOOL]'/ 4 ' Where FILESPEC is any single file specification'/ 5 ' and HOST is the remote host to which the job is to'/ 6 ' be directed. Current valid host names are 7600 and'/ 7 ' 203. If the HOST parameter is omitted, the logical'/ 8 ' name XRB$HOST is searched to determine the default'/ 9 ' remote host to be used. In this manner, each user'/ A ' may define the default remote host to which his'/ 1 ' job decks will be transmitted. To locally define'/ 2 ' this symbol, use the following DCL command:'// 3 ' $ ASSIGN host XRB$HOST'// 4 ' The /DELETE switch forces deletion of the input job'/ 5 ' deck after submission to the remote host.'/ 6 ' The /ROUTE switch forces listing file output'/ 7 ' received from the remote host back to the user'/ 8 ' disk. The default is to have listing files printed'/ 9 ' on the local node system printer.'/ B ' The /SPOOL switch forces the listing file to be'/ 1 ' printed on the local server node as well as being'/ 2 ' routed back to the users directory.'// 3 ' 3. XRB TALK [/HOST=host]'/ 4 ' This command enables interactive RJE workstation'/ 5 ' commands to be directed to the selected remote host') 3000 FORMAT(A) C----------------------------------------------------------------------* C END OF MAIN PROGRAM XRB * C----------------------------------------------------------------------* END SUBROUTINE XRB_GET_MSG C----------------------------------------------------------------------* C SUBROUTINE: XRB_GET_MSG * C----------------------------------------------------------------------* C LANGUAGE: VAX-11 FORTRAN V2.4 * C SYSTEM: VAX-11/780 VAX/VMS V2.4 * C MOSTEK CORPORATION * C COMPUTER AIDS TO DESIGN DEPARTMENT * C 1215 WEST CROSBY ROAD * C CARROLLTON, TEXAS 75006 * C (214) 323-8813 * C----------------------------------------------------------------------* C PROGRAMMER: KEVIN KLUGHART * C----------------------------------------------------------------------* C DATE: 03-17-82 @ 09:00 CDST * C----------------------------------------------------------------------* C PURPOSE: THIS SUBROUTINE QUEUES A READ REQUEST FROM THE * C NETWORK SERVER MAILBOX. THIS MAILBOX IS THE * C LOGICAL LINK BETWEEN THE REMOTE SERVER NODE AND * C THE INTERACTIVE VAX USER COMMAND INTERFACE. * C----------------------------------------------------------------------* C----------------------------------------------------------------------* C SUBROUTINE PARAMETERS * C----------------------------------------------------------------------* PARAMETER BYTCNT = 2 ! I/O STATUS BLOCK BYTE CNT PARAMETER CRT = 'TT' ! USER TERMINAL NAME PARAMETER FULL = 'F'X ! FULL ERROR MESSAGES PARAMETER FOUR = 4 ! USEFUL CONSTANT PARAMETER IOSTAT = 1 ! I/O STATUS BLOCK STATUS PARAMETER MAX = 255 ! MAXIMUM INPUT RECORD PARAMETER ONE = 1 ! USEFUL CONSTANT PARAMETER TWO = 2 ! USEFUL CONSTANT PARAMETER ZERO = 0 ! USEFUL CONSTANT C----------------------------------------------------------------------* C STATUS DEFINITIONS * C----------------------------------------------------------------------* C QIO FUNCTION CODES * C----------------------------------------------------------------------* EXTERNAL IO$_READVBLK C----------------------------------------------------------------------* C SYSTEM SERVICE STATUS CODES * C----------------------------------------------------------------------* EXTERNAL SS$_NORMAL C----------------------------------------------------------------------* C EXTERNAL AST PROCESSING ROUTINES * C----------------------------------------------------------------------* EXTERNAL XRB_MSG_AST C----------------------------------------------------------------------* C CHARACTER * C----------------------------------------------------------------------* CHARACTER*(MAX) ERRMSG C----------------------------------------------------------------------* C INTEGER*2 * C----------------------------------------------------------------------* INTEGER*2 MSG_STATUS (FOUR) C----------------------------------------------------------------------* C INTEGER*4 * C----------------------------------------------------------------------* INTEGER*4 IO$_READVBLK INTEGER*4 MSG_CHANNEL INTEGER*4 MSG_DESCRIPTOR (TWO) INTEGER*4 MSGLEN INTEGER*4 SS$_NORMAL INTEGER*4 STATUS INTEGER*4 SYS$BRDCST INTEGER*4 SYS$GETMSG INTEGER*4 SYS$QIO C----------------------------------------------------------------------* C LOGICAL*1 * C----------------------------------------------------------------------* LOGICAL*1 MSG_BUFFER (MAX) C----------------------------------------------------------------------* C * C NETWORK MESSAGE COMMON BLOCK * C * C----------------------------------------------------------------------* COMMON / NETMSG / MSG_BUFFER COMMON / NETMSG / MSG_CHANNEL COMMON / NETMSG / MSG_DESCRIPTOR COMMON / NETMSG / MSG_STATUS C----------------------------------------------------------------------* C SECTION 100 * C----------------------------------------------------------------------* C REISSUE NETWORK MESSAGE READ REQUEST * C----------------------------------------------------------------------* 100 CONTINUE STATUS=SYS$QIO(,%VAL(MSG_CHANNEL), 1 %VAL(%LOC(IO$_READVBLK)),MSG_STATUS, 2 XRB_MSG_AST,, 3 MSG_BUFFER,%VAL(MAX),,,,) IF (STATUS .EQ. %LOC(SS$_NORMAL)) GO TO 900 C----------------------------------------------------------------------* C SECTION 800 * C----------------------------------------------------------------------* 800 CONTINUE CALL SYS$GETMSG(%VAL(STATUS),MSGLEN,ERRMSG,%VAL(FULL),) CALL SYS$BRDCST(ERRMSG(ONE:MSGLEN),CRT) C----------------------------------------------------------------------* C SECTION 900 * C----------------------------------------------------------------------* C SUBROUTINE TERMINATION * C----------------------------------------------------------------------* 900 CONTINUE C----------------------------------------------------------------------* C END OF SUBROUTINE XRB_GET_MSG * C----------------------------------------------------------------------* RETURN END SUBROUTINE XRB_MSG_AST C----------------------------------------------------------------------* C SUBROUTINE: XRB_MSG_AST * C----------------------------------------------------------------------* C LANGUAGE: VAX-11 FORTRAN V2.4 * C SYSTEM: VAX-11/780 VAX/VMS V2.4 * C MOSTEK CORPORATION * C COMPUTER AIDS TO DESIGN DEPARTMENT * C 1215 WEST CROSBY ROAD * C CARROLLTON, TEXAS 75006 * C (214) 323-8813 * C----------------------------------------------------------------------* C PROGRAMMER: KEVIN KLUGHART * C----------------------------------------------------------------------* C DATE: 03-17-82 @ 09:00 CDST * C----------------------------------------------------------------------* C PURPOSE: THIS SUBROUTINE ACTS AS THE RECEIVE HOST MESSAGE * C NETWORK AST WHICH GATHERS MESSAGES FROM THE XRB * C SERVER ON THE REMOTE RSX NODE. MESSAGES RECEIVED * C FROM THE REMOTE CDC HOST ARE ROUTED THROUGH THE * C SERVER NODE TO THIS AST AND THEN TO THE USER. * C----------------------------------------------------------------------* C----------------------------------------------------------------------* C AST PARAMETERS * C----------------------------------------------------------------------* PARAMETER BYTCNT = 2 ! I/O STATUS BLOCK BYTE CNT PARAMETER CRT = 'TT' ! USER TERMINAL PARAMETER FULL = 'F'X ! FULL ERROR MESSAGES PARAMETER FOUR = 4 ! USEFUL CONSTANT PARAMETER IOSTAT = 1 ! I/O STATUS BLOCK STATUS PARAMETER MAX = 255 ! MAXIMUM INPUT RECORD PARAMETER ONE = 1 ! USEFUL CONSTANT PARAMETER TWO = 2 ! USEFUL CONSTANT PARAMETER ZERO = 0 ! USEFUL CONSTANT C----------------------------------------------------------------------* C STATUS DEFINITIONS * C----------------------------------------------------------------------* C QIO FUNCTION CODES * C----------------------------------------------------------------------* EXTERNAL IO$_READVBLK C----------------------------------------------------------------------* C SYSTEM SERVICE STATUS CODES * C----------------------------------------------------------------------* EXTERNAL SS$_NORMAL C----------------------------------------------------------------------* C CHARACTER * C----------------------------------------------------------------------* CHARACTER*(MAX) ERRMSG C----------------------------------------------------------------------* C INTEGER*2 * C----------------------------------------------------------------------* INTEGER*2 MSG_STATUS (FOUR) C----------------------------------------------------------------------* C INTEGER*4 * C----------------------------------------------------------------------* INTEGER*4 IO$_READVBLK INTEGER*4 MSG_CHANNEL INTEGER*4 MSG_DESCRIPTOR (TWO) INTEGER*4 MSGLEN INTEGER*4 SS$_NORMAL INTEGER*4 STATUS INTEGER*4 SYS$BRDCST INTEGER*4 SYS$GETMSG C----------------------------------------------------------------------* C LOGICAL*1 * C----------------------------------------------------------------------* LOGICAL*1 MSG_BUFFER (MAX) C----------------------------------------------------------------------* C * C NETWORK MESSAGE COMMON BLOCK * C * C----------------------------------------------------------------------* COMMON / NETMSG / MSG_BUFFER COMMON / NETMSG / MSG_CHANNEL COMMON / NETMSG / MSG_DESCRIPTOR COMMON / NETMSG / MSG_STATUS C----------------------------------------------------------------------* C SECTION 100 * C----------------------------------------------------------------------* C CHECK I/O COMPLETION STATUS TO INSURE THAT MESSAGE IS GOOD * C----------------------------------------------------------------------* 100 CONTINUE STATUS=MSG_STATUS(IOSTAT) IF (STATUS .NE. %LOC(SS$_NORMAL)) GO TO 800 C----------------------------------------------------------------------* C LOAD THE REMOTE HOST MESSAGE DESCRIPTOR WITH LENGTH AND ADDRESS * C----------------------------------------------------------------------* MSG_DESCRIPTOR(ONE)=MSG_STATUS(BYTCNT) MSG_DESCRIPTOR(TWO)=%LOC(MSG_BUFFER) C----------------------------------------------------------------------* C ISSUE MESSAGE TO USER * C----------------------------------------------------------------------* CALL SYS$BRDCST(MSG_DESCRIPTOR,CRT) C----------------------------------------------------------------------* C REISSUE THE NETWORK SERVER READ REQUEST TO GET NEXT HOST MESSAGE * C----------------------------------------------------------------------* CALL XRB_GET_MSG GO TO 900 C----------------------------------------------------------------------* C SECTION 800 * C----------------------------------------------------------------------* 800 CONTINUE CALL SYS$GETMSG(%VAL(STATUS),MSGLEN,ERRMSG,%VAL(FULL),) CALL SYS$BRDCST(ERRMSG(ONE:MSGLEN),CRT) C----------------------------------------------------------------------* C SECTION 900 * C----------------------------------------------------------------------* C AST TERMINATION * C----------------------------------------------------------------------* 900 CONTINUE C----------------------------------------------------------------------* C END OF AST XRB_MSG_AST * C----------------------------------------------------------------------* RETURN END