.TITLE FTP - DECnet File Transfer Utility .IDENT /1.03/ ;++ ; Title: ; FTP - DECnet File Transfer Utility ; ; Facility: ; Utility to facilitate copying files over DECnet. ; ; Abstract: ; FTP is a utility to facilitate copying files over DECnet. It ; uses a menu style display to speed entry of commands. It preserves ; security by not echoing passwords. It also allows specification of ; file ownership, providing the remote access username has sufficient ; privilege. ; ; Must be assembled with DEV$SSG:[SSG.SOURCE.SMAC]SMAC.MLB and ; SYS$LIBRARY:LIB.MLB. ; ; Environment: ; Native Mode. Uses DECnet access via RMS. ; ; Author: ; Gary L. Grebus, Creation date: 19-Nov-1981 ; Battelle Columbus Labs ; ; Modified by: ; Gary L. Grebus, 30-Nov-1981 ; 1.00 - First production version ; ; Gary L. Grebus, 14-Dec-1981 ; 1.01 - Improved SIGNAL macro. Added condition handlers with ; special processing for batch. ; ; Gary L. Grebus, 17-Dec-1981 ; 1.02 - Modified SIGNAL macro to standard version. ; ; Gary L. Grebus, 15-Mar-1982 ; 1.03 - Added [] notation for current default directory. Fixed ; RMS error messages to eliminat STV junk. Fixed ; TRANSLATE_LOGICAL to do ESC processing in logical names. ; Added "D" ownership option and "." notation for current ; node. Added "O" notation for opposite node. Made username ; and password info be applied to any and all node specs that ; are not the current one. ;-- .PAGE .SBTTL Symbol definitions ; System symbols $DSCDEF ; Descriptor definitions $STSDEF ; Condition value fields $JPIDEF ; $GETJPI codes $TPADEF ; LIB$TPARSE symbols $PCBDEF ; Process status flags $CHFDEF ; Condition handling facility symbols ; Equated symbols NODENAME_SZ = 6 ; Max size of a node name USERNAME_SZ = 12 ; Max size of a username PASSWORD_SZ = 31 ; Max size of a password .PAGE .SBTTL Macros .MACRO SIGNAL CODE1, F1, CODE2, F2 ;; Macro to generate a message vector and signal a condition. ;; Up to two message sequences are allowed. Each sequence may have up to ;; four FAO parameters. Sequences for RMS and SS error codes are correctly ;; generated. Parameters must not reside R1 which is modified. R0 is ;; preserved. .IF BLANK, ;; CODE1 must be specified .ERROR ; Message code must be specified .MEXIT .ENDC PUSHL R0 ; Preserve condition value CLRL R1 ; Clear argument count MSG.. CODE2,F2 ; Process both message sequences MSG.. CODE1,F1 CALLS R1,G^LIB$SIGNAL ; Signal the condition POPL R0 ; Restore condition value .ENDM SIGNAL .MACRO MSG.. CODE,FW,FX,FY,FZ,?L1 .IF NB, ;; If there is a message code ..FLEN=0 ;; Count of FAO parameters .IRP F, ;; Stack parameters in reverse order .IF NB, ;; If parameter supplied .NTYPE ..TYP,F ;; Get addressing type ..TYP = ..TYP@-4&^XF ..FLG = 0 .IIF LE,..TYP-1, ..FLG=1 .IIF EQ,..TYP-5, ..FLG=1 .IF EQ,..FLG ;; If mode is an address PUSHAL F .IF_FALSE ;; Else push value PUSHL F .ENDC ..FLEN = ..FLEN + 1 .ENDC .ENDR PUSHL CODE ; Push message code on stack CMPZV #STS$V_FAC_NO,- #STS$S_FAC_NO,- (SP),- #1 ; Is facility code system or RMS? BLEQ L1 ; Branch if so MOVAB 4(SP),SP ; Clear code from stack PUSHL #..FLEN ; Push FAO list length INCL R1 PUSHL CODE ; Push message code again L1: ADDL2 #..FLEN+1,R1 ; Bump argument count .ENDC .ENDM MSG.. .MACRO CODE_SECTION NAME=CODE, ALIGN=LONG .PSECT NAME RD,NOWRT,EXE,SHR,ALIGN .ENDM CODE_SECTION .MACRO DATA_SECTION NAME=RWDATA, ALIGN=LONG .PSECT NAME RD,WRT,NOEXE,NOSHR,ALIGN .ENDM DATA_SECTION .MACRO CONSTANT_SECTION NAME=RODATA, ALIGN=LONG .PSECT NAME RD,NOWRT,NOEXE,SHR,ALIGN .ENDM CONSTANT_SECTION .MACRO V_STRING ;; Macro to generate a skeleton descriptor to hold the descriptor ;; returned by dynamically allocating a string. String is allocated ;; by calling OTS$SGET_DD. .WORD 0 .BYTE DSC$K_DTYPE_T ; String type .BYTE DSC$K_CLASS_D ; Dynamic type .BLKL 1 ; Address .ENDM V_STRING .MACRO OUTPUT W, P, TEXT CONSTANT_SECTION ..L1=. .ASCID `TEXT` ; Generate the text CODE_SECTION CALL SCR_OUT ..L1, W, P ; Output the string to the screen .ENDM OUTPUT .MACRO IF_STR_EQ ARG1, ARG2, DUMMY ;; Macro to do a string compare using descriptors CALL STR$COMPARE_EQL ARG1,ARG2 IF THEN .ENDM IF_STR_EQ .PAGE .SBTTL Read only data CONSTANT_SECTION ; Default node names A_NODE: .ASCID /BCLVXA/ ; Default node "A" B_NODE: .ASCID /BCLVXB/ ; Default node "B" SYSNODE: .ASCID /SYS$NODE/ ; Logical name for our node ; Useful characters in descriptor form HELP_CHAR: .ASCID /?/ ; Help character A_CHAR: .ASCID /A/ B_CHAR: .ASCID /B/ DOT_CHAR: .ASCID /./ O_CHAR: .ASCID /O/ ; $GETJPI vector for getting process status STS_JPI_VEC: .WORD 4 .WORD JPI$_STS .ADDRESS PROC_STATUS .LONG 0,0 .PAGE .SBTTL Read/write data DATA_SECTION ; Read/write data SOURCE_NODE: V_STRING ; File source node DEST_NODE: V_STRING ; File destination node REMOTE_USERNAME: V_STRING ; Username for access control REMOTE_PW: V_STRING ; Password for access control PROC_STATUS: .BLKL 1 ; Process status flags including ; BATCH flag .PAGE .SBTTL FTP - Main program CODE_SECTION .ENTRY FTP,^M<> ; Register usage: ; R0-R1 - Scratch. Modified. ; Establish a condition handler MOVAB MAIN_HANDLER,(FP) ; Obtain process status (batch or online) CLRL PROC_STATUS ; Clear status flags $GETJPI_S - ITMLST=STS_JPI_VEC ; Get status IF THEN SIGNAL - CODE1=R0 ; Signal any error ENDIF ; Initialize screen. Reset each window. CALL SCR_RESET_WINDOW #SCR_C_HEADW CALL SCR_RESET_WINDOW #SCR_C_NODEW CALL SCR_RESET_WINDOW #SCR_C_FILEW CALL SCR_RESET_WINDOW #SCR_C_STATUSW CALL SCR_RESET_WINDOW #SCR_C_SPECIALW ; Clear screen and print banner. CALL SCR_ERASE_SCREEN ; Erase screen OUTPUT #SCR_C_HEADW, #SCR_C_NEXT,- ; Banner line ; Obtain node and access control info from the user. CALL INQ_SRC_NODE SOURCE_NODE ; Source node name BLBC R0,10$ ; Branch if error CALL INQ_DST_NODE DEST_NODE ; Destination node BLBC R0,10$ ; Destination node name CALL INQ_USR_NAME REMOTE_USERNAME ; Access username BLBC R0,10$ ; Branch if error CALL INQ_PASSWORD REMOTE_PW ; Access password 10$: IF THEN ; All node and access info available. Loop transferring files. REPEAT CALL FILE_REQUEST - SOURCE_NODE,- DEST_NODE,- REMOTE_USERNAME,- REMOTE_PW ; Transfer one file UNTIL ENDIF ; Check for a non-fatal error has occurred anywhere in this routine IF THEN IF THEN ; If EOF encountered from user MOVZWL #SS$_NORMAL,R0 ; Treat EOF as success ENDIF ENDIF MOVL R0,R2 ; Save return status OUTPUT #SCR_C_LAST, #1,- <> ; Position to bottom of screen MOVL R2,R0 ; Restore return status RET ; Return with status .PAGE .SBTTL MAIN_HANDLER - Main condition handler ; This is the main condition handler for FTP. It gets control ; when any "fatal" error is signalled. .ENTRY MAIN_HANDLER,^M ; Issue message for the status we get and exit with that status and ; no-message bit set. If any error occurs in this processing, it ; will get passed to the default traceback handler. MOVL CHF$L_SIGARGLST(AP),R2 ; Get address of signal args array. CALL SCR_RESET_WINDOW,- #SCR_C_STATUSW ; Display error in status window OUTPUT #SCR_C_STATUSW,- #SCR_C_NEXT,- SUBW2 #2,CHF$L_SIG_ARGS(R2) ; Drop PC and PSL from argument list $PUTMSG_S - MSGVEC=(R2),- ACTRTN=PUTMSG_ACTION ; Display message via action routine MOVL CHF$L_SIGARGLST(AP),R0 ; Get address of signal args BISL3 #STS$M_INHIB_MSG,- CHF$L_SIG_NAME(R0),R0 ; Get condition value with inhib msg $EXIT_S R0 ; Exit with the status ; Action routine called by $PUTMSG. We issue the formatted system error ; message using screen display stuff. .ENTRY PUTMSG_ACTION,^M<> CALL SCR_OUT @4(AP),- #SCR_C_STATUSW,- #SCR_C_NEXT ; Display the message CLRL R0 ; Return failure status RET .PAGE .SBTTL INQ_SRC_NODE - Inquire after source node ;++ ; Functional Description: ; Routine to obtain the source node for the copies. Prompts for ; input, reads user response, and processes defaults. ; ; Calling Sequence: ; CALLS #1,INQ_SRC_NODE ; ; Input Parameters: NONE ; ; Output Parameters: ; SOURCE_NAME - Address of descriptor to receive source node name ; ; Implicit Inputs: NONE ; ; Implicit Outputs: NONE ; ; Procedures called: ; SCR_IN, SCR_OUT, SCR_RESET_WINDOW, OTS$COPY_DX_DX, STR$COMPARE_EQL, ; STR$LEFT ; ; Completion Status: ; Signals any fatal errors. Returns non-fatal errors (primarily ; EOF) in R0. ; ; Side Effects: NONE ; ;-- ; Local symbols ; Parameters $OFFSET 4,POSITIVE,<- SOURCE_NAME,- ; Address of descriptor to get name > CODE_SECTION .ENTRY INQ_SRC_NODE,^M ; Register usage: ; R0-R1 - Scratch. ; R2 - Address of descriptor. MOVL SOURCE_NAME(AP),R2 ; Get address of descriptor ; Loop until a valid reply obtained OUTPUT #SCR_C_NODEW,#SCR_C_NEXT,- REPEAT CALL SCR_IN (R2) ; Read the reply BREAK IF ; Was the reply a HELP request? CALL STR$COMPARE_EQL (R2), HELP_CHAR ; Do the strings match? BREAK IF ; Break if not (no match) ; Issue HELP text CALL SCR_RESET_WINDOW,- #SCR_C_SPECIALW ; Reset window OUTPUT #SCR_C_SPECIALW,- #SCR_C_NEXT,- OUTPUT #SCR_C_SPECIALW,- #SCR_C_NEXT,- OUTPUT #SCR_C_NODEW,#SCR_C_CURRENT,- UNTIL ; Process the string if one was returned. ENB_LONG ;; Enable long branches for macros IF THEN IF THEN ; If string is null, return null (current node). Otherwise, process ; the returned value. IF_STR_EQ (R2),O_CHAR THEN ; Was reply a "O"? CALL OPPOSITE_NODE (R2) ; Return opposite node name MOVZWL #SS$_NORMAL,R0 BRW END_CASE ENDIF IF_STR_EQ (R2),DOT_CHAR THEN ; Was reply a "." CLRW DSC$W_LENGTH(R2) ; Make reply a null (current node) MOVZWL #SS$_NORMAL,R0 ; Return success. BRW END_CASE ENDIF IF_STR_EQ (R2),A_CHAR THEN ; Was reply an "A" CALL OTS$SCOPY_DXDX - A_NODE, (R2) ; Return nodename A MOVZWL #SS$_NORMAL,R0 ; Return success BRW END_CASE ENDIF IF_STR_EQ (R2), B_CHAR THEN ; Was reply a "B" CALL OTS$SCOPY_DXDX - B_NODE, (R2) ; Return nodename B MOVZWL #SS$_NORMAL,R0 ; Return success BRW END_CASE ENDIF ; Reply is some other text, take that as a node name. Return the ; reply string itself, less any colons. LOCC #^A/:/,- DSC$W_LENGTH(R2),- @DSC$A_POINTER(R2) ; Look for a ":" ; R0 has nr of bytes after name. IF THEN ; If colons found SUBW3 R0,DSC$W_LENGTH(R2),- R0 ; Compute string length less colons PUSHL R0 ; Store the new length. MOVL SP,R0 ; And get its address CALL STR$LEFT - (R2), (R2), (R0) ; Truncate the string ELSE MOVZWL #SS$_NORMAL,R0 ; No colons to worry about. Success. ENDIF END_CASE: ENDIF ENDIF DSB_LONG ;; Disable long branches for macros RET .PAGE .SBTTL INQ_DST_NODE - Inquire after destination node ;++ ; Functional Description: ; Routine to obtain the destination node for the copies. Prompts for ; input, reads user response, and processes defaults. If a null reply ; is entered, the default action is to return the opposite node from ; the current executor. ; ; Calling Sequence: ; CALLS #1,INQ_DST_NODE ; ; Input Parameters: NONE ; ; Output Parameters: ; DEST_NAME - Address of descriptor to receive dest node name ; ; Implicit Inputs: NONE ; ; Implicit Outputs: NONE ; ; Procedures called: ; SCR_IN, SCR_OUT, SCR_RESET_WINDOW, OTS$COPY_DX_DX, STR$COMPARE_EQL, ; STR$LEFT ; ; Completion Status: ; Signals any fatal errors. Returns non-fatal errors (primarily ; EOF) in R0. ; ; Side Effects: NONE ; ;-- ; Local symbols ; Parameters $OFFSET 4,POSITIVE,<- DEST_NAME,- ; Address of descriptor to get name > CODE_SECTION .ENTRY INQ_DST_NODE,^M ; Register usage: ; R0-R1 - Scratch. ; R2 - Address of descriptor. MOVL DEST_NAME(AP),R2 ; Get address of descriptor ; Loop until a valid reply obtained OUTPUT #SCR_C_NODEW,#SCR_C_NEXT,- REPEAT CALL SCR_IN (R2) ; Read the reply BREAK IF ; Was the reply a HELP request? CALL STR$COMPARE_EQL (R2), HELP_CHAR ; Do the strings match? BREAK IF ; Break if not (no match) ; Issue HELP text CALL SCR_RESET_WINDOW,- #SCR_C_SPECIALW ; Reset window OUTPUT #SCR_C_SPECIALW,- #SCR_C_NEXT,- OUTPUT #SCR_C_SPECIALW,- #SCR_C_NEXT,- OUTPUT #SCR_C_NODEW,#SCR_C_CURRENT,- UNTIL ; Process the string returned ENB_LONG ;; Enable long branches in macros IF THEN IF THEN ; Reply was null. Return opposite node CALL OPPOSITE_NODE (R2) MOVZWL #SS$_NORMAL,R0 ; Return success ELSE IF_STR_EQ (R2), O_CHAR THEN ; Was reply a "O"? CALL OPPOSITE_NODE (R2) ; Yes. Return opposite node MOVZWL #SS$_NORMAL,R0 ; Return success BRW END_CASE_1 ENDIF IF_STR_EQ (R2), A_CHAR THEN ; Was reply an "A" CALL OTS$SCOPY_DXDX - A_NODE, (R2) ; Return nodename A MOVZWL #SS$_NORMAL,R0 ; Return success BRW END_CASE_1 ENDIF IF_STR_EQ (R2), B_CHAR THEN ; Was reply a "B" CALL OTS$SCOPY_DXDX - B_NODE, (R2) ; Return nodename B MOVZWL #SS$_NORMAL,R0 ; Return success BRW END_CASE_1 ENDIF IF_STR_EQ (R2), DOT_CHAR THEN ; Was reply a "." CLRW DSC$W_LENGTH(R2) ; Make reply a null (current node) MOVZWL #SS$_NORMAL,R0 ; Return success BRW END_CASE_1 ENDIF ; Reply is some other text, take that as a node name. ; Return the reply string itself, less any colons LOCC #^A/:/,- DSC$W_LENGTH(R2),- @DSC$A_POINTER(R2) ; Look for a colon IF THEN ; If colon found SUBW3 R0,- DSC$W_LENGTH(R2),R0 ; Compute string length before colons PUSHL R0 ; Store the new length MOVL SP,R0 ; and get its address CALL STR$LEFT - (R2), (R2), (R0) ; Truncate the string to remove colons ELSE MOVZWL #SS$_NORMAL,R0 ; Else no colons. Success ENDIF END_CASE_1: ENDIF ENDIF DSB_LONG ;; Disable long branches RET .PAGE .SBTTL INQ_USR_NAME - Inquire after remote username ;++ ; Functional Description: ; Routine to obtain the username to be used in remote node access ; control strings. If unspecified, the current user's name is ; used. If an "S" is entered, the username SYSTEM is used. ; ; Calling Sequence: ; CALLS #1,INQ_USR_NAME ; ; Input Parameters: NONE ; ; Output Parameters: ; USR_NAME - Address of descriptor to receive username ; ; Implicit Inputs: NONE ; ; Implicit Outputs: NONE ; ; Procedures called: ; SCR_IN, SCR_OUT, SCR_RESET_WINDOW, OTS$COPY_DX_DX, STR$COMPARE_EQL, ; SYS$GETJPI ; ; Completion Status: ; Signals any fatal errors. Returns non-fatal errors (primarily ; EOF) in R0. ; ; Side Effects: NONE ; ;-- ; Local symbols ; Parameters $OFFSET 4,POSITIVE,<- USR_NAME,- ; Address of descriptor to get name > CONSTANT_SECTION: S_CHAR: .ASCID /S/ ; Reply for username SYSTEM SYSTEM_NAME: .ASCID /SYSTEM/ ; Username SYSTEM NAME_JPI_LIST: ; Request list for $GETJPI .WORD USERNAME_SZ .WORD JPI$_USERNAME .ADDRESS CURRENT_UN ; Address of return buffer .ADDRESS CURRENT_UN_LEN ; Address of return for length .LONG 0 DATA_SECTION CURRENT_UN: .BLKB USERNAME_SZ ; Buffer for current username CURRENT_UN_DESC: CURRENT_UN_LEN: .WORD 0 ; Length of username. Skeleton desc. .WORD 0 .ADDRESS CURRENT_UN CODE_SECTION .ENTRY INQ_USR_NAME,^M ; Register usage: ; R0-R1 - Scratch. ; R2 - Address of descriptor. MOVL USR_NAME(AP),R2 ; Get address of descriptor ; Loop until a valid reply obtained OUTPUT #SCR_C_NODEW,#SCR_C_NEXT,- REPEAT CALL SCR_IN (R2) ; Read the reply BREAK IF ; Was the reply a HELP request? CALL STR$COMPARE_EQL (R2), HELP_CHAR ; Do the strings match? BREAK IF ; Break if not (no match) ; Issue HELP text CALL SCR_RESET_WINDOW,- #SCR_C_SPECIALW ; Reset window OUTPUT #SCR_C_SPECIALW,- #SCR_C_NEXT,- OUTPUT #SCR_C_SPECIALW,- #SCR_C_NEXT,- OUTPUT #SCR_C_NODEW,#SCR_C_CURRENT,- UNTIL ; Process the string if one was returned. IF THEN IF THEN ; If string is null, return current username. $GETJPI_S - ITMLST=NAME_JPI_LIST ; Get current username IF THEN ; Signal any errors SIGNAL - CODE1=R0 ; Signal the error ENDIF CALL STR$TRIM - (R2),- CURRENT_UN_DESC ; Return username, less trailing ; blanks ELSE IF_STR_EQ (R2), S_CHAR THEN ; Was reply an "S" CALL OTS$SCOPY_DXDX - SYSTEM_NAME, (R2) ; Return username "SYSTEM" ENDIF ENDIF MOVZWL #SS$_NORMAL,R0 ; Return success ENDIF RET .PAGE .SBTTL INQ_PASSWORD - Inquire after remote password ;++ ; Functional Description: ; Routine to obtain the password to be used in remote node access ; control strings. If unspecified the user is reprompted. ; used. ; ; Calling Sequence: ; CALLS #1,INQ_PASSWORD ; ; Input Parameters: NONE ; ; Output Parameters: ; PW_DESC - Address of descriptor to receive password ; ; Implicit Inputs: NONE ; ; Implicit Outputs: NONE ; ; Procedures called: ; SCR_IN, SCR_OUT, SCR_RESET_WINDOW, STR$COMPARE_EQL ; ; Completion Status: ; Signals any fatal errors. Returns non-fatal errors (primarily ; EOF) in R0. ; ; Side Effects: NONE ; ;-- ; Local symbols ; Parameters $OFFSET 4,POSITIVE,<- PW_DESC,- ; Address of descriptor to get pw > CODE_SECTION .ENTRY INQ_PASSWORD,^M ; Register usage: ; R0-R1 - Scratch. ; R2 - Address of descriptor. MOVL PW_DESC(AP),R2 ; Get address of descriptor ; Loop until a valid reply obtained OUTPUT #SCR_C_NODEW,#SCR_C_NEXT,- REPEAT CALL SCR_IN (R2), #1 ; Read the reply with no echo BREAK IF ; Was the reply a HELP request? CALL STR$COMPARE_EQL (R2), HELP_CHAR ; Do the strings match? BREAK IF AND - ; Break if not (no match) ; and do not accept null strings ; Issue HELP text CALL SCR_RESET_WINDOW,- #SCR_C_SPECIALW ; Reset window OUTPUT #SCR_C_SPECIALW,- #SCR_C_NEXT,- OUTPUT #SCR_C_SPECIALW,- #SCR_C_NEXT,- OUTPUT #SCR_C_NODEW,#SCR_C_CURRENT,- UNTIL RET .PAGE .SBTTL OPPOSITE_NODE - Return nodename of opposite node ;++ ; Functional Description: ; Routine to return the nodename of the "opposite" node. This ; is really only a good assumption for a network with two nodes. ; If the current node is neither the A node nor the B node, the ; name of the A node is returned. The current node name is obtained ; by translating the logical name SYS$NODE. ; ; Calling Sequence: ; CALLS #1, OPPOSITE_NODE ; ; Input Parameters: ; ; Output Parameters: ; OPP_DESC - Address of descriptor to receive nodename ; ; Implicit Inputs: NONE ; ; Implicit Outputs: NONE ; ; Procedures called: ; TRANSLATE_LOGICAL, OTS$SCOPY_DXDX, STR$COMPARE_EQL ; ; Completion Status: ; No error status returned. Fatal errors are signaled and processed ; by the condition handler. ; ; Side Effects: NONE ; ;-- ; Local symbols ; Parameters $OFFSET 4,POSITIVE,<- OPP_DESC,- > ; Address of descriptor ; Local storage DATA_SECTION THIS_NODE: STRING 63 ; Descriptor and buffer for returned ; node name. THIS_NODE_V: ; Skeleton desc for returned name THIS_NODE_LEN: .WORD 0 ; Returned length of node name .WORD 0 ; Desc type and class .LONG 0 CODE_SECTION .ENTRY OPPOSITE_NODE,^M ; Register usage: ; R0-R2 - Scratch CALL TRANSLATE_LOGICAL - SYSNODE,- THIS_NODE,- THIS_NODE_LEN ; Translate SYS$NODE IF THEN ; Signal any errors SIGNAL - CODE1=R0 ; Signal the error ELSE ; SYS$NODE translation always has a "::". Build descriptor ; to the name without these characters. MOVAL THIS_NODE+8,- THIS_NODE_V+4 ; Set address past "_" SUBW2 #2,THIS_NODE_V ; and adjust length IF_STR_EQ THIS_NODE_V, A_NODE THEN ; If we are on node A, return B CALL OTS$SCOPY_DXDX B_NODE,@OPP_DESC(AP) ELSE ; If we are on B, or any other node, return A CALL OTS$SCOPY_DXDX A_NODE,@OPP_DESC(AP) ENDIF ENDIF RET .PAGE .SBTTL FILE_REQUEST - Process a file request ;++ ; Functional Description: ; Routine prompts user for source and destination filespecs, file ; owner, and protection. This information is combined with the ; node and access information passed as parameters. The resulting ; filespecs are then used to specify the file transfer. ; ; Calling Sequence: ; CALLS #4, FILE_REQUEST ; ; Input Parameters: ; S_NODE - Address of descriptor for source node ; D_NODE - Address of descriptor for destination node ; USERNAME - Address of descriptor for remote access username. ; PASSWORD - Address of descriptor for remote access password. ; ; Output Parameters: NONE ; ; Implicit Inputs: NONE ; ; Implicit Outputs: NONE ; ; Procedures called: ; INQ_FROM_SPEC, INQ_TO_SPEC, INQ_OWNER, INQ_PROTECTION, ; STR$CONCAT, TRANSFER_FILE ; ; Completion Status: ; Signals any fatal errors. Non-fatal errors (such as EOF) are ; returned. ; ; Side Effects: NONE ; ;-- ; Local symbols ; Parameters $OFFSET 4,POSITIVE,<- S_NODE,- D_NODE,- USERNAME,- PASSWORD,- > CONSTANT_SECTION ; Characters needed for building filespecs BLANK_CHAR: .ASCID / / D_QUOTE_CHAR: .ASCID /"/ D_COLON: .ASCID /::/ DATA_SECTION ; Local data FROM_SPEC: V_STRING ; Source filespec TO_SPEC: V_STRING ; Destination filespec OWNER: .BLKL 1 ; Owner UIC PROTECTION: .BLKW 1 ; Protection mask CODE_SECTION .ENTRY FILE_REQUEST,^M<> ; Register usage: ; R0-R1 - Scratch ; Establish condition handler for per-file processing. MOVAB RMS_HANDLER,(FP) ; Establish handler CALL SCR_RESET_WINDOW,- #SCR_C_FILEW ; Reset display window CALL INQ_FROM_SPEC, FROM_SPEC ; Get source filespec BLBC R0,10$ ; Branch if error CALL INQ_TO_SPEC, TO_SPEC, FROM_SPEC ; Get destination filespec BLBC R0,10$ ; Branch if error CALL INQ_OWNER, OWNER ; Get requested owner BLBC R0,10$ ; Branch if error CALL INQ_PROTECTION, PROTECTION ; Get requested protection 10$: ENB_LONG ;; Enable long branch for macros IF THEN ; If no errors above ; Generate complete specs IF THEN ; If source node is non-null CALL STR$CONCAT FROM_SPEC,- @S_NODE(AP),- D_QUOTE_CHAR,- @USERNAME(AP),- BLANK_CHAR,- @PASSWORD(AP),- D_QUOTE_CHAR,- D_COLON,- FROM_SPEC ; Build complete spec ENDIF IF THEN ; If destination node is non-null CALL STR$CONCAT TO_SPEC,- @D_NODE(AP),- D_QUOTE_CHAR,- @USERNAME(AP),- BLANK_CHAR,- @PASSWORD(AP),- D_QUOTE_CHAR,- D_COLON,- TO_SPEC ; Build complete destination spec ENDIF CALL TRANSFER_FILE - FROM_SPEC,- TO_SPEC,- OWNER,- PROTECTION ; Transfer the requested file CALL SCR_RESET_WINDOW,- #SCR_C_STATUSW ; Reset status window OUTPUT #SCR_C_STATUSW,#SCR_C_NEXT,- MOVZWL #SS$_NORMAL,R0 ; Return success ENDIF DSB_LONG ;; Disable long branch for macros RET .PAGE .SBTTL RMS_HANDLER - Per-file processing condition handler ; This is the condition handler for the file processing in FTP. ; It gets control when any lower routines signal an error. ; It issues the error message and unwinds to the caller of its ; invoker (FILE_REQUEST). This causes FTP to resume operation with ; prompting for the next source file. If an error occurs when running ; in BATCH, this is treated as fatal and is resignaled to the main handler. .ENTRY RMS_HANDLER,^M MOVL CHF$L_SIGARGLST(AP),R2 ; Get address of signal args ; Ignore any calls during unwinding IF THEN MOVZWL #SS$_CONTINUE,R0 RET ENDIF IF THEN ; We are in batch. Resignal. MOVZWL #SS$_RESIGNAL,R0 ; Resignal status RET ELSE CALL SCR_RESET_WINDOW,- #SCR_C_STATUSW ; Display error in status window OUTPUT - #SCR_C_STATUSW,- #SCR_C_NEXT,- SUBW2 #2,CHF$L_SIG_ARGS(R2) ; Remove PC and PSL from sig args $PUTMSG_S - MSGVEC=(R2),- ACTRTN=PUTMSG_ACTION ; Output message using action routine MOVL CHF$L_MCHARGLST(AP),R0 ; Get address of mechanism args MOVZWL - #SS$_NORMAL,- CHF$L_MCH_SAVR0(R0) ; Reset saved R0 to success $UNWIND_S ; And unwind to caller of FILE_REQUEST ENDIF .PAGE .SBTTL INQ_FROM_SPEC - Inquire after source filespec ;++ ; Functional Description: ; Routine asks user for the source filespec. A null reply is ; not accepted. ; ; Calling Sequence: ; CALLS #1,INQ_FROM_SPEC ; ; Input Parameters: NONE ; ; Output Parameters: ; S_DESC - Address of descriptor to receive filespec ; ; Implicit Inputs: NONE ; ; Implicit Outputs: NONE ; ; Procedures called: ; SCR_IN, SCR_OUT, SCR_RESET_WINDOW, STR$COMPARE_EQL ; ; Completion Status: ; Signals any fatal errors. Returns non-fatal errors (primarily ; EOF) in R0. ; ; Side Effects: NONE ; ;-- ; Local symbols ; Parameters $OFFSET 4,POSITIVE,<- S_DESC,- ; Address of descriptor to get spec > CODE_SECTION .ENTRY INQ_FROM_SPEC,^M ; Register usage: ; R0-R1 - Scratch. ; R2 - Address of descriptor. MOVL S_DESC(AP),R2 ; Get address of descriptor ; Loop until a valid reply obtained OUTPUT #SCR_C_FILEW,#SCR_C_NEXT,- REPEAT CALL SCR_IN (R2) ; Read reply BREAK IF ; Was the reply a HELP request? CALL STR$COMPARE_EQL (R2), HELP_CHAR ; Do the strings match? BREAK IF AND - ; Break if not (no match) ; and do not accept null strings ; Issue HELP text CALL SCR_RESET_WINDOW,- #SCR_C_SPECIALW ; Reset window OUTPUT #SCR_C_SPECIALW,- #SCR_C_NEXT,- OUTPUT #SCR_C_SPECIALW,- #SCR_C_NEXT,- OUTPUT #SCR_C_FILEW,#SCR_C_CURRENT,- UNTIL RET .PAGE .SBTTL INQ_TO_SPEC - Inquire after desitnation filespec ;++ ; Functional Description: ; Routine asks user for the destination filespec. A null reply is ; interpreted as requesting the same as the default filespec passed ; as a parameter. This would normally be the source filespec. ; ; Calling Sequence: ; CALLS #1,INQ_TO_SPEC ; ; Input Parameters: ; DEF_DESC - Address of default filespec descriptor ; ; Output Parameters: ; D_DESC - Address of descriptor to receive filespec ; ; Implicit Inputs: NONE ; ; Implicit Outputs: NONE ; ; Procedures called: ; SCR_IN, SCR_OUT, SCR_RESET_WINDOW, STR$COMPARE_EQL, OTS$SCOPY_DXDX ; ; Completion Status: ; Signals any fatal errors. Returns non-fatal errors (primarily ; EOF) in R0. ; ; Side Effects: NONE ; ;-- ; Local symbols ; Parameters $OFFSET 4,POSITIVE,<- D_DESC,- ; Address of descriptor to get spec DEF_DESC,- ; Address of descriptor to default > CODE_SECTION .ENTRY INQ_TO_SPEC,^M ; Register usage: ; R0-R1 - Scratch. ; R2 - Address of descriptor. MOVL D_DESC(AP),R2 ; Get address of descriptor ; Loop until a valid reply obtained OUTPUT #SCR_C_FILEW,#SCR_C_NEXT,- REPEAT CALL SCR_IN (R2) ; Read reply BREAK IF ; Was the reply a HELP request? CALL STR$COMPARE_EQL (R2), HELP_CHAR ; Do the strings match? BREAK IF ; Break if not (no match) ; Issue HELP text CALL SCR_RESET_WINDOW,- #SCR_C_SPECIALW ; Reset window OUTPUT #SCR_C_SPECIALW,- #SCR_C_NEXT,- OUTPUT #SCR_C_SPECIALW,- #SCR_C_NEXT,- OUTPUT #SCR_C_FILEW,#SCR_C_CURRENT,- UNTIL IF THEN IF THEN ; If reply is null, use default filespec CALL OTS$SCOPY_DXDX @DEF_DESC(AP), @D_DESC(AP) ; Return default MOVZWL #SS$_NORMAL,R0 ; Restore success status ENDIF ENDIF RET .PAGE .SBTTL INQ_OWNER - Inquire after file ownership ;++ ; Functional Description: ; Routine to obtain ownership specification for the destination file. ; Allowable responses are null for owner of source file, S for system ; UIC [1,4], D for default owner based on remote username, ; or a specific UIC with or without brackets. LIB$TPARSE ; is used to parse the UIC specification. The UIC is returned as a ; longword quantity. ; ; Calling Sequence: ; CALLS #1, INQ_OWNER ; ; Input Parameters: NONE ; ; Output Parameters: ; OWN - Address of longword to receive owner UIC ; ; Implicit Inputs: NONE ; ; Implicit Outputs: NONE ; ; Procedures called: ; SCR_OUT, SCR_RESET_WINDOW, SCR_IN, LIB$TPARSE ; ; Completion Status: ; Fatal errors are signalled. Non-fatal errors such as EOF are ; returned. ; ; Side Effects: NONE ; ;-- ; Local symbols ; Parameter $OFFSET 4,POSITIVE,<- OWN,- > SYSTEM_GRP = 1 ; System uic SYSTEM_MEM = 4 CONSTANT_SECTION ; Parser tables LAB = ^A/ ; Register usage: ; R0-R1 - Scratch CLRL REQUEST_GRP ; Assume request is for original owner CLRL REQUEST_MEM ; Loop until valid reply obtained OUTPUT #SCR_C_FILEW,- #SCR_C_NEXT,- REPEAT CALL SCR_IN UIC_REPLY ; Read response BREAK IF OR - ; Break if error or ; null reply. IF_STR_EQ UIC_REPLY, HELP_CHAR THEN ; If reply was a HELP request, issue help text. CALL SCR_RESET_WINDOW - #SCR_C_SPECIALW ; Reset window OUTPUT #SCR_C_SPECIALW,- #SCR_C_NEXT,- OUTPUT #SCR_C_SPECIALW,- #SCR_C_NEXT,- CLRL R0 ; No value available yet ELSE ; Parse the reply MOVZWL - UIC_REPLY+DSC$W_LENGTH,- UIC_TPARSE+TPA$L_STRINGCNT ; Point TPARSE at string MOVL UIC_REPLY+DSC$A_POINTER,- UIC_TPARSE+TPA$L_STRINGPTR CALL LIB$TPARSE - UIC_TPARSE, UIC_STATE, UIC_KEY ; Do the parse IF THEN ; Bad UIC input. Issue message CALL SCR_RESET_WINDOW,- #SCR_C_STATUSW ; Reset status window OUTPUT - #SCR_C_STATUSW,- #SCR_C_NEXT,- CLRL R0 ; No UIC gotten yet ENDIF ENDIF BREAK IF ; Done if we parsed a UIC OUTPUT #SCR_C_FILEW,- ; Reprompt #SCR_C_CURRENT,- UNTIL ; All done. Return the UIC obtained IF THEN MOVL #-1,@OWN(AP) ; Special value--default by username ELSE MOVW REQUEST_GRP,- REQUEST_MEM+2 ; Make longword UIC MOVL REQUEST_UIC,- @OWN(AP) ; Return value ENDIF RET .PAGE .SBTTL INQ_PROTECTION - Inquire after file protection ;++ ; Functional Description: ; Routine to obtain the protection to be supplied for the destination ; file. The options are oriented toward system files and are as ; follows: E is WORLD execute only, R is WORLD read only, N is ; no WORLD access, P is no world access and no OWNER delete access. ; A complete protection spec can also be entered. LIB$TPARSE is used ; to parse the input string. The protection mask is generated ; internally with a one-bit for each allowed access. The mask is then ; inverted before being returned as required by RMS. The mask is ; returned as a word length quantity. ; ; Calling Sequence: ; CALLS #1, INQ_PROTECTION ; ; Input Parameters: NONE ; ; Output Parameters: ; PRO - Address of longword to receive protection ; ; Implicit Inputs: NONE ; ; Implicit Outputs: NONE ; ; Procedures called: ; SCR_OUT, SCR_RESET_WINDOW, SCR_IN, LIB$TPARSE ; ; Completion Status: ; Fatal errors are signalled. Non-fatal errors such as EOF are ; returned. ; ; Side Effects: NONE ; ;-- ; Local symbols ; Parameter $OFFSET 4,POSITIVE,<- PRO,- > ; Protection masks for special options E_PROT = ^X4777 ; S:RWE,G:RWE,O:RWE,W:E R_PROT = ^X1777 ; S:RWE,G:RWE,O:RWE,W:R N_PROT = ^X0FF7 ; S:RWE,G:RWED,O:RWED,W P_PROT = ^X0777 ; S:RWE,G:RWE,O:RWE,W CONSTANT_SECTION ; Parser tables COMMA = ^A/,/ $INIT_STATE PROT_STATE, PROT_KEY $STATE $TRAN 'R',TPA$_EXIT,,R_PROT,FILE_PROT $TRAN 'N',TPA$_EXIT,,N_PROT,FILE_PROT $TRAN 'P',TPA$_EXIT,,P_PROT,FILE_PROT $TRAN TPA$_EOS,TPA$_EXIT,,E_PROT,FILE_PROT $TRAN '(' $TRAN TPA$_LAMBDA $STATE NEXT_PRO $TRAN 'SYSTEM', SYPR $TRAN 'OWNER', OWPR $TRAN 'GROUP', GRPR $TRAN 'WORLD', WOPR $STATE SYPR $TRAN ':' $TRAN '=' $STATE SYPRO $TRAN 'R',SYPRO,,<0001>,FILE_PROT $TRAN 'W',SYPRO,,<0002>,FILE_PROT $TRAN 'E',SYPRO,,<0004>,FILE_PROT $TRAN 'D',SYPRO,,<0008>,FILE_PROT $TRAN TPA$_LAMBDA,ENDPRO $STATE OWPR $TRAN ':' $TRAN '=' $STATE OWPRO $TRAN 'R',OWPRO,,<1@4>,FILE_PROT $TRAN 'W',OWPRO,,<2@4>,FILE_PROT $TRAN 'E',OWPRO,,<4@4>,FILE_PROT $TRAN 'D',OWPRO,,<8@4>,FILE_PROT $TRAN TPA$_LAMBDA,ENDPRO $STATE GRPR $TRAN ':' $TRAN '=' $STATE GRPRO $TRAN 'R',GRPRO,,<1@8>,FILE_PROT $TRAN 'W',GRPRO,,<2@8>,FILE_PROT $TRAN 'E',GRPRO,,<4@8>,FILE_PROT $TRAN 'D',GRPRO,,<8@8>,FILE_PROT $TRAN TPA$_LAMBDA,ENDPRO $STATE WOPR $TRAN ':' $TRAN '=' $STATE WOPRO $TRAN 'R',WOPRO,,<1@12>,FILE_PROT $TRAN 'W',WOPRO,,<2@12>,FILE_PROT $TRAN 'E',WOPRO,,<4@12>,FILE_PROT $TRAN 'D',WOPRO,,<8@12>,FILE_PROT $TRAN TPA$_LAMBDA,ENDPRO $STATE ENDPRO $TRAN COMMA,NEXT_PRO $TRAN ')',TPA$_EXIT $TRAN TPA$_EOS,TPA$_EXIT $END_STATE DATA_SECTION FILE_PROT: .BLKW 1 ; Buffer for accumulating protection PROT_REPLY: V_STRING ; Descriptor for protection string read PROT_TPARSE: .LONG TPA$K_COUNT0 ; TPARSE parameter block .LONG TPA$M_ABBREV .BLKL TPA$K_LENGTH0-8 CODE_SECTION .ENTRY INQ_PROTECTION,^M<> ; Register usage: ; R0-R1 - Scratch CLRL FILE_PROT ; Clear out protection mask ; Loop until valid reply obtained OUTPUT #SCR_C_FILEW,- #SCR_C_NEXT,- REPEAT CALL SCR_IN PROT_REPLY ; Read response BREAK IF ; Break if error IF_STR_EQ PROT_REPLY, HELP_CHAR THEN ; If reply was a HELP request, issue help text. CALL SCR_RESET_WINDOW - #SCR_C_SPECIALW ; Reset window OUTPUT #SCR_C_SPECIALW,- #SCR_C_NEXT,- OUTPUT #SCR_C_SPECIALW,- #SCR_C_NEXT,- CLRL R0 ; No value available yet ELSE ; Parse the reply MOVZWL - PROT_REPLY+DSC$W_LENGTH,- PROT_TPARSE+TPA$L_STRINGCNT ; Point TPARSE at string MOVL PROT_REPLY+DSC$A_POINTER,- PROT_TPARSE+TPA$L_STRINGPTR CALL LIB$TPARSE - PROT_TPARSE, PROT_STATE, PROT_KEY ; Do the parse IF THEN ; Bad protection input. Issue message CALL SCR_RESET_WINDOW,- #SCR_C_STATUSW ; Reset status window OUTPUT - #SCR_C_STATUSW,- #SCR_C_NEXT,- CLRL R0 ; No protection gotten yet ENDIF ENDIF BREAK IF ; Done if we parsed a protection OUTPUT #SCR_C_FILEW,- ; Reprompt #SCR_C_CURRENT,- UNTIL ; All done. Return the inverted mask. MCOMW FILE_PROT,- @PRO(AP) ; Return value RET .PAGE .SBTTL TRANSFER_FILE - Transfer one set of files ;++ ; Functional Description: ; Routine to perform the file transfer specified by a pair of filespecs. ; This could involve the copying of more than one file if wildcards are ; involved. File ownership and protection are also handled by this ; routine. ; ; Calling Sequence: ; CALLS #4, TRANSFER_FILE ; ; Input Parameters: ; FROM - Address of source filespec ; TO - Address of to filespec ; TO_OWNER - Address of file owner UIC longword ; TO_PROT - Address of file protection word mask ; ; Output Parameters: NONE ; ; Implicit Inputs: NONE ; ; Implicit Outputs: NONE ; ; Procedures called: ; SYS$PARSE, SYS$SEARCH, SYS$OPEN, SYS$CONNECT, OPEN_OUT,- ; TRANSFER_BLOCKS, SYS$CLOSE ; ; Completion Status: ; None. Signals any fatal errors ; ; Side Effects: NONE ; ;-- ; Local symbols ; Parameters $OFFSET 4,POSITIVE,<- FROM,- TO,- TO_OWNER,- TO_PROT,- > CONSTANT_SECTION EMPTY_DIR: .ASCID /[]/ ; Notation for default directory DATA_SECTION ; Read / write data ; Source file RMS structures .ALIGN LONG FROM_FAB: $FAB FAC=,- ; BRO so XAB's get filled in FOP=,- ; Network performance enhancement NAM=FROM_NAM,- XAB=FROM_XAB FROM_RAB: $RAB FAB=FROM_FAB,- ROP=BIO FROM_NAM: $NAM ESA=FROM_ESA,- RSA=FROM_RSA,- ESS=NAM$C_MAXRSS,- RSS=NAM$C_MAXRSS FROM_XAB: FROM_XABPRO: $XABPRO NXT=FROM_XABALL FROM_XABALL: $XABALL NXT=FROM_XABKEY1 FROM_XABKEY1: $XABKEY NXT=FROM_XABKEY2,REF=0 FROM_XABKEY2: $XABKEY NXT=FROM_XABKEY3,REF=1 FROM_XABKEY3: $XABKEY,REF=2 FROM_ESA: .BLKB NAM$C_MAXRSS FROM_RSA: .BLKB NAM$C_MAXRSS ; Destination file RMS blocks .ALIGN LONG TO_FAB: $FAB FAC=,- FOP=- ; Network performance enhancement NAM=TO_NAM,- XAB=FROM_XAB ; Chained to same XAB's TO_RAB: $RAB FAB=TO_FAB,- ROP=BIO TO_NAM: $NAM RLF=FROM_NAM ; Use source file as resultant file EMPTY_DIR_END: .BLKL 1 ; Space for index to end of brackets EMPTY_DIR_POS: .BLKL 1 ; Space for index to bracket in spec DEF_DIR: STRING NAM$C_MAXRSS ; Descriptor and buffer for current ; default directory buffer DEF_DIR_DESC: ; Skeleton desc for contents of above DEF_DIR_LEN: .BLKL 1 ; Returned length of above .ADDRESS DEF_DIR+8 CODE_SECTION .ENTRY TRANSFER_FILE,^M ; Register usage: ; R0-R1 - Scratch ; R2 - Address of FROM_FAB ; R3 - Scratch ; Check for notation "[]" in both filespecs. If present, propagate ; current default directory into file spec. CALL SYS$SETDDIR - #0,DEF_DIR_LEN,- DEF_DIR ; Get current default directory CALL LIB$INDEX @TO(AP), EMPTY_DIR ; Look for empty bracket notation IF THEN ; If brackets found MOVL R0,- EMPTY_DIR_POS ; Save position of brackets in spec ADDL3 R0,#1,EMPTY_DIR_END ; End position is start plus 1 CALL STR$REPLACE - @TO(AP),- @TO(AP),- EMPTY_DIR_POS,- EMPTY_DIR_END,- DEF_DIR_DESC ; Alter filespec to contain directory ENDIF CALL LIB$INDEX @FROM(AP), EMPTY_DIR ; Look for empty bracket notation IF THEN ; If brackets found MOVL R0,- EMPTY_DIR_POS ; Save position of brackets in spec ADDL3 R0,#1,EMPTY_DIR_END ; End position is start plus 1 CALL STR$REPLACE - @FROM(AP),- @FROM(AP),- EMPTY_DIR_POS,- EMPTY_DIR_END,- DEF_DIR_DESC ; Alter filespec to contain directory ENDIF ; Point the FAB to the source filespec MOVAL FROM_FAB,R2 ; Get FAB address MOVL FROM(AP),R0 ; Get address of source file desc CVTWB DSC$W_LENGTH(R0),- FAB$B_FNS(R2) ; Point FAB at filespec MOVL DSC$A_POINTER(R0),- FAB$L_FNA(R2) ; Parse the source filespec $PARSE FAB=(R2) ; Parse the source filespec ENB_LONG ;; Enable long branches for macros IF THEN SIGNAL - CODE1=R0 ; Signal fatal error ELSE ; Search for and open source file. Process all wildcards. REPEAT $SEARCH FAB=(R2) ; Search for next file BREAK IF ; Break if all files done IF THEN ; If any errors on file manipulation SIGNAL - CODE1=R0 ; Signal fatal error ENDIF $OPEN FAB=(R2) ; Open the file IF THEN ; If any errors on file manipulation SIGNAL - CODE1=R0 ; Signal fatal error ELSE $CONNECT - RAB=FROM_RAB ; Connect a record stream IF THEN SIGNAL - CODE1=R0 ; Signal error ENDIF ; Setup protection and ownership on destination file MOVW @TO_PROT(AP),- FROM_XABPRO+XAB$W_PRO ; Set protection mask in XAB IF THEN ; If not defaulting to current owner, supply the UIC specified IF THEN CLRL FROM_XABPRO+XAB$L_UIC ; -1 implies default by username ELSE MOVL @TO_OWNER(AP),- FROM_XABPRO+XAB$L_UIC ; Supply specified UIC ENDIF ENDIF IF THEN ; If non-zero file allocation quantity in FAB, reset the allocation ; value in the XAB. This is needed to make INDEXED file copies work. MOVL FROM_FAB+FAB$L_ALQ,- FROM_XABALL+XAB$L_ALQ ; Copy file size ENDIF CALL OPEN_OUT - ; Open the destination file FROM_FAB,- FROM_RAB,- TO_FAB,- TO_RAB,- @TO(AP) ; Destination file spec CALL TRANSFER_BLOCKS - FROM_RAB, TO_RAB ; Transfer the contents of file $CLOSE FAB=FROM_FAB ; Close the file pair $CLOSE FAB=TO_FAB ENDIF UNTIL ; Loop if wildcards remain ENDIF DSB_LONG ;; Disable long branches for macros RET .PAGE .SBTTL OPEN_OUT - Setup and open destination file for output ;++ ; Functional Description: ; Routine to open/create the destination file. This routine handles ; any setup to the output file FAB and RAB needed to duplicate the ; characteristics of the input file. ; ; Calling Sequence: ; CALLS #5, OPEN_OUT ; ; Input Parameters: ; F_FAB - Address of source file FAB ; F_RAB - " " " RAB ; T_FAB - Address of destination file FAB ; T_RAB - " " " RAB ; T_SPEC - Address of destination filespec descriptor ; ; Output Parameters: NONE ; ; Implicit Inputs: NONE ; ; Implicit Outputs: NONE ; ; Procedures called: ; SYS$CREATE, SYS$CONNECT ; ; Completion Status: ; No status returned. Signals any fatal errors. ; ; Side Effects: NONE ; ;-- ; Local macros .MACRO COPY OFFSET,FROM=(R2),TO=(R3) MOV%EXTRACT(4,1,OFFSET) - OFFSET'FROM, OFFSET'TO .ENDM COPY ; Local symbols ; Parameters $OFFSET 4,POSITIVE,<- F_FAB,- F_RAB,- T_FAB,- T_RAB,- T_SPEC,- > CODE_SECTION .ENTRY OPEN_OUT,^M ; Register usage: ; R0-R1 - Scratch ; R2 - Address of input FAB ; R3 - Address of output FAB ; R4 - Scratch MOVL F_FAB(AP),R2 ; Setup base regs for FAB's MOVL T_FAB(AP),R3 MOVL T_SPEC(AP),R0 ; Get address of filespec desc MOVL DSC$A_POINTER(R0),- FAB$L_FNA(R3) ; Point dest FAB at file spec CVTWB DSC$W_LENGTH(R0),- FAB$B_FNS(R3) ; and set length ; Copy all relevant fields from input FAB to output FAB. Note that both ; FAB's point to the same XAB chain so no XAB fields need be copied. COPY FAB$B_BKS COPY FAB$B_FSZ COPY FAB$L_MRN COPY FAB$W_MRS COPY FAB$B_ORG COPY FAB$B_RAT COPY FAB$B_RFM COPY FAB$B_RTV ; Create the file $CREATE FAB=(R3) IF THEN SIGNAL - CODE1=R0 ; Signal fatal error ELSE MOVL T_RAB(AP),R3 ; Switch pointer to RAB $CONNECT - RAB=(R3) ; Connect a record stream IF THEN ; Signal any errors SIGNAL - CODE1=R0 ENDIF ENDIF RET .PAGE .SBTTL TRANSFER_BLOCKS - Move blocks from source to dest ;++ ; Functional Description: ; This routine uses RMS block I/O to move the contents of the ; source file to the destination file. ; ; Calling Sequence: ; CALLS #2,TRANSFER_BLOCKS ; ; Input Parameters: ; IN_RAB - Address of source file RAB ; OUT_RAB - Address of destination file RAB ; ; Output Parameters: ; Same as input. ; ; Implicit Inputs: NONE ; ; Implicit Outputs: NONE ; ; Procedures called: ; SYS$READ, SYS$WRITE ; ; Completion Status: ; Signals fatal errors. Returns non-fatal errors such as EOF ; ; Side Effects: NONE ; ;-- ; Local symbols ; Parameters $OFFSET 4,POSITIVE,<- IN_RAB,- OUT_RAB,- > BUF_SIZE = 4*512 ; Size of transfer buffer (n blocks) DATA_SECTION BUFFER: .BLKB BUF_SIZE ; Buffer for transfers CODE_SECTION .ENTRY TRANSFER_BLOCKS,^M ; Register usage: ; R0-R1 - Scratch ; R2 - Pointer to source RAB ; R3 - Pointer to destination RAB ; R4 - Scratch MOVL IN_RAB(AP),R2 ; Setup base regs for RAB's MOVL OUT_RAB(AP),R3 ; Setup the RAB's MOVW #BUF_SIZE,- RAB$W_USZ(R2) ; Set buffer size in source RAB MOVAL BUFFER,RAB$L_UBF(R2) ; and buffer address MOVAL BUFFER,RAB$L_RBF(R3) ; Set buffer address in dest RAB ; Loop reading blocks until error or EOF REPEAT $READ RAB=(R2) ; Read a buffer-ful IF THEN IF THEN BRW END_OF_FILE ; Break out on EOF ELSE SIGNAL - CODE1=R0 ; Signal any other error as fatal ENDIF ENDIF MOVW RAB$W_RSZ(R2),- RAB$W_RSZ(R3) ; Copy actual data length to output ; RAB $WRITE RAB=(R3) ; and write data IF THEN SIGNAL - CODE1=R0 ; Signal any other error as fatal ENDIF UNTIL END_OF_FILE: RET .PAGE .SBTTL SCR_OUT - Screen output routines ;++ ; Functional Description: ; These routines are used to output screen messages to the user's ; terminal. They use the VAX RTL screen formatting package to ; perform the actual output. The screen is considered to be ; broken into SCR_C_LAST windows. Each type of message is ; displayed in its specified window. The message can be displayed at ; a specified line within the window, at the current, or next available ; line. Other entry points allow resetting the next line back to the ; beginning of the window and clearing the screen. No effort is made ; to protect against long messages wrapping around to another line. ; ; Calling Sequence: ; CALLS #3, SCR_OUT ; CALLS #0, SCR_ERASE_SCREEN ; CALLS #1, SCR_RESET_WINDOW ; ; Input Parameters: ; SCR_OUT: ; OUTSTR - Address of descriptor for message to be output. ; WINDOW - Code number for window to be used. ; SCR_C_HEADW, SCR_C_NODEW, SCR_C_FILEW, SCR_C_STATUSW ; SCR_C_LAST ; POS_IN_WINDOW - Position in window (1-n), or ; SCR_C_NEXT - display on next line in window ; SCR_C_CURRENT - display on current line ; ; SCR_ERASE: ; NONE ; ; SCR_RESETW: ; RWINDOW - Code number for window to be reset ; ; Output Parameters: NONE ; ; Implicit Inputs: NONE ; ; Implicit Outputs: NONE ; ; Procedures called: ; SCR$ERASE_PAGE, SCR$ERASE_LINE, SCR$PUT_SCREEN ; ; Completion Status: ; No error status returned. Fatal errors are signaled and processed ; by the condition handler. ; ; Side Effects: NONE ; ;-- ; External symbols ; Codes for display window. The ordering here must correspond to the ; entries in SCR_WINDOW_OFFSET. $EQULST SCR_C_,,0,1,<- - ; Headings window - ; Node window - ; File window - ; Status messages window - ; Special info window - ; Last line on screen > ; Special codes for message position. ; Values > 0 imply actual line within window $EQULST SCR_C_,,0,-1,<- - ; Output on next available line - ; Output on current line > ; Local values ; Parameters $OFFSET 4,POSITIVE,<- OUTSTR,- ; String descriptor address WINDOW,- ; Window number POS_IN_WINDOW,- ; Position within window > $OFFSET 4,POSITIVE,<- RWINDOW,- > ; Window number to be reset ; Local storage DATA_SECTION SCR_NEXT_LINE: VECTOR SCR_C_LAST ; Vector of next line numbers for ; each window. CONSTANT_SECTION ; Vector of offsets to beginning of each window on screen. ; Note these are offsets (zero relative) although screen lines are line ; numbers (1 relative). SCR_WINDOW_OFFSET: .LONG 0 ; Header .LONG 2 ; Node .LONG 7 ; File .LONG 12 ; Status .LONG 20 ; Special .LONG 23 ; Last line CODE_SECTION .ENTRY SCR_OUT,^M ; Register usage: ; R0-R1 - Scratch. Modified. ; R2 - Window number. ; R3 - Absolute line number to receive record. MOVL WINDOW(AP),R2 ; Get window number IF THEN IF THEN ; If NEXT, display on next line, else display on current line INCL SCR_NEXT_LINE[R2] ; Bump count for next line ENDIF ADDL3 SCR_NEXT_LINE[R2],- SCR_WINDOW_OFFSET[R2],- R3 ; Compute actual line to use ELSE ; Display at specified line ADDL3 POS_IN_WINDOW(AP),- SCR_WINDOW_OFFSET[R2],- R3 ; Compute actual line to use ENDIF CALL SCR$ERASE_LINE R3,#1 ; Clear out the line before writing IF THEN CALL SCR$PUT_SCREEN - @OUTSTR(AP) ; Output the string ENDIF IF THEN ; Signal any errors SIGNAL - CODE1=R0 ; Signal the error ENDIF RET .ENTRY SCR_RESET_WINDOW,^M<> ; Register usage: ; R0 - Scratch. Modified MOVL RWINDOW(AP),R0 ; Get window number CLRL SCR_NEXT_LINE[R0] ; Reset window to first line RET .ENTRY SCR_ERASE_SCREEN,^M<> ; Register usage: ; R0,R1 - Scratch. Modified. CALL SCR$ERASE_PAGE #1, #1 ; Erase entire page IF THEN SIGNAL - CODE1=R0 ; Signal the error ENDIF RET .PAGE .SBTTL SCR_IN - Read input from the terminal ;++ ; Functional Description: ; This routine is used to read input from the terminal. Input is ; read into a local buffer and then returned using the string ; descriptor passed as a parameter. Input is converted to upper ; case. The optional second parameter is a flag; if set it indicates ; the read should be made without echoing the input. ; ; Calling Sequence: ; CALLS #2, SCR_IN ; ; Input Parameters: ; NOECHO - Longword flag that echoing is to be supressed ; ; Output Parameters: ; INPUT_STR - Address of return descriptor for input read. ; ; Implicit Inputs: NONE ; ; Implicit Outputs: NONE ; ; Procedures called: ; SYS$GET, SYS$OPEN, SYS$CONNECT, OTS$COPY_R_DX, STR$UPCASE ; ; Completion Status: ; Signals fatal errors. Returns non-fatal status in R0, including ; EOF. ; ; Side Effects: ; On first call, SYS$INPUT is opened for input and a record stream ; is connected. ; ;-- ; Local symbols ; Parameters $OFFSET 0, POSITIVE,<- NR_PARAM,- ; Number of parameters INPUT_STR,- ; Descriptor address NOECHO,- ; Noecho flag > SCR_BUFFER_SZ = 256 ; Size of readin buffer ; Local storage DATA_SECTION SCR_BUFFER: .BLKB SCR_BUFFER_SZ ; Buffer for input lines .ALIGN LONG SCR_FAB: $FAB FAC=GET,- FNM= ; FAB for input SCR_RAB: $RAB FAB=SCR_FAB,- UBF=SCR_BUFFER,- USZ=SCR_BUFFER_SZ ; RAB for input CODE_SECTION .ENTRY SCR_IN,^M ; Register usage: ; R0-R1 - Scratch. ; R2 - Address of input RAB ; R3 - Scratch MOVAB SCR_RAB,R2 ; Get RAB address ; Initialize on first call IF THEN ; Open file and connect record stream $OPEN FAB=SCR_FAB IF THEN ; Signal any errors SIGNAL CODE1=R0 ENDIF $CONNECT RAB=SCR_RAB IF THEN ; Signal any errors SIGNAL CODE1=R0 ENDIF ENDIF ; Select echo option IF OR - THEN ; If flag omitted or zero, echo BICL2 #RAB$M_RNE, RAB$L_ROP(R2) ; Clear NOECHO bit ELSE BISL2 #RAB$M_RNE, RAB$L_ROP(R2) ; Set NOECHO bit ENDIF $GET RAB=SCR_RAB ; Read from terminal IF THEN IF THEN ; Signal all errors except EOF SIGNAL - CODE1=R0 ; Signal error ENDIF ELSE ; Return string read. CALL OTS$SCOPY_R_DX - @RAB$W_RSZ(R2),- @RAB$L_RBF(R2),- @INPUT_STR(AP) ; Copy data to return string CALL STR$UPCASE - @INPUT_STR(AP),- @INPUT_STR(AP) ; Uppercase the string ENDIF RET .PAGE .SBTTL TRANSLATE_LOGICAL - Translate logical name ;++ ; Functional Description: ; General purpose routine to recursivly translate a logical name ; until all levels of translation have been made. This routine ; searches all logical name tables for a match. This routine is ; reentrant and position-independent. ; ; Calling Sequence: ; CALLS #3, TRANSLATE_LOGICAL ; ; Input Parameters: ; LOGICAL - Address of descriptor to logical name ; ; Output Parameters: ; EQUIV - Address of descriptor of buffer to receive translation. ; EQUIV_LEN - Address of a word to receive actual length of translation. ; ; Implicit Inputs: NONE ; ; Implicit Outputs: NONE ; ; Procedures called: ; SYS$TRNLOG ; ; Completion Status: ; Returns any status returnable by SYS$TRNLOG. If no translation is ; found, SS$_NOTRAN is returned. If at least one translation is found, ; SS$_NORMAL is returned. ; ; Side Effects: NONE ; ;-- ; Local symbols ; Parameters $OFFSET 4,POSITIVE,<- LOGICAL,- EQUIV,- EQUIV_LEN,- > ; Offsets to scratch space allocated on stack $OFFSET 0,NEGATIVE,<- ,- ; Descriptor 1 ,- ; Descriptor 2 ,- ; Buffer for translation ,- ; Amount of space needed > CODE_SECTION .ENTRY TRANSLATE_LOGICAL,^M ; Register usage ; R0-R5 - Scratch MOVAB SCR_SZ(SP),SP ; Allocate scratch space on stack ; Setup descriptors for first tranlation MOVAB BUF(FP),D2+4(FP) ; Setup descriptors to point to buffer MOVAB BUF(FP),D1+4(FP) MOVW #63,D2(FP) ; Set length to max for equiv name. $TRNLOG_S - LOGNAM=@LOGICAL(AP),- RSLLEN=D1(FP),- RSLBUF=D2(FP) ; Do first translation BLBS R0,10$ ; Branch if no real errors RET ; Return any error status 10$: CMPL R0,#SS$_NOTRAN ; Was there a translation? BEQL NO_TRAN ; Branch if not ; We have already written the translated string length into D1. D2 is ; still correctly pointing at the buffer. 15$: MOVAL D1(FP),R0 ; Get pointer to descriptor CMPB @4(R0),#^X1B ; Does equiv name contain ESC? BNEQ 17$ ; Branch if not ADDL2 #4,4(R0) ; Adjust descriptor past header SUBW2 #4,(R0) 17$: $TRNLOG_S - LOGNAM=D1(FP),- RSLLEN=D1(FP),- RSLBUF=D2(FP) ; Translate again BLBS R0,20$ ; Branch if no real error RET ; Return error status 20$: CMPL R0,#SS$_NOTRAN ; Was there a translation? BNEQ 15$ ; If so, try again. MOVZWL #SS$_NORMAL,R0 ; We had at least one successful ; translation. Return full success. ; Copy result from scratch buffer to result NO_TRAN: MOVW D1(FP),@EQUIV_LEN(AP) ; Return result string length PUSHL R0 ; Save return status MOVL EQUIV(AP),R1 ; Get address of result descriptor MOVC5 D1(FP), BUF(FP),- #^A/ /,(R1),@4(R1) ; Move the string TSTL R0 ; Were there unmoved source chars? BEQL 10$ ; Branch if not MOVZWL #SS$_RESULTOVF,(SP) ; Replace saved status with error. 10$: POPL R0 ; Restore saved status RET .END FTP