y2 MGFTP026.G1] MGFTP026.GBACKUP/INTERCHANGE/BLOCK=8192 FTP_SRC_FILES.TXT;,[-.SOURCE]*.B32;,*.R32;,*.MMS;,*.MSG;,*.CLD;,*.MAR;,*.OPT; MG_KIT:[MGFTP]MGFTP026.G/SAVE GOATHUNTER )+V7.2 _CAESAR:: _$1$DKA100: V7.2  *[MGFTP.KIT]FTP_SRC_FILES.TXT;3+,%b ./ 4;f-~J0123KPWO 56OX7&89/RFÞGHJ!MadGoat FTP Source files!!BLISS modules4FTP_TMP ACTIVITY_LOG.B32 MADGOAT_ROOT:[SOURCES.FTP]-FTP_TMP ANON.B32 MADGOAT_ROOT:[SOURCES.FTP]2FTP_TMP CMD_PARSE.B32 MADGOAT_ROOT:[SOURCES.FTP]2FTP_TMP CONDITION.B32 MADGOAT_ROOT:[SOURCES.FTP]2FTP_TMP CONTROL_C.B32 MADGOAT_ROOT:[SOURCES.FTP];FTP_TMP COPY_DIR_FTP_SUPPORT.B32 MADGOAT_ROOT:[SOURCES.FTP]-FTP_TMP DIR.B32 MADGOAT_ROOT:[SOURCES.FTP]2FTP_TMP FILE_INFO.B32 MADGOAT_ROOT:[SOURCES.FTP]-FTP_TMP FTP.B32 MADGOAT_ROOT:[SOURCES.FTP]2FTP_TMP FTP_ALIAS.B32 MADGOAT_ROOT:[SOURCES.FTP]6FTP_TMP FTP_ALIAS_CMDS.B32 MADGOAT_ROOT:[SOURCES.FTP]4FTP_TMP FTP_ANNOUNCE.B32 MADGOAT_ROOT:[SOURCES.FTP]1FTP_TMP FTP_DTON.B32 MADGOAT_ROOT:[SOURCES.FTP]1FTP_TMP FTP_DTOT.B32 MADGOAT_ROOT:[SOURCES.FTP]1FTP_TMP FTP_FILE.B32 MADGOAT_ROOT:[SOURCES.FTP]1FTP_TMP FTP_FTON.B32 MADGOAT_ROOT:[SOURCES.FTP]4FTP_TMP FTP_HANDLER.B32 MADGOAT_ROOT:[SOURCES.FTP]1FTP_TMP FTP_HELP.B32 MADGOAT_ROOT:[SOURCES.FTP]/FTP_TMP FTP_IN.B32 MADGOAT_ROOT:[SOURCES.FTP]2FTP_TMP FTP_INPUT.B32 MADGOAT_ROOT:[SOURCES.FTP]4FTP_TMP FTP_LISTENER.B32 MADGOAT_ROOT:[SOURCES.FTP]9FTP_TMP FTP_LISTENER_CMDS.B32 MADGOAT_ROOT:[SOURCES.FTP]8FTP_TMP FTP_LISTENER_MEM.B32 MADGOAT_ROOT:[SOURCES.FTP]4FTP_TMP FTP_NETWORK.B32 MADGOAT_ROOT:[SOURCES.FTP]1FTP_TMP FTP_NTOF.B32 MADGOAT_ROOT:[SOURCES.FTP]1FTP_TMP FTP_NTOT.B32 MADGOAT_ROOT:[SOURCES.FTP]2FTP_TMP FTP_QUEUE.B32 MADGOAT_ROOT:[SOURCES.FTP]3FTP_TMP FTP_SERVER.B32 MADGOAT_ROOT:[SOURCES.FTP]7FTP_TMP FTP_SERVER_CMDS.B32 MADGOAT_ROOT:[SOURCES.FTP]6FTP_TMP FTP_SET_PARAMS.B32 MADGOAT_ROOT:[SOURCES.FTP]-FTP_TMP HASH.B32 MADGOAT_ROOT:[SOURCES.FTP].FTP_TMP LOGIN.B32 MADGOAT_ROOT:[SOURCES.FTP]7FTP_TMP LOG_TO_LISTENER.B32 MADGOAT_ROOT:[SOURCES.FTP]-FTP_TMP MEM.B32 MADGOAT_ROOT:[SOURCES.FTP]/FTP_TMP NETLIB.B32 MADGOAT_ROOT:[SOURCES.FTP]3FTP_TMP PARSE_MODE.B32 MADGOAT_ROOT:[SOURCES.FTP]3FTP_TMP PARSE_PASV.B32 MADGOAT_ROOT:[SOURCES.FTP]3FTP_TMP PARSE_PORT.B32 MADGOAT_ROOT:[SOURCES.FTP]3FTP_TMP PARSE_STRU.B32 MADGOAT_ROOT:[SOURCES.FTP]3FTP_TMP PARSE_TYPE.B32 MADGOAT_ROOT:[SOURCES.FTP]-FTP_TMP PORT.B32 MADGOAT_ROOT:[SOURCES.FTP]1FTP_TMP ROUTINES.B32 MADGOAT_ROOT:[SOURCES.FTP]/FTP_TMP STRING.B32 MADGOAT_ROOT:[SOURCES.FTP]-FTP_TMP TEXT.B32 MADGOAT_ROOT:[SOURCES.FTP]/FTP_TMP VMS054.B32 MADGOAT_ROOT:[SOURCES.FTP]!!BLISS library files!1FTP_TMP ANON_FTP.R32 MADGOAT_ROOT:[SOURCES.FTP]-FTP_TMP CLI.R32 MADGOAT_ROOT:[SOURCES.FTP]/FTP_TMP FIELDS.R32 MADGOAT_ROOT:[SOURCES.FTP]-FTP_TMP FTP.R32 MADGOAT_ROOT:[SOURCES.FTP]/FTP_TMP FTPSRV.R32 MADGOAT_ROOT:[SOURCES.FTP]2FTP_TMP FTP_ALIAS.R32 MADGOAT_ROOT:[SOURCES.FTP]5FTP_TMP FTP_CONN_INFO.R32 MADGOAT_ROOT:[SOURCES.FTP]/FTP_TMP FTP_IN.R32 MADGOAT_ROOT:[SOURCES.FTP]4FTP_TMP FTP_LISTENER.R32 MADGOAT_ROOT:[SOURCES.FTP]0FTP_TMP FTP_MSG.R32 MADGOAT_ROOT:[SOURCES.FTP]/FTP_TMP NETAUX.R32 MADGOAT_ROOT:[SOURCES.FTP]/FTP_TMP NETLIB.R32 MADGOAT_ROOT:[SOURCES.FTP]-FTP_TMP TEXT.R32 MADGOAT_ROOT:[SOURCES.FTP]-FTP_TMP TPA.R32 MADGOAT_ROOT:[SOURCES.FTP]0FTP_TMP VERSION.R32 MADGOAT_ROOT:[SOURCES.FTP]!! MMS/MMK file!0FTP_TMP DESCRIP.MMS MADGOAT_ROOT:[SOURCES.FTP]!! Message files!/FTP_TMP FTPSRV.MSG MADGOAT_ROOT:[SOURCES.FTP]0FTP_TMP FTP_MSG.MSG MADGOAT_ROOT:[SOURCES.FTP]!! Command definition utilities!0FTP_TMP FTP_CMD.CLD MADGOAT_ROOT:[SOURCES.FTP]4FTP_TMP FTP_NOREPLY.CLD MADGOAT_ROOT:[SOURCES.FTP]2FTP_TMP FTP_PARSE.CLD MADGOAT_ROOT:[SOURCES.FTP]9FTP_TMP FTP_PARSE_NO_HOST.CLD MADGOAT_ROOT:[SOURCES.FTP]2FTP_TMP FTP_QUIET.CLD MADGOAT_ROOT:[SOURCES.FTP]8FTP_TMP FTP_SERVER_PARSE.CLD MADGOAT_ROOT:[SOURCES.FTP]!! Miscellaneous!-FTP_TMP HPWD.MAR MADGOAT_ROOT:[SOURCES.FTP]/FTP_TMP NETLIB.OPT MADGOAT_ROOT:[SOURCES.FTP]2FTP_TMP NETLIBDEF.R32 MADGOAT_ROOT:[SOURCES.FTP] |{ MGFTP026.G I [MGFTP.SOURCE]ACTIVITY_LOG.B32;3C *[MGFTP.SOURCE]ACTIVITY_LOG.B32;3+, ./ 4C-I0123KPWO56 ^R7^R89/RFÞGHJ  ! MadGoat FTP client and server!?! Authors: Chad Wilson, Dale Moore, Tod Shannon, Bruce Miller,,! Marc Shannon, Henry Miller, John Clement,1! Matt Madison, Darrell Burkhead, Hunter Goatley!6! Copyright 1986, 1992, Carnegie Mellon University.<! Copyright 1994, MadGoat Software. All rights reserved.!?! Permission is granted for not-for-profit redistribution,?! provided all source and object code remain unchanged from?! the original distribution, and that all copyright notices! remain intact.!MODULE ACTIVITY_LOG( ADDRESSING_MODE( EXTERNAL = LONG_RELATIVE, NONEXTERNAL = LONG_RELATIVE), IDENT = 'V2.4',& LIST(ASSEMBLY, NOBINARY, NOEXPAND)) =BEGIN!++! ACTIVITY_LOG.B32!! Description:!C! This module contains routines to take the place of CMU's activity! logging for UCX.!.! Written By: Darrell Burkhead 16-APR-1993 WKU!! Modifications:!)! V2.4 Hunter Goatley 11-MAR-1998 13:567! Modify to append to existing file, instead of always! creating a new file.!!--LIBRARY 'SYS$LIBRARY:STARLET';OWN. act_fab : $FAB( FNM = 'MADGOAT_FTP_ACTIVITY',# DNM = 'MADGOAT_ROOT:[LOGS].LOG', FAC = PUT, FOP = CIF, ORG = SEQ, RAT = CR, RFM = VAR, SHR = GET), act_rab : $RAB( FAB = act_fab, RAC = SEQ, ROP = EOF); %SBTTL 'CREATE_ACT_LOG'GLOBAL ROUTINE create_act_log=!++!! Routine: CREATE_ACT_LOG!! Description:!<! This routine creates the activity log for this FTP server.! ! Parameters:!! None.! ! Returns:!! RMS$_NORMAL, success!!--BEGINREGISTER status : UNSIGNED LONG;< status = $CREATE( FAB = act_fab ); !Create the log file' IF NOT .status THEN RETURN .status;: status = $CONNECT( RAB = act_rab ); !Connect a stream RETURN .status;END; %SBTTL 'WRITE_ACT_LOG')GLOBAL ROUTINE write_act_log(act_line_a)=!++!! Routine: WRITE_ACT_LOG!! Description:!1! This routine writes a line to the activity log.! ! Parameters:!C! act_line_a - address of a descriptor containing the line to write! ! Returns:!! RMS$_NORMAL, success!!--BEGINREGISTER status : UNSIGNED LONG;BIND" act_line = .act_line_a : $BBLOCK;1 act_rab[RAB$W_RSZ] = .act_line[DSC$W_LENGTH];2 act_rab[RAB$L_RBF] = .act_line[DSC$A_POINTER];4 status = $PUT( RAB = act_rab ); !Write the line IF .status* THEN status = $FLUSH( RAB = act_rab ); .statusEND;ENDELUDOM*[MGFTP.SOURCE]ANON.B32;22+,|B.4/ 4K42-I0123KPWO556 2_"n7%89/RFÞGHJ ! MadGoat FTP client and server!?! Authors: Chad Wilson, Dale Moore, Tod Shannon, Bruce Miller,,! Marc Shannon, Henry Miller, John Clement,1! Matt Madison, Darrell Burkhead, Hunter Goatley!6! Copyright 1986, 1992, Carnegie Mellon University.B! Copyright 1994, 1996, MadGoat Software. All rights reserved.!?! Permission is granted for not-for-profit redistribution,?! provided all source and object code remain unchanged from?! the original distribution, and that all copyright notices! remain intact.! %TITLE 'ANON'MODULE anon(IDENT = 'V2.2',J ADDRESSING_MODE(EXTERNAL=LONG_RELATIVE, NONEXTERNAL=LONG_RELATIVE)) =BEGIN!++! FACILITY: FTP! ! ABSTRACT:!C! This module provides routines for implementing ANONYMOUS FTP in! the FTP_SERVER.!! MODULE DESCRIPTION:!H! This module contains routines for logging ANONYMOUS FTP transactions6! and controlling ANONYMOUS's access to directories.!! AUTHOR: M. Madison!! CREATION DATE: 11-AUG-1988!! MODIFICATION HISTORY:!)! V2.2 Hunter Goatley 5-AUG-1996 23:06=! Added init_rdirq() and add_to_rdirq() to a) finish support8! for "~username" for anonymous connections and b) make7! these routines more efficient by not translating the/! logical names for every check_access() call.!,! V2.1-1 Darrell Burkhead 16-SEP-1994 11:06=! Leave one of the .'s on the end of the directory string if>! it ends in "..." This allows skip_000000_dirs to strip off<! the 000000 directory for something like ROOT:[000000...].!*! V2.1 Darrell Burkhead 12-JUL-1994 15:056! Added support for dev:[*...] directory names in the<! MADGOAT_FTP_DIRS and MADGOAT_FTP_user_DIRS logical names.!+! V2.0-1 Hunter Goatley 16-MAY-1994 16:03<! Fixed handling of anonymous ftp dirs logical so that it's1! not wiped out if the log file can't be opened.!)! V2.0 Hunter Goatley 27-SEP-1993 07:34<! Modified to use ARGPTR so it will work under AXP. Though;! not the most efficient method, it was the easiest to do.,! Added MADGOAT_ to FTP_ANON logical names.!-- COMPILETIME debug = 0;LIBRARY 'SYS$LIBRARY:STARLET';LIBRARY 'FTP';LIBRARY 'FIELDS'; %IF debug%THEN LIBRARY 'NETAUX';%FIC%IF debug %THEN %MESSAGE('DEBUG mode is enabled in ANON.B32!') %FI;EXTERNAL ROUTINE2 LIB$GET_VM : BLISS ADDRESSING_MODE(GENERAL),2 LIB$FREE_VM : BLISS ADDRESSING_MODE(GENERAL), text_init, text_append;FORWARD ROUTINE anon_log_open, anon_log_fao, init_rdirq, add_to_rdirq, check_access, check_directory, skip_000000_dirs;LITERAL bufsize = 256; _DEF(ABL) ABL_L_FABPTR = _LONG, ABL_L_RABPTR = _LONG,' ABL_Q_BUFDSC = _BYTES(DSC$C_S_BLN), _OVERLAY(ABL_Q_BUFDSC) ABL_W_BUFLEN = _WORD, ABL_B_DTYPE = _BYTE, ABL_B_CLASS = _BYTE, ABL_L_BUFPTR = _LONG, _ENDOVERLAY# ABL_T_BUFFER = _BYTES(bufsize),# ABL_T_FAB = _BYTES(FAB$C_BLN)," ABL_T_RAB = _BYTES(RAB$C_BLN) _ENDDEF(ABL); _DEF(TXT)!++! Description:!:! The text is implemented using the VAXes absolute queues.>! Absolute queues are very similar to doubly circularly linked?! lists. The desc in the record is a dynamic string descriptor! used to store the text.!-- TXT_L_FLINK = _LONG, TXT_L_BLINK = _LONG,% TXT_Q_DESC = _BYTES(DSC$C_S_BLN), _OVERLAY(TXT_Q_DESC) TXT_W_LENGTH = _WORD, TXT_B_DTYPE = _BYTE, TXT_B_CLASS = _BYTE, TXT_A_POINTER = _LONG _ENDOVERLAY! TXT_Q_DESC = _QUAD _ENDDEF(TXT);BIND@ ! LOG_DIR is also used in a literal string as DNM for a FAB.< madgoat_ftp_log_dir = %ASCID'MADGOAT_FTP_ANON_LOG_DIR';EXTERNAL. madgoat_ftp_name_table, !Defined in FTP_IN exec_mode, !... lnm$dcl_logical, !... madgoat_ftp_dirs; !...OWN2 anonymous_ftp_dirs_log : $BBLOCK[DSC$K_S_BLN]; %SBTTL 'ANON_LOG_OPEN';GLOBAL ROUTINE anon_log_open(ablock_a_a, anon_dir_log_a) = BEGIN!++! FUNCTIONAL DESCR MGFTP026.G|BI[MGFTP.SOURCE]ANON.B32;22K4 IPTION:!?! This routine opens a log file for an ANONYMOUS FTP session.!A! RETURNS: cond_value, longword(unsigned), write only, by value! ! PROTOTYPE:!! anon_log_open!! IMPLICIT INPUTS: LOG_OPEN!&! IMPLICIT OUTPUTS: FAB, RAB, LOG_OPEN!! COMPLETION CODES:!2! SS$_NORMAL: normal successful completion.!! SIDE EFFECTS:! ! None.!-- EXTERNAL ROUTINE. STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL),1 LIB$SYS_TRNLOG : BLISS ADDRESSING_MODE(GENERAL); BIND* ablock_a = .ablock_a_a : REF ABLDEF,* anon_dir_log = .anon_dir_log_a : $BBLOCK; LOCAL log_dir: $BBLOCK [DSC$K_S_BLN], status; %IF debug! %THEN print('anon_log_open'); %FI !C ! Copy anonymous ftp directories logical name to OWN variable. !* $INIT_DYNDESC(anonymous_ftp_dirs_log);6 STR$COPY_DX(anonymous_ftp_dirs_log, anon_dir_log); ablock_a = 0;6 status = LIB$GET_VM(%REF(ABL_S_ABLDEF), ablock_a);' IF NOT .status THEN RETURN(.status) ELSE BEGIN BIND# ablk = .ablock_a : ABLDEF;- ablk[ABL_L_BUFPTR] = ablk[ABL_T_BUFFER];" ablk[ABL_W_BUFLEN] = bufsize;' ablk[ABL_B_DTYPE] = DSC$K_DTYPE_T;' ablk[ABL_B_CLASS] = DSC$K_CLASS_S; $INIT_DYNDESC(log_dir);: status = LIB$SYS_TRNLOG(madgoat_ftp_log_dir, 0, log_dir);' IF .status AND .status NEQU SS$_NOTRAN THEN $FAB_INIT( FAB = ablk[ABL_T_FAB], FNM = 'ANON_FTP_LOG',( DNM = 'MADGOAT_FTP_ANON_LOG_DIR:.LOG', FAC = PUT, SHR = SHRPUT, RFM = VAR, RAT = CR) ELSE $FAB_INIT( FAB = ablk[ABL_T_FAB], FNM = 'ANON_FTP_LOG', DNM = 'SYS$LOGIN:.LOG', FAC = PUT, SHR = SHRPUT, RFM = VAR, RAT = CR);- status = $CREATE(FAB = ablk[ABL_T_FAB]); IF .status THEN BEGIN $RAB_INIT( RAB = ablk[ABL_T_RAB], FAB = ablk[ABL_T_FAB], RBF = ablk[ABL_T_BUFFER]);. status = $CONNECT(RAB = ablk[ABL_T_RAB]); END; IF NOT .status THEN BEGIN %IF debug8 %THEN print('anon_log_open: status = !XL', .status); %FI' $CLOSE(FAB = ablk[ABL_T_FAB]);3 LIB$FREE_VM(%REF(abl_s_abldef), ablock_a); ablock_a = 0; RETURN(.status); END; END; SS$_NORMALEND; ! anon_log_open %SBTTL 'ANON_LOG_CLOSE'*GLOBAL ROUTINE anon_log_close(ablock_a) = BEGIN!++! FUNCTIONAL DESCRIPTION:!6! This routine closes the ANONYMOUS FTP session log.!A! RETURNS: cond_value, longword(unsigned), write only, by value! ! PROTOTYPE:!! ANON_LOG_CLOSE!!! IMPLICIT INPUTS: FAB, LOG_OPEN!!! IMPLICIT OUTPUTS: FAB, LOG_OPEN!! COMPLETION CODES:!2! SS$_NORMAL: normal successful completion.!! SIDE EFFECTS:! ! None.!-- BIND ablk = .ablock_a : ABLDEF; %IF debug" %THEN print('ANON_LOG_CLOSE'); %FI IF .ablock_a NEQ 0 THEN BEGIN# $CLOSE(fab = ablk[ABL_T_FAB]);/ LIB$FREE_VM(%REF(abl_s_abldef), ablock_a); END; SS$_NORMALEND; ! ANON_LOG_CLOSE %SBTTL 'ANON_LOG_FAO'(GLOBAL ROUTINE anon_log_fao(ablock_a) = BEGIN!++! FUNCTIONAL DESCRIPTION:!=! This routine formats a string using $FAO and writes it to! the ANONYMOUS FTP log.!A! RETURNS: cond_value, longword(unsigned), write only, by value! ! PROTOTYPE:!! anon_log_fao!)! IMPLICIT INPUTS: LOG_OPEN, RAB, LOGBUF!! IMPLICIT OUTPUTS: RAB, LOGBUF!! COMPLETION CODES:!2! SS$_NORMAL: normal successful completion.!! SIDE EFFECTS:! ! None.!-- BUILTIN ARGPTR; BIND' arglst = ARGPTR() : VECTOR[,LONG], ablk = .ablock_a : ABLDEF; LOCAL status; %IF debug %THEN print('anon_log_fao'); %FI/ IF (.ablock_a NEQ 0) AND (.arglst[0] GTR 1) THEN BEGIN BIND+ rab = ablk[ABL_T_RAB] : $RAB_DECL;" status = (IF .arglst[0] GTR 2$ THEN $FAOL( CTRSTR = .arglst[2], OUTLEN = rab[RAB$W_RSZ], OUTBUF = ablk[ABL_Q_BUFDSC], PRMLST = arglst[3])E ELSE $FAO(.arglst[2], rab[RAB$W_RSZ], ablk[ABL_Q_BUFDSC])); IF .status THEN BEGIN $PUT(RAB = rab); %IF debugB %THEN print('anon_log_fao : Message = "!AD"',.rab[RAB$W_RSZ], .rab[RAB$L_RBF]); %FI END; END; SS$_NORMALEND; ! anon_log_fao +GLOBAL ROUTINE init_rdirq (rdirq_a, anon) =BEGIN!++! FUNCTIONAL DESCRIPTION:!H! This routine translates the FTP_DIRS logical and builds a text queue)! of the logical's equivalence strings.!B! RETURNS: cond_value, longword (unsigned), write only, by value! ! PROTOTYPE:!! check_access! ! INPUTS:,! FSPEC: File name or directory descriptor.! Anon: 0,1 for anonymous FTP..! Restrict: Access restrictions for this user.!! IMPLICIT INPUTS: None.!! IMPLICIT OUTPUTS: None.!! COMPLETION CODES:!>! SS$_NORMAL: normal successful completion - access OK.(! any non-success: access not allowed.!! SIDE EFFECTS:! ! None.!-- BIND% rdirq = .rdirq_a : VOLATILE $BBLOCK; LOCAL/ lnmlst1 : VOLATILE $ITMLST_DECL(ITEMS=1),/ lnmlst2 : VOLATILE $ITMLST_DECL(ITEMS=2),* lnmbuf : VOLATILE VECTOR[255, BYTE], lnmlen : VOLATILE WORD, lnmidx : VOLATILE, maxlnm : VOLATILE," tmp_desc : $BBLOCK [DSC$K_S_BLN], status;2 text_init (rdirq); !Initialize the text queue %IF debug1 %THEN print('init_rdirq : In init_rdirq()!'); %FI !J ! Next, check whether the appropriate restrict logical is defined. If# ! not, assume that FSpec is OK. ! $ITMLST_INIT(ITMLST=lnmlst1,I (ITMCOD=LNM$_MAX_INDEX, BUFADR=maxlnm, BUFSIZ=%ALLOCATION(maxlnm))); IF .anon THEN BEGIN %IF debugC %THEN print('init_rdirq : dirs = !AS', anonymous_ftp_dirs_log); %FI status = $TRNLNM(# TABNAM = madgoat_ftp_name_table, ACMODE = exec_mode,# LOGNAM = anonymous_ftp_dirs_log, ITMLST = lnmlst1); END ELSE status = $TRNLNM( TABNAM = LNM$DCL_LOGICAL, LOGNAM = madgoat_ftp_dirs, ITMLST = lnmlst1);# IF NOT .status OR .maxlnm LSS 0A THEN RETURN(SS$_NORMAL); !No restrict dirs, leave queue empty+ tmp_desc [DSC$B_DTYPE] = DSC$K_DTYPE_T;+ tmp_desc [DSC$B_CLASS] = DSC$K_CLASS_S;& tmp_desc [DSC$A_POINTER] = lnmbuf; $ITMLST_INIT(ITMLST=lnmlst2,D (ITMCOD=LNM$_INDEX, BUFADR=lnmidx, BUFSIZ=%ALLOCATION(lnmidx)),D (ITMCOD=LNM$_STRING, BUFADR=lnmbuf, BUFSIZ=%ALLOCATION(lnmbuf), RETLEN=lnmlen)); !G ! Next, loop through the logicals in the restrict list, adding each) ! translation to the directory queue. ! lnmidx = 0;" WHILE (.lnmidx LEQ .maxlnm) DO BEGIN IF .anon THEN status = $TRNLNM(# TABNAM = madgoat_ftp_name_table, ACMODE = exec_mode,# LOGNAM = anonymous_ftp_dirs_log, ITMLST = lnmlst2) ELSE status = $TRNLNM( TABNAM = LNM$DCL_LOGICAL, LOGNAM = madgoat_ftp_dirs, ITMLST = lnmlst2); IF .status THEN BEGIN' tmp_desc [DSC$W_LENGTH] = .lnmlen;# text_append (rdirq, tmp_desc); %IF debug= %THEN print('init_rdirq : Appending = "!AS"', tmp_desc); %FI END; lnmidx = .lnmidx + 1; END;) SS$_NORMAL !Return success to callerEND; .GLOBAL ROUTINE add_to_rdirq (rdirq_a, dsc_a) =BEGIN BIND rdirq = .jBU MGFTP026.G|BI[MGFTP.SOURCE]ANON.B32;22K4erdirq_a : TXTDEF, dsc = .dsc_a : $BBLOCK; LOCAL ptr : REF TXTDEF;( IF (.rdirq [TXT_L_FLINK] EQLA rdirq) THEN RETURN (SS$_NORMAL); !H ! See if this string is already in the queue. Do this here insteadH ! of calling text_in_que() for efficiency's sake, since the routine9 ! copies strings around and it's not necessary here. ! ptr = .rdirq [TXT_L_FLINK]; WHILE (.ptr NEQA rdirq) DO BEGIN6 IF (.ptr [TXT_W_LENGTH] EQLU .dsc [DSC$W_LENGTH]) AND7 (CH$EQL (.ptr [TXT_W_LENGTH], .ptr [TXT_A_POINTER],1 .dsc [DSC$W_LENGTH], .dsc [DSC$A_POINTER])) THEN EXITLOOP; ptr = .ptr [TXT_L_FLINK]; END;< IF (.ptr EQLA rdirq) !String wasn't in queue, so add it THEN BEGIN %IF debug3 %THEN print('add_to_dirq : append = !AS', .dsc_a); %FI text_append (rdirq, dsc); END;  RETURN (SS$_NORMAL);END; %SBTTL 'CHECK_ACCESS'@GLOBAL ROUTINE check_access(fspec_a, anon, restrict, rdirq_a) = BEGIN!++! FUNCTIONAL DESCRIPTION:!?! This routine checks to see if the device and directory of aI! file specification are in the list of device/directory specifications>! ok for use by ANONYMOUS. The logical name FTP_DIRS should6! hold that list. If FTP_DIRS does not exist in the?! system logical name table, access is automatically GRANTED.!B! RETURNS: cond_value, longword (unsigned), write only, by value! ! PROTOTYPE:!! check_access! ! INPUTS:,! FSPEC: File name or directory descriptor.! Anon: 0,1 for anonymous FTP..! Restrict: Access restrictions for this user.!! IMPLICIT INPUTS: None.!! IMPLICIT OUTPUTS: None.!! COMPLETION CODES:!>! SS$_NORMAL: normal successful completion - access OK.(! any non-success: access not allowed.!! SIDE EFFECTS:! ! None.!-- BIND- fspec = .fspec_a : $BBLOCK[DSC$K_S_BLN], rdirq = .rdirq_a : TXTDEF; LOCAL nam1_parsed : INITIAL(0),/ lnmlst1 : VOLATILE $ITMLST_DECL(ITEMS=1),/ lnmlst2 : VOLATILE $ITMLST_DECL(ITEMS=2),! fab1 : VOLATILE $FAB_DECL,! nam1 : VOLATILE $NAM_DECL,* espec1 : VOLATILE VECTOR[255, BYTE], fab2 : VOLATILE $FAB_DECL, nam2 : VOLATILE $FAB_DECL,* espec2 : VOLATILE VECTOR[255, BYTE],* lnmbuf : VOLATILE VECTOR[255, BYTE], lnmlen : VOLATILE WORD, lnmidx : VOLATILE, maxlnm : VOLATILE, ptr : REF TXTDEF, status; %IF debug4 %THEN print('check_access : FSPEC = !AS',fspec); %FI !F ! First determine whether we are restricted to the current workingE ! directory. If so, make sure FSpec is in the current directory. !/ IF (.restrict AND FTP$K_RESTRICT_CWD) NEQ 0 THEN BEGIN $NAM_INIT( NAM = nam1, ESA = espec1, ESS = %ALLOCATION(espec1), NOP = ); $FAB_INIT( FAB = fab1, FNA = .fspec[DSC$A_POINTER], FNS = .fspec[DSC$W_LENGTH], DNM = '*.*;*', NAM = nam1);9 IF NOT (status = $PARSE(FAB=fab1)) THEN RETURN(.status);+ nam1_parsed = 1; !Don't reparse this below $NAM_INIT( NAM = nam2, ESA = espec2, ESS = %ALLOCATION(espec2), NOP = ); $FAB_INIT( FAB = fab2, FNM = 'SYS$DISK:[]*.*;*', NAM = nam2);9 IF NOT (status = $PARSE(FAB=fab2)) THEN RETURN(.status);% status = check_directory(nam1,nam2);= IF NOT .status THEN RETURN(.status); !Not in the current dir END;! !K! ! Next, check whether the appropriate restrict logical is defined. If$! ! not, assume that FSpec is OK.! !!! $ITMLST_INIT(ITMLST=lnmlst1,J! (ITMCOD=LNM$_MAX_INDEX, BUFADR=maxlnm, BUFSIZ=%ALLOCATION(maxlnm)));! ! IF .anon ! THEN! BEGIN! %IF debugF! %THEN print('check_access : dirs = !AS', anonymous_ftp_dirs_log);! %FI! status = $TRNLNM($! TABNAM = madgoat_ftp_name_table,! ACMODE = exec_mode,$! LOGNAM = anonymous_ftp_dirs_log,! ITMLST = lnmlst1);! END! ELSE status = $TRNLNM(! TABNAM = LNM$DCL_LOGICAL,! LOGNAM = madgoat_ftp_dirs,! ITMLST = lnmlst1);!$! IF NOT .status OR .maxlnm LSS 0=! THEN RETURN(SS$_NORMAL); !No restrict dirs, grant access !? ! If the restricted directory queue is empty, grant access !$ IF (.rdirq [TXT_L_FLINK] EQLU 0) THEN RETURN (SS$_NORMAL); %IF debugF %THEN print('check_access : logical name defined, making checks'); %FI !@ ! Don't redo parsing the NAM for FSpec if it was done above. !n IF NOT .nam1_parsed  THEN BEGIN $NAM_INIT(S NAM = nam1,i ESA = espec1,o ESS = %ALLOCATION(espec1),$ NOP = ); $FAB_INIT( FAB = fab1, FNA = .fspec[DSC$A_POINTER], FNS = .fspec[DSC$W_LENGTH],1 DNM = '*.*;*', NAM = nam1);9 IF NOT (status = $PARSE(FAB=fab1)) THEN RETURN(.status);i END;i $ITMLST_INIT(ITMLST=lnmlst2,D (ITMCOD=LNM$_INDEX, BUFADR=lnmidx, BUFSIZ=%ALLOCATION(lnmidx)),D (ITMCOD=LNM$_STRING, BUFADR=lnmbuf, BUFSIZ=%ALLOCATION(lnmbuf), RETLEN=lnmlen));' IF NOT .nam1_parsedT THEN $NAM_INIT(N NAM = nam2,_ ESA = espec2,I ESS = %ALLOCATION(espec2), NOP = ); ptr = .rdirq [TXT_L_FLINK];g WHILE (.ptr NEQA rdirq) DO BEGIN $FAB_INIT(E FAB = fab2, FNA = .ptr [TXT_A_POINTER],u FNS = .ptr [TXT_W_LENGTH], DNM = '*.*;*', NAM = nam2); IF $PARSE(FAB=fab2) THENt BEGIN) status = check_directory(nam1,nam2);N7 IF .status THEN RETURN(SS$_NORMAL); !Found a match END;t ptr = .ptr [TXT_L_FLINK]; END;A%( !rJ ! Next, loop through the logicals in the restrict list. If a match is3 ! found, grant access. Otherwise, deny access.f !b lnmidx = 0;  WHILE .lnmidx LEQ .maxlnmy DO BEGIN IF .anon THEN status = $TRNLNM(e# TABNAM = madgoat_ftp_name_table,  ACMODE = exec_mode,# LOGNAM = anonymous_ftp_dirs_log,  ITMLST = lnmlst2) ELSE status = $TRNLNM(f TABNAM = LNM$DCL_LOGICAL, LOGNAM = madgoat_ftp_dirs,. ITMLST = lnmlst2);u IF .status THEN BEGINs $FAB_INIT( FAB = fab2,  FNA = lnmbuf,T FNS = .lnmlen, DNM = '*.*;*', NAM = nam2); IF $PARSE(FAB=fab2) THEN BEGIN6& status = check_directory(nam1,nam2);4 IF .status THEN RETURN(SS$_NORMAL); !Found a match END; END; lnmidx = .lnmidx + 1; END;P)%" RMS$_PRV !No match found aboveEND; ! check_access. u%SBTTL 'CHECK_DIRECTORY'*ROUTINE check_directory(nam1_a, nam2_a) = BEGIND!++ ! FUNCTIONAL DESCRIPTION:!F! This routine is used by check_access to test for directory equality.B! It returns a true (low bit set) value if nam1 refers to the same! directory as nam2.!EA! RETURNS: cond_value, longword(unsigned), write only, by valueR!I ! PROTOTYPE:!V! check_access!_ ! INPUTS:L<! nam1_a : Address of the NAM block for the first directory.=! nam2_a : Address of the NAM block for the second directory.! ! IMPLICIT INPUTS: None.r!! IMPLICIT OUTPUTS: None.a!s! COMPLETION CODES:!s>! SS$_NORMAL: normal successful completion - access OK.(! any non-success: access not allowed.!_! SIDE EFFECTS:_!D ! None.(!--_ BIND nam1 = .nam1_a : $BBLOCK, nam2 = .nam2_a : $BBLOCK; LOCAL_ l1, l2, desc1 : $BBLOCK[DSC$C_S_BLN]* PRESET([DSC$B_CLASS] = DSC$K_CLASS_S,$ [DSC$B_DTYPE] = DSC$K_DTYPE_T), desc2 : $BBLOCK[DSC$C_S_BLN]* PRESET([DP:6o MGFTP026.G|BI[MGFTP.SOURCE]ANON.B32;22K4'SC$B_CLASS] = DSC$K_CLASS_S,$ [DSC$B_DTYPE] = DSC$K_DTYPE_T), f1, f2, match : INITIAL(1),h dots_flag,u status; MACROe" concealed_delim = %STRING('][')%; LITERALk max_devnam = 64,3 concealed_delim_len = %CHARCOUNT(concealed_delim);s EXTERNAL ROUTINE1 STR$MATCH_WILD : BLISS ADDRESSING_MODE(GENERAL); MACRO  get_next_subdir(length, desc)= BEGIN REGISTER tmp_pos;; tmp_pos = CH$FIND_CH(length, .desc[DSC$A_POINTER], %C'.');_ desc[DSC$W_LENGTH] == (IF CH$FAIL(.tmp_pos) THEN length=0 ELSE CH$DIFF(.tmp_pos, .desc[DSC$A_POINTER]));" END%, !End of get_next_subdir new_length(old_length, desc)=' (IF old_length EQL .desc[DSC$W_LENGTH]% THEN 0 !This was the last chunk ELSE BEGIN REGISTER delta;: delta = .desc[DSC$W_LENGTH] + 1; !The amount to shift= desc[DSC$A_POINTER] = CH$PLUS( !Point to the next subdir# .desc[DSC$A_POINTER], .delta);R old_length - .delta! END)%, !End of new_length concealed_dir(length, buffer)=) (IF .length GEQU concealed_delim_len ANDn& CH$EQL(concealed_delim_len, .buffer,/ concealed_delim_len, UPLIT(concealed_delim)) & THEN BEGIN !Found a "][", skip it, length = .length - concealed_delim_len;, buffer = .buffer + concealed_delim_len; 1 !Return success END !End of found "]["f$ ELSE 0)%; !End of concealed_dir4 IF CH$EQL(.nam1[NAM$B_NODE], .nam1[NAM$L_NODE],. .nam2[NAM$B_NODE], .nam2[NAM$L_NODE], %C' ')/ AND(CH$EQL(.nam1[NAM$B_DEV], .nam1[NAM$L_DEV],D0 .nam2[NAM$B_DEV], .nam2[NAM$L_DEV], %C' ')6 OR (.nam1[NAM$B_DEV] NEQ 0 AND .nam2[NAM$B_DEV] NEQ 0 AND (LOCAL status1,R status2,a devnam : $BBLOCK[DSC$C_S_BLN]/ PRESET([DSC$W_LENGTH] = .nam1[NAM$B_DEV],B# [DSC$B_CLASS] = DSC$K_CLASS_S,# [DSC$B_DTYPE] = DSC$K_DTYPE_T, ( [DSC$A_POINTER]= .nam1[NAM$L_DEV]), dev1 : $BBLOCK[max_devnam], dev2 : $BBLOCK[max_devnam]," itmlst : $ITMLST_DECL(ITEMS=1); $ITMLST_INIT(ITMLST=itmlst, (BUFADR = dev1, BUFSIZ = max_devnam,t ITMCOD = DVI$_FULLDEVNAM));8 status1 = $GETDVIW(DEVNAM = devnam, ITMLST = itmlst); IF .status1 THEN BEGIN ' BIND itmptr = itmlst : $BBLOCK;l$ itmptr[ITM$L_BUFADR] = dev2;0 devnam[DSC$W_LENGTH] = .nam2[NAM$B_DEV];1 devnam[DSC$A_POINTER] = .nam2[NAM$L_DEV];= status2 = $GETDVIW(N' DEVNAM = devnam, ITMLST = itmlst);m END; .status1 AND .status2 AND. CH$EQL(max_devnam,dev1, max_devnam,dev2)))) THEN BEGIN l1 = .nam1[NAM$B_DIR]-2;_ l2 = .nam2[NAM$B_DIR]-2;P5 desc1[DSC$A_POINTER] = CH$PLUS(.nam1[NAM$L_DIR], 1); 5 desc2[DSC$A_POINTER] = CH$PLUS(.nam2[NAM$L_DIR], 1);k ! ! Is it [name...]?O !C dots_flag = CH$EQL(3, CH$PLUS(.desc2[DSC$A_POINTER], .l2 - 3), 3, UPLIT('...'));R IF .dots_flag, THEN l2 = .l2 - 2; !Don't compare the ...!BEGIN! !E)! ! Is it-... shorter than requested one?R! !! IF (.l2 - 3) LSS .l1<! THEN l1 = l2 = .nam2[NAM$B_DIR]-4 ! Keep 1 dot(kill 2)&! ELSE l2 = .l2 - 3; ! Kill dots ! END;4! status = CH$EQL(.l1, CH$PLUS(.nam1[NAM$L_DIR], 1),.! .l2, CH$PLUS(.nam2[NAM$L_DIR], 1), %C' '); %IF debug %THEN< print('!%D Test dir:"!AF"',0, .l1, .desc1[DSC$A_POINTER]);< print('!%D Log dir:"!AF"',0, .l2, .desc2[DSC$A_POINTER]); %FI!+! Skip leading 000000 directory references.p!, skip_000000_dirs(l1, desc1[DSC$A_POINTER]);, skip_000000_dirs(l2, desc2[DSC$A_POINTER]); WHILE .l1 GTRU 0 AND .l2 GTRU 0 DO BEGINo? get_next_subdir(.l1, desc1); !Set up a descriptor pointingl> get_next_subdir(.l2, desc2); !...to the next subdirectory %IF debug= %THEN print('!%D Comparing "!AS" to "!AS"',0, desc1, desc2);O %FI( IF NOT STR$MATCH_WILD(desc1, desc2) THEN BEGINM# match = 0; !Record the mismatch.( EXITLOOP; !No need to check any more! END; !End of subdir mismatch_ !! ! Set up for the next iteration.E !@ l1 = new_length(.l1, desc1); !Move to the next subdirectory& l2 = new_length(.l2, desc2); !.../ IF concealed_dir(l1, desc1[DSC$A_POINTER])_= THEN skip_000000_dirs(l1, !Found a concealed dir start,S6 desc1[DSC$A_POINTER]); !...skip leading 000000 dirs/ IF concealed_dir(l2, desc2[DSC$A_POINTER])= THEN skip_000000_dirs(l2, !Found a concealed dir start,t6 desc2[DSC$A_POINTER]); !...skip leading 000000 dirs( END; !End of dir comparison loop IF .match AND .l2 EQL 0 AND6 (.l1 EQL 0 OR .dots_flag) !Got an exact match or the7 THEN RETURN(SS$_NORMAL); !target was a ... directory.I END; !End of device matched1 RETURN(RMS$_PRV); !Directory did not match!END; !End of check_directory %SBTTL 'SKIP_000000_DIRS'a0ROUTINE skip_000000_dirs(length_a, buffer_a_a)= BEGIN !++D! Functional Description:a!;C! This routine takes a string length and buffer address (assumed to B! reference part of a directory string) and skips past any leading! 000000 directory references.!]! Formal Parameters:!a<! length_a - the address of the length longword. It will be8! updated to contain the length - the leading 000000! directories.@! buffer_a_a - the address a longword conataining the address of4! the start of the directory string. It will be/! updated to point after the last "000000."N!--tBIND length = .length_a : LONG,r$ buffer = .buffer_a_a : REF $BBLOCK;MACROI skip_dir = %STRING('000000.')%;LITERALN% skip_dir_len = %CHARCOUNT(skip_dir);E# WHILE .length GEQU skip_dir_lenF DO IF CH$EQL(skip_dir_len, .buffer, skip_dir_len, UPLIT(skip_dir))( THEN BEGIN !Found another 000000 dir3 buffer = .buffer + skip_dir_len; !Skip past itN8 length = .length - skip_dir_len; !Update the length' END !End of found a 000000 dir/ ELSE EXITLOOP; !Out of 000000 dirs, get outd7 RETURN(SS$_NORMAL); !Return status to the callerc"END; !End of skip_000000_dirsENDLELUDOMS: None.!! IMPLICIT OUTPUTS: None.!! COMPLETION CODES:!>! SS$_NO*[MGFTP.SOURCE]CMD_PARSE.B32;15+,4z.(/ 4J(%-I0123KPWO&56Rjr7XPjr89/RFÞGHJ ! MadGoat FTP client and server!?! Authors: Chad Wilson, Dale Moore, Tod Shannon, Bruce Miller,,! Marc Shannon, Henry Miller, John Clement,1! Matt Madison, Darrell Burkhead, Hunter Goatley!6! Copyright 1986, 1992, Carnegie Mellon University.B! Copyright 1994, 2000, MadGoat Software. All rights reserved.!?! Permission is granted for not-for-profit redistribution,?! provided all source and object code remain unchanged from?! the original distribution, and that all copyright notices! remain intact.!MODULE ftpin_parse( ADDRESSING_MODE( EXTERNAL = LONG_RELATIVE," NONEXTERNAL = LONG_RELATIVE),$ LIST(ASSEMBLY, NOBINARY, NOEXPAND), IDENT = 'V2.6-1') =BEGIN!++>! Cmd_Parse.B32 Copyright (c) 1986 Carnegie Mellon University!! Description:!;! Parse the commands and verify the syntax of each command.!/! Written by: Dale Moore 20-FEB-1986 CMU-CS/RI!! Modifications:!+! V2.6-1 Hunter Goatley 16-MAR-2000 00:50 MGFTP026.G4zI[MGFTP.SOURCE]CMD_PARSE.B32;15J(k! Added SIZE command.!)! V2.4 Hunter Goatley 22-APR-1998 11:15:! Accept descriptor address for parse argument instead of7! using pblock in parse_ftp_command(). Needed because<! FTP_HANDLER unwinds, skipping the return to this routine,:! causing us to never deallocate the string allocated for<! any argument. By passing it, we let FTP_IN deallocate it! in FTP_IN_FINISH().!)! V1.1 Hunter Goatley 26-SEP-1993 11:29A! Modified to run under OpenVMS AXP. Mostly, removed references2! to BUILTIN AP and explicitly passed parameters.!--LIBRARY 'SYS$LIBRARY:STARLET';LIBRARY 'SYS$LIBRARY:TPAMAC';LIBRARY 'TPA'; COMPILETIME debug = 0;H%IF debug %THEN %MESSAGE('DEBUG mode is enabled in CMD_PARSE.B32!') %FI; %IF debug%THEN LIBRARY 'NETAUX';%FIMACRO$ PBLOCK_L_ROUTINE = 0, 0, 32, 0%,% PBLOCK_Q_ARGUMENT = 4, 0, 0, 0%;LITERAL PBLOCK_K_SIZE = 12; 1 %SBTTL 'Routines to aid the parsing of commands'MACRO' store_command_macro(routine_name) = EXTERNAL ROUTINE routine_name; !: ! The "param" parameter(parameter #8) is the address of ! the PBlock. ! BIND% pblock = .parameter : $BBLOCK;* pblock[PBLOCK_L_ROUTINE] = routine_name; SS$_NORMAL END%;>TPA_ROUTINE(store_command_user,(options, stringcnt, stringptr,0 tokencnt, tokenptr, char, number, parameter))# store_command_macro(user_command);>TPA_ROUTINE(store_command_pass,(options, stringcnt, stringptr,0 tokencnt, tokenptr, char, number, parameter))# store_command_macro(pass_command);>TPA_ROUTINE(store_command_acct,(options, stringcnt, stringptr,0 tokencnt, tokenptr, char, number, parameter))# store_command_macro(acct_command);>TPA_ROUTINE(store_command_cwd ,(options, stringcnt, stringptr,0 tokencnt, tokenptr, char, number, parameter))" store_command_macro(cwd_command);>TPA_ROUTINE(store_command_xcwd,(options, stringcnt, stringptr,0 tokencnt, tokenptr, char, number, parameter))" store_command_macro(cwd_command);>TPA_ROUTINE(store_command_cdup,(options, stringcnt, stringptr,0 tokencnt, tokenptr, char, number, parameter))# store_command_macro(cdup_command);>TPA_ROUTINE(store_command_xcup,(options, stringcnt, stringptr,0 tokencnt, tokenptr, char, number, parameter))# store_command_macro(cdup_command);>TPA_ROUTINE(store_command_smnt,(options, stringcnt, stringptr,0 tokencnt, tokenptr, char, number, parameter))# store_command_macro(smnt_command);>TPA_ROUTINE(store_command_quit,(options, stringcnt, stringptr,0 tokencnt, tokenptr, char, number, parameter))# store_command_macro(quit_command);>TPA_ROUTINE(store_command_rein,(options, stringcnt, stringptr,0 tokencnt, tokenptr, char, number, parameter))# store_command_macro(rein_command);>TPA_ROUTINE(store_command_port,(options, stringcnt, stringptr,0 tokencnt, tokenptr, char, number, parameter))# store_command_macro(port_command);>TPA_ROUTINE(store_command_pasv,(options, stringcnt, stringptr,0 tokencnt, tokenptr, char, number, parameter))# store_command_macro(pasv_command);>TPA_ROUTINE(store_command_type,(options, stringcnt, stringptr,0 tokencnt, tokenptr, char, number, parameter))# store_command_macro(type_command);>TPA_ROUTINE(store_command_stru,(options, stringcnt, stringptr,0 tokencnt, tokenptr, char, number, parameter))# store_command_macro(stru_command);>TPA_ROUTINE(store_command_mode,(options, stringcnt, stringptr,0 tokencnt, tokenptr, char, number, parameter))# store_command_macro(mode_command);>TPA_ROUTINE(store_command_retr,(options, stringcnt, stringptr,0 tokencnt, tokenptr, char, number, parameter))# store_command_macro(retr_command);>TPA_ROUTINE(store_command_stor,(options, stringcnt, stringptr,0 tokencnt, tokenptr, char, number, parameter))# store_command_macro(stor_command);>TPA_ROUTINE(store_command_stou,(options, stringcnt, stringptr,0 tokencnt, tokenptr, char, number, parameter))# store_command_macro(stou_command);>TPA_ROUTINE(store_command_appe,(options, stringcnt, stringptr,0 tokencnt, tokenptr, char, number, parameter))# store_command_macro(appe_command);>TPA_ROUTINE(store_command_allo,(options, stringcnt, stringptr,0 tokencnt, tokenptr, char, number, parameter))# store_command_macro(allo_command);>TPA_ROUTINE(store_command_rest,(options, stringcnt, stringptr,0 tokencnt, tokenptr, char, number, parameter))# store_command_macro(rest_command);>TPA_ROUTINE(store_command_rnfr,(options, stringcnt, stringptr,0 tokencnt, tokenptr, char, number, parameter))# store_command_macro(rnfr_command);>TPA_ROUTINE(store_command_rnto,(options, stringcnt, stringptr,0 tokencnt, tokenptr, char, number, parameter))# store_command_macro(rnto_command);>TPA_ROUTINE(store_command_abor,(options, stringcnt, stringptr,0 tokencnt, tokenptr, char, number, parameter))# store_command_macro(abor_command);>TPA_ROUTINE(store_command_dele,(options, stringcnt, stringptr,0 tokencnt, tokenptr, char, number, parameter))# store_command_macro(dele_command);>TPA_ROUTINE(store_command_rmd ,(options, stringcnt, stringptr,0 tokencnt, tokenptr, char, number, parameter))" store_command_macro(rmd_command);>TPA_ROUTINE(store_command_xrmd,(options, stringcnt, stringptr,0 tokencnt, tokenptr, char, number, parameter))" store_command_macro(rmd_command);>TPA_ROUTINE(store_command_mkd ,(options, stringcnt, stringptr,0 tokencnt, tokenptr, char, number, parameter))" store_command_macro(mkd_command);>TPA_ROUTINE(store_command_xmkd,(options, stringcnt, stringptr,0 tokencnt, tokenptr, char, number, parameter))" store_command_macro(mkd_command);>TPA_ROUTINE(store_command_pwd ,(options, stringcnt, stringptr,0 tokencnt, tokenptr, char, number, parameter))" store_command_macro(pwd_command);>TPA_ROUTINE(store_command_xpwd,(options, stringcnt, stringptr,0 tokencnt, tokenptr, char, number, parameter))" store_command_macro(pwd_command);>TPA_ROUTINE(store_command_list,(options, stringcnt, stringptr,0 tokencnt, tokenptr, char, number, parameter))# store_command_macro(list_command);>TPA_ROUTINE(store_command_nlst,(options, stringcnt, stringptr,0 tokencnt, tokenptr, char, number, parameter))# store_command_macro(nlst_command);>TPA_ROUTINE(store_command_site,(options, stringcnt, stringptr,0 tokencnt, tokenptr, char, number, parameter))# store_command_macro(site_command);>TPA_ROUTINE(store_command_size,(options, stringcnt, stringptr,0 tokencnt, tokenptr, char, number, parameter))# store_command_macro(size_command);>TPA_ROUTINE(store_command_syst,(options, stringcnt, stringptr,0 tokencnt, tokenptr, char, number, parameter))# store_command_macro(syst_command);>TPA_ROUTINE(store_command_stat,(options, stringcnt, stringptr,0 tokencnt, tokenptr, char, number, parameter))# store_command_macro(stat_command);>TPA_ROUTINE(store_command_help,(options, stringcnt, stringptr,0 tokencnt, tokenptr, char, number, parameter))# store_command_macro(help_command);>TPA_ROUTINE(store_command_noop,(options, stringcnt, stringptr,0 tokencnt, tokenptr, char, number, parameter))# store_command_macro(noop_command); 5TPA_ROUTINE(store_arg,(options, stringcnt, stringptr,0 tokencnt, tokenptr, char, number, parameter))!++! Functional Description:!8! Store an argument to pass along to the remote routine.!! Formal Parameters:!-! The AP points at the TParse argument block.!!-- BIND pblock = .parameter : $BBLOCK; EXTERNAL ROUTINE. STR$COPY_DX : BLISS ADDRESSING_MODE3P MGFTP026.G4zI[MGFTP.SOURCE]CMD_PARSE.B32;15J((GENERAL); LOCAL status; %IF debug2 %THEN print('Save command ''!AS''', tokencnt); %FI status = STR$COPY_DX( pblock[PBLOCK_Q_ARGUMENT], tokencnt);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; !++! Description:!2! LIB$TPARSE state tables for FTP server commands.!9! One of the major drawbacks in using LIB$TPARSE, is that@! there is no easy way of doing case blind compares on keywords.!@! So we must have verify routines which set the command and call! the appropriate routines.!!--0$INIT_STATE(ftpin_state_table, ftpin_key_table);$STATE(ftp_command, ((USER), , store_command_user), ((PASS), , store_command_pass), ((ACCT), , store_command_acct), ((CWD) , , store_command_cwd), ((XCWD), , store_command_xcwd), ((CDUP), , store_command_cdup), ((XCUP), , store_command_xcup), ((SMNT), , store_command_smnt), ((QUIT), , store_command_quit), ((REIN), , store_command_rein), ((PORT), , store_command_port), ((PASV), , store_command_pasv), ((TYPE), , store_command_type), ((STRU), , store_command_stru), ((MODE), , store_command_mode), ((RETR), , store_command_retr), ((STOR), , store_command_stor), ((STOU), , store_command_stou), ((APPE), , store_command_appe), ((ALLO), , store_command_allo), ((REST), , store_command_rest), ((RNFR), , store_command_rnfr), ((RNTO), , store_command_rnto), ((ABOR), , store_command_abor), ((DELE), , store_command_dele), ((RMD) , , store_command_rmd), ((XRMD), , store_command_xrmd), ((MKD) , , store_command_mkd), ((XMKD), , store_command_xmkd), ((PWD) , , store_command_pwd), ((XPWD), , store_command_xpwd), ((LIST), , store_command_list), ((NLST), , store_command_nlst), ((SITE), , store_command_site), ((SIZE), , store_command_size), ((SYST), , store_command_syst), ((STAT), , store_command_stat), ((HELP), , store_command_help),! ((NOOP), , store_command_noop));$STATE(, (' '), (TPA$_EOS, TPA$_EXIT));$STATE(,( ((command_arg), TPA$_EXIT, store_arg)); $State(command_arg, (TPA$_ANY, command_arg), (TPA$_EOS, TPA$_EXIT));!++D! The TPARSE flags don't have a case insensitive0! match flag. So we must do these crufty hacks.!--$STATE(USER,('U'),('u'));$STATE( ,('S'),('s'));$STATE( ,('E'),('e'));$STATE( ,('R'),('r'));&$STATE( ,(TPA$_LAMBDA, TPA$_EXIT));$STATE(PASS,('P'),('p'));$STATE( ,('A'),('a'));$STATE( ,('S'),('s'));$STATE( ,('S'),('s'));&$STATE( ,(TPA$_LAMBDA, TPA$_EXIT));$STATE(ACCT,('A'),('a'));$STATE( ,('C'),('c'));$STATE( ,('C'),('c'));$STATE( ,('T'),('t'));&$STATE( ,(TPA$_LAMBDA, TPA$_EXIT));$STATE(CWD ,('C'),('c'));$STATE( ,('W'),('w'));$STATE( ,('D'),('d'));&$STATE( ,(TPA$_LAMBDA, TPA$_EXIT));$STATE(XCWD,('X'),('x'));$STATE( ,('C'),('c'));$STATE( ,('W'),('w'));$STATE( ,('D'),('d'));&$STATE( ,(TPA$_LAMBDA, TPA$_EXIT));$STATE(CDUP,('C'),('c'));$STATE( ,('D'),('d'));$STATE( ,('U'),('u'));$STATE( ,('P'),('p'));&$STATE( ,(TPA$_LAMBDA, TPA$_EXIT));$STATE(XCUP,('X'),('x'));$STATE( ,('C'),('c'));$STATE( ,('U'),('u'));$STATE( ,('P'),('p'));&$STATE( ,(TPA$_LAMBDA, TPA$_EXIT));$STATE(SMNT,('S'),('s'));$STATE( ,('M'),('m'));$STATE( ,('N'),('n'));$STATE( ,('T'),('t'));&$STATE( ,(TPA$_LAMBDA, TPA$_EXIT));$STATE(QUIT,('Q'),('q'));$STATE( ,('U'),('u'));$STATE( ,('I'),('i'));$STATE( ,('T'),('t'));&$STATE( ,(TPA$_LAMBDA, TPA$_EXIT));$STATE(REIN,('R'),('r'));$STATE( ,('E'),('e'));$STATE( ,('I'),('i'));$STATE( ,('N'),('n'));&$STATE( ,(TPA$_LAMBDA, TPA$_EXIT));$STATE(PORT,('P'),('p'));$STATE( ,('O'),('o'));$STATE( ,('R'),('r'));$STATE( ,('T'),('t'));&$STATE( ,(TPA$_LAMBDA, TPA$_EXIT));$STATE(PASV,('P'),('p'));$STATE( ,('A'),('a'));$STATE( ,('S'),('s'));$STATE( ,('V'),('v'));&$STATE( ,(TPA$_LAMBDA, TPA$_EXIT));$STATE(TYPE,('T'),('t'));$STATE( ,('Y'),('y'));$STATE( ,('P'),('p'));$STATE( ,('E'),('e'));&$STATE( ,(TPA$_LAMBDA, TPA$_EXIT));$STATE(STRU,('S'),('s'));$STATE( ,('T'),('t'));$STATE( ,('R'),('r'));$STATE( ,('U'),('u'));&$STATE( ,(TPA$_LAMBDA, TPA$_EXIT));$STATE(MODE,('M'),('m'));$STATE( ,('O'),('o'));$STATE( ,('D'),('d'));$STATE( ,('E'),('e'));&$STATE( ,(TPA$_LAMBDA, TPA$_EXIT));$STATE(RETR,('R'),('r'));$STATE( ,('E'),('e'));$STATE( ,('T'),('t'));$STATE( ,('R'),('r'));&$STATE( ,(TPA$_LAMBDA, TPA$_EXIT));$STATE(STOR,('S'),('s'));$STATE( ,('T'),('t'));$STATE( ,('O'),('o'));$STATE( ,('R'),('r'));&$STATE( ,(TPA$_LAMBDA, TPA$_EXIT));$STATE(STOU,('S'),('s'));$STATE( ,('T'),('t'));$STATE( ,('O'),('o'));$STATE( ,('U'),('u'));&$STATE( ,(TPA$_LAMBDA, TPA$_EXIT));$STATE(APPE,('A'),('a'));$STATE( ,('P'),('p'));$STATE( ,('P'),('p'));$STATE( ,('E'),('e'));&$STATE( ,(TPA$_LAMBDA, TPA$_EXIT));$STATE(ALLO,('A'),('a'));$STATE( ,('L'),('l'));$STATE( ,('L'),('l'));$STATE( ,('O'),('o'));&$STATE( ,(TPA$_LAMBDA, TPA$_EXIT));$STATE(REST,('R'),('r'));$STATE( ,('E'),('e'));$STATE( ,('S'),('s'));$STATE( ,('T'),('t'));&$STATE( ,(TPA$_LAMBDA, TPA$_EXIT));$STATE(RNFR,('R'),('r'));$STATE( ,('N'),('n'));$STATE( ,('F'),('f'));$STATE( ,('R'),('r'));&$STATE( ,(TPA$_LAMBDA, TPA$_EXIT));$STATE(RNTO,('R'),('r'));$STATE( ,('N'),('n'));$STATE( ,('T'),('t'));$STATE( ,('O'),('o'));&$STATE( ,(TPA$_LAMBDA, TPA$_EXIT));$STATE(ABOR,('A'),('a'));$STATE( ,('B'),('b'));$STATE( ,('O'),('o'));$STATE( ,('R'),('r'));&$STATE( ,(TPA$_LAMBDA, TPA$_EXIT));$STATE(DELE,('D'),('d'));$STATE( ,('E'),('e'));$STATE( ,('L'),('l'));$STATE( ,('E'),('e'));&$STATE( ,(TPA$_LAMBDA, TPA$_EXIT));$STATE(RMD ,('R'),('r'));$STATE( ,('M'),('m'));$STATE( ,('D'),('d'));&$STATE( ,(TPA$_LAMBDA, TPA$_EXIT));$STATE(XRMD,('X'),('x'));$STATE( ,('R'),('r'));$STATE( ,('M'),('m'));$STATE( ,('D'),('d'));&$STATE( ,(TPA$_LAMBDA, TPA$_EXIT));$STATE(MKD ,('M'),('m'));$STATE( ,('K'),('k'));$STATE( ,('D'),('d'));&$STATE( ,(TPA$_LAMBDA, TPA$_EXIT));$STATE(XMKD,('X'),('x'));$STATE( ,('M'),('m'));$STATE( ,('K'),('k'));$STATE( ,('D'),('d'));&$STATE( ,(TPA$_LAMBDA, TPA$_EXIT));$STATE(PWD ,('P'),('p'));$STATE( ,('W'),('w'));$STATE( ,('D'),('d'));&$STATE( ,(TPA$_LAMBDA, TPA$_EXIT));$STATE(XPWD,('X'),('x'));$STATE( ,('P'),('p'));$STATE( ,('W'),('w'));$STATE( ,('D'),('d'));&$STATE( ,(TPA$_LAMBDA, TPA$_EXIT));$STATE(LIST,('L'),('l'));$STATE( ,('I'),('i'));$STATE( ,('S'),('s'));$STATE( ,('T'),('t'));&$STATE( ,(TPA$_LAMBDA, TPA$_EXIT));$STATE(NLST,('N'),('n'));$STATE( ,('L'),('l'));$STATE( ,('S'),('s'));$STATE( ,('T'),('t'));&$STATE( ,(TPA$_LAMBDA, TPA$_EXIT));$STATE(SITE,('S'),('s'));$STATE( ,('I'),('i'));$STATE( ,('T'),('t'));$STATE( ,('E'),('e'));&$STATE( ,(TPA$_LAMBDA, TPA$_EXIT));$STATE(SIZE,('S'),('s'));$STATE( ,('I'),('i'));$STATE( ,('Z'),('z'));$STATE( ,('E'),('e'));&$STATE( ,(TPA$_LAMBDA, TPA$_EXIT));$STATE(SYST,('S'),('s'));$STATE( ,('Y'),('y'));$STATE( ,('S'),('s'));$STATE( ,('T'),('t'i MGFTP026.G4zI[MGFTP.SOURCE]CMD_PARSE.B32;15J(ǘ !)); &$STATE( ,(TPA$_LAMBDA, TPA$_EXIT));$STATE(STAT,('S'),('s'));r$STATE( ,('T'),('t'));r$STATE( ,('A'),('a'));M$STATE( ,('T'),('t'));t&$STATE( ,(TPA$_LAMBDA, TPA$_EXIT));$STATE(HELP,('H'),('h'));,$STATE( ,('E'),('e'));e$STATE( ,('L'),('l'));,$STATE( ,('P'),('p'));l&$STATE( ,(TPA$_LAMBDA, TPA$_EXIT));$STATE(NOOP,('N'),('n'));i$STATE( ,('O'),('o'));i$STATE( ,('O'),('o'));o$STATE( ,('P'),('p'));&$STATE( ,(TPA$_LAMBDA, TPA$_EXIT)); l&ROUTINE parse_handler(sig_a, mech_a) = BEGINE BIND sig = .sig_a : $BBLOCK, mech = .mech_a : $BBLOCK; BIND1 condition = sig[CHF$L_SIG_NAME] : LONG UNSIGNED;A %IF debugI> %THEN print('Parse Handler: Condition = !XL', .condition); %FIa SS$_RESIGNAL END; eDGLOBAL ROUTINE parse_ftp_command(string_desc_a, arg_desc_a, param) =!++! Functional Description:o!2A! Parse the command and get the argument to the command and whichG! routine handles the command.!--S BEGIN. ENABLE parse_handler;  BIND( string_desc = .string_desc_a : $BBLOCK,# arg_desc = .arg_desc_a : $BBLOCK;p EXTERNAL ROUTINE- LIB$TPARSE : BLISS ADDRESSING_MODE(GENERAL),s. STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL),r unknown_command; LOCALi" pblock : $BBLOCK[PBLOCK_K_SIZE],. tparse_block : $BBLOCK[TPA$K_LENGTH0] PRESET( [TPA$L_COUNT] = TPA$K_COUNT0," [TPA$L_OPTIONS] = TPA$M_BLANKS,1 [TPA$L_STRINGCNT] = .string_desc[DSC$W_LENGTH],a2 [TPA$L_STRINGPTR] = .string_desc[DSC$A_POINTER], [TPA$L_PARAM] = pblock);A BIND0 argument = pblock[PBLOCK_Q_ARGUMENT] : $BBLOCK; LOCALE status; %IF debugn; %THEN print('FTP_Parse_Command: ''!AS''', string_desc);N %FI $INIT_DYNDESC (argument);I@ STR$FREE1_DX(arg_desc); !Free any string that might be thereJ status = LIB$TPARSE(tparse_block, ftpin_state_table, ftpin_key_table); IF NOT .status- THEN unknown_command(.param, string_desc)E ELSE BEGINB IF (.argument [DSC$W_LENGTH] NEQU 0) !Only copy string if present THENr BEGIN& STR$COPY_DX (arg_desc, argument); STR$FREE1_DX (argument); END;C/ (.pblock[PBLOCK_L_ROUTINE])(.param, arg_desc);% END;P !(? ! We never return here because FTP_HANDLER does an unwind!t !,! STR$FREE1_DX(argument); SS$_NORMAL END;ENDELUDOMUTINE(store_command_pass,(options, stringcnt, stringptr,0 tokencnt, tokenptr, c*[MGFTP.SOURCE]CONDITION.B32;5+,(#./ 4N-I0123KPWO56j2ۖ702ۖ89/RFÞGHJ ! MadGoat FTP client and server!?! Authors: Chad Wilson, Dale Moore, Tod Shannon, Bruce Miller,,! Marc Shannon, Henry Miller, John Clement,1! Matt Madison, Darrell Burkhead, Hunter Goatley!6! Copyright 1986, 1992, Carnegie Mellon University.B! Copyright 1994, 2000, MadGoat Software. All rights reserved.!?! Permission is granted for not-for-profit redistribution,?! provided all source and object code remain unchanged from?! the original distribution, and that all copyright notices! remain intact.!MODULE condition( ADDRESSING_MODE( EXTERNAL = LONG_RELATIVE," NONEXTERNAL = LONG_RELATIVE), IDENT = 'V2.6-2',& LIST(ASSEMBLY, NOBINARY, NOEXPAND)) =BEGIN!++! Description:!<! Some routines for the FTP utility to manage how errors and!! special conditions are handled.! ! Written By:!"! Dale Moore CMU-CS/RI 12-OCT-1987!! Modifications:!+! V2.6-2 Hunter Goatley 1-MAY-2000 09:497! Modified do_exit(), do_continue(), and do_abort() to9! call ftp_cancel_input() to cancel any read we may have9! outstanding. If we don't do this, we could get out of(! synch with our reads and our prompts.!*! V2.1 Darrell Burkhead 7-JUN-1994 15:34<! Replaced the $EXIT call in do_exit with a more controlled! exit.!&! V1.0 21-SEP-1993 Hunter Goatley WKU-! Ported to run under OpenVMS AXP(using UCX).!--LIBRARY 'SYS$LIBRARY:STARLET';LIBRARY 'FTP_MSG';LIBRARY 'CLI';LIBRARY 'NETAUX';LITERAL cond_abort = 0, cond_continue = 1, cond_exit = 2;OWN, cntrl_c_condition : INITIAL(cond_abort),* error_condition : INITIAL(cond_abort),+ severe_condition : INITIAL(cond_abort),/ warning_condition : INITIAL(cond_continue); !ROUTINE do_abort(sig_a, mech_a) =!++! Functional Description:!4! From the status of the various condition settings,<! I'm suppose to abort whatever I'm doing and go to the FTP> ! prompt.!-- BEGIN BIND sig = .sig_a : $BBLOCK, mech = .mech_a : $BBLOCK; BIND5%IF %BLISS(BLISS32E) %THEN !If compiling for AXP...( sig_args = sig[CHF$IS_SIG_ARGS] : LONG,( sig_name = sig[CHF$IS_SIG_NAME] : LONG,%ELSE' sig_args = sig[CHF$L_SIG_ARGS] : LONG,' sig_name = sig[CHF$L_SIG_NAME] : LONG,%FI& sig_name_block = sig_name : $BBLOCK; EXTERNAL ROUTINE ftp_cancel_input; sig_args = .sig_args - 2; $PUTMSG(MSGVEC = sig); ftp_cancel_input();1%IF %BLISS(BLISS32E) %THEN !Put the value in R0+ mech[CHF$IL_MCH_SAVR0_LOW] = .sig_name;%ELSE& mech[CHF$L_MCH_SAVR0] = .sig_name;%FI SETUNWIND() END; ROUTINE do_continue(sig_a) =!++! Functional Description:!E! Merely display the message and continue as though nothing happened.!-- BEGIN EXTERNAL ROUTINE ftp_cancel_input; BIND sig = .sig_a : $BBLOCK,' sig_args = sig[CHF$L_SIG_ARGS] : LONG; sig_args = .sig_args - 2; $PUTMSG(MSGVEC = sig); ftp_cancel_input(); SS$_CONTINUE END; ROUTINE do_exit(sig_a) =!++! Functional Description:!5! Display the error message and exit the FTP utility.!-- BEGIN BIND sig = .sig_a : $BBLOCK,' sig_args = sig[CHF$L_SIG_ARGS] : LONG,' sig_name = sig[CHF$L_SIG_NAME] : LONG; EXTERNAL exit_flag, exit_status; EXTERNAL ROUTINE ftp_cancel_input; sig_args = .sig_args - 2; $PUTMSG(MSGVEC = sig); ftp_cancel_input(); exit_flag = 1;/ exit_status = .sig_name OR STS$M_INHIB_MSG; SIGNAL(RMS$_EOF); SS$_NORMAL END; :GLOBAL ROUTINE ftp_routine_handler(sig_a, mech_a, ena_a) =!++! Functional Description:!>! Here is where we check the condition that has been raised or:! signalled. If it is something that we check for then we!! see what we are to do about it.!!-- BEGIN BIND sig = .sig_a : $BBLOCK, mech = .mech_a : $BBLOCK, ena = .ena_a : $BBLOCK; BIND' sig_args = sig[CHF$L_SIG_ARGS] : LONG,' sig_name = sig[CHF$L_SIG_NAME] : LONG,& sig_name_block = sig_name : $BBLOCK;9 IF .sig_name EQLU SS$_UNWIND THEN RETURN(SS$_NORMAL);= IF .sig_name EQLU SS$_ACCVIO THEN RETURN( SS$_RESIGNAL );K IF(.sig_name EQL FTP$_CONTROL_C) AND(.cntrl_c_condition EQL cond_abort)% THEN RETURN(do_abort(sig, mech));N IF(.sig_name EQL FTP$_CONTROL_C) AND(.cntrl_c_condition EQL cond_continue) THEN RETURN(SS$_CONTINUE);J IF(.sig_name EQL FTP$_CONTROL_C) AND(.cntrl_c_condition EQL cond_exit) THEN R Њ MGFTP026.G(#I[MGFTP.SOURCE]CONDITION.B32;5N ETURN(do_exit(sig));; IF(.sig_name_Block[STS$V_SEVERITY] EQL STS$K_ERROR) AND" (.error_condition EQL cond_abort)% THEN RETURN(do_abort(sig, mech));; IF(.sig_name_Block[STS$V_SEVERITY] EQL STS$K_ERROR) AND% (.error_condition EQL cond_continue)" THEN RETURN(do_continue(sig));; IF(.sig_name_Block[STS$V_SEVERITY] EQL STS$K_ERROR) AND! (.error_condition EQL cond_exit) THEN RETURN(do_exit(sig));< IF(.sig_name_Block[STS$V_SEVERITY] EQL STS$K_SEVERE) AND# (.severe_condition EQL cond_abort)% THEN RETURN(do_abort(sig, mech));< IF(.sig_name_Block[STS$V_SEVERITY] EQL STS$K_SEVERE) AND& (.severe_condition EQL cond_continue)" THEN RETURN(do_continue(sig));< IF(.sig_name_Block[STS$V_SEVERITY] EQL STS$K_SEVERE) AND" (.severe_condition EQL cond_exit) THEN RETURN(do_exit(sig));= IF(.sig_name_Block[STS$V_SEVERITY] EQL STS$K_WARNING) AND$ (.warning_condition EQL cond_abort)% THEN RETURN(do_abort(sig, mech));= IF(.sig_name_Block[STS$V_SEVERITY] EQL STS$K_WARNING) AND' (.warning_condition EQL cond_continue)" THEN RETURN(do_continue(sig));= IF(.sig_name_Block[STS$V_SEVERITY] EQL STS$K_WARNING) AND# (.warning_condition EQL cond_exit) THEN RETURN(do_exit(sig)); SS$_RESIGNAL END; GLOBAL ROUTINE!++! Functional Description:!:! A CLI dispatch routine. Tells what to do in the case of! a Control-C.!--9 on_controlc_abort = (cntrl_c_condition = cond_abort),? on_controlc_continue = (cntrl_c_condition = cond_continue),7 on_controlc_exit = (cntrl_c_condition = cond_exit); GLOBAL ROUTINE!++! Functional Description:!:! A CLI dispatch routine. Tells what to do in the case of ! an Error!--4 on_error_abort = (error_condition = cond_abort),: on_error_continue = (error_condition = cond_continue),2 on_error_exit = (error_condition = cond_exit); GLOBAL ROUTINE!++! Functional Description:!:! A CLI dispatch routine. Tells what to do in the case of! a Severe Error!--5 on_severe_abort =(severe_condition = cond_abort),; on_severe_continue =(severe_condition = cond_continue),3 on_severe_exit =(severe_condition = cond_exit); GLOBAL ROUTINE!++! Functional Description:!:! A CLI dispatch routine. Tells what to do in the case of ! a Warning!--7 on_warning_abort =(warning_condition = cond_abort),= on_warning_continue =(warning_condition = cond_continue),5 on_warning_exit =(warning_condition = cond_exit); GLOBAL ROUTINE show_conditions =!++! Functional Description:!7! Display for the user what the current settings of the.! various condition handling arrangements are.!-- BEGIN# SELECTONE .cntrl_c_condition OF SET- [cond_abort] : Print('ON Control_C Abort');3 [cond_continue] : Print('ON Control_C Continue');+ [cond_exit] : Print('ON Control_C Exit'); TES;! SELECTONE .error_condition OF SET) [cond_abort] : Print('ON Error Abort');/ [cond_continue] : Print('ON Error Continue');' [cond_exit] : Print('ON Error Exit'); TES;" SELECTONE .severe_condition OF SET* [cond_abort] : Print('ON Severe Abort');0 [cond_continue] : Print('ON Severe Continue');( [cond_exit] : Print('ON Severe Exit'); TES;# SELECTONE .warning_condition OF SET+ [cond_abort] : Print('ON Warning Abort');1 [cond_continue] : Print('ON Warning Continue');) [cond_exit] : Print('ON Warning Exit'); TES; SS$_NORMAL END;ENDELUDOM*[MGFTP.SOURCE]CONTROL_C.B32;1+,I./ 4L-I0123KPWO56~!ӗ789/RFÞGHJ  ! MadGoat FTP client and server!?! Authors: Chad Wilson, Dale Moore, Tod Shannon, Bruce Miller,,! Marc Shannon, Henry Miller, John Clement,1! Matt Madison, Darrell Burkhead, Hunter Goatley!6! Copyright 1986, 1992, Carnegie Mellon University.<! Copyright 1994, MadGoat Software. All rights reserved.!?! Permission is granted for not-for-profit redistribution,?! provided all source and object code remain unchanged from?! the original distribution, and that all copyright notices! remain intact.!MODULE control_c( ADDRESSING_MODE( EXTERNAL = LONG_RELATIVE," NONEXTERNAL = LONG_RELATIVE), IDENT = 'V2.0',& LIST(ASSEMBLY, NOBINARY, NOEXPAND)) =BEGIN!++! Control_C.B32!.! Copyright(C) 1987 Carnegie Mellon University!! Description:!0! A module to try and trap and handle control-C.! For the FTP Utility.! ! Written By:!! Chad Wilson CMU-CS/RI!! Modifications:!!--LIBRARY 'SYS$LIBRARY:STARLET';LIBRARY 'FTP_MSG';OWN) term_chan : WORD UNSIGNED INITIAL(0); FORWARD ROUTINE setup_control_c;ROUTINE control_c_ast(astprm) =!++! Functional Description:!9! A Control-C has been typed. ReEnable for another, then=! SIGNAL the condition, which will probably unwind the stack.!-- BEGIN EXTERNAL quiet_flag; setup_control_c(); $WAKE(); signal(FTP$_CONTROL_C); SS$_NORMAL END; ROUTINE setup_control_c =!++! Functional Description:!-- BEGIN LOCAL status; status = $QIOW( CHAN = .term_chan,& FUNC = IO$_SETMODE OR IO$M_CTRLCAST, P1 = control_c_ast);7 IF NOT .status THEN SIGNAL(FTP$_ERROR, 0, .status); SS$_NORMAL END; GLOBAL ROUTINE init_control_c =!++! Functional Description:!5! Will set up the I/O request for the control-c trap.!!-- BEGIN EXTERNAL ROUTINE- LIB$GETDVI : BLISS ADDRESSING_MODE(GENERAL); LOCAL dev_type : LONG UNSIGNED, status; !++* ! See if we've already started things. !--1 IF .term_chan NEQU 0 THEN RETURN(SS$_NORMAL);2 status = $ASSIGN( DEVNAM = %ASCID'SYS$INPUT:', CHAN = term_chan);7 IF NOT .status THEN SIGNAL(FTP$_ERROR, 0, .status);L status = LIB$GETDVI(%REF(DVI$_DEVCLASS), %REF(.term_chan), 0, dev_type);7 IF NOT .status THEN SIGNAL(FTP$_ERROR, 0, .status); !++; ! If device isn't terminal, don't start control-C trap !--7 IF .dev_type NEQU DC$_TERM THEN RETURN(SS$_NORMAL); setup_control_c(); SS$_NORMAL END; #GLOBAL ROUTINE clean_up_control_c =!++! Functional Description:!3! Will cancel I/O request and deassign the channel.!-- BEGIN LOCAL status;( status = $CANCEL(CHAN = .term_chan);( IF NOT .status THEN SIGNAL(.status);( status = $DASSGN(CHAN = .term_chan);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END;ENDELUDOM)*[MGFTP.SOURCE]COPY_DIR_FTP_SUPPORT.B32;38+,| .$/ 4\$!P-I0123KPWO"56ɽv7w/v89GHJ%TITLE 'COPY_DIR_FTP_SUPPORT'MODULE COPY_DIR_FTP_SUPPORT (#%IF %VARIANT %THEN MAIN = main, %FI ADDRESSING_MODE ( EXTERNAL = LONG_RELATIVE," NONEXTERNAL = LONG_RELATIVE),IDENT = 'V2.6-3') = BEGIN!++!!! Facility: COPY_DIR_FTP_SUPPORT!! Author: Hunter Goatley!! Date: August 13, 1996! ! Abstract:!>! Routines that allow MadGoat FTP to be called via the VMS DCL ! commands COPY/FTP and DIR/FTP.!! Modified by:!+! V2.6-3 Hunter Goatley 6-AUG-200 1 MGFTP026.G| I)[MGFTP.SOURCE]COPY_DIR_FTP_SUPPORT.B32;38\$20 20:528! Add /WARNING=EXIT so that we'll exit and report error8! conditions in $STATUS. Also, preserve case of quoted:! filespecs in DIR. COPY did, but the logic was a little! off for DIR.!+! V2.5-3 Hunter Goatley 8-MAR-1999 14:30&! Save blanks in directory specs too!!+! 01-000 Hunter Goatley 13-AUG-1996 11:25! Original version.!!--9LIBRARY 'SYS$LIBRARY:STARLET'; !Pull stuff from STARLET4LIBRARY 'SYS$LIBRARY:TPAMAC'; !Pull stuff from LIBLIBRARY 'TPA';LIBRARY 'CLI'; FORWARD ROUTINE %IF %VARIANT%THEN main, !Main entry point%FI parse_nodespec, node_store, build_copy_string, build_dir_string ; EXTERNAL ROUTINE) STR$COPY_DX : ADDRESSING_MODE (GENERAL),( LIB$TPARSE : ADDRESSING_MODE (GENERAL),) LIB$SYS_FAO : ADDRESSING_MODE (GENERAL),, LIB$PUT_OUTPUT : ADDRESSING_MODE (GENERAL),- LIB$GET_COMMAND : ADDRESSING_MODE (GENERAL),( STR$COPY_R : ADDRESSING_MODE (GENERAL),) CLI$PRESENT : ADDRESSING_MODE (GENERAL),+ CLI$GET_VALUE : ADDRESSING_MODE (GENERAL),( STR$APPEND : ADDRESSING_MODE (GENERAL),( STR$CONCAT : ADDRESSING_MODE (GENERAL),) LIB$SYS_FAO : ADDRESSING_MODE (GENERAL),- STR$COMPARE_EQL : ADDRESSING_MODE (GENERAL),) STR$FREE1_DX : ADDRESSING_MODE (GENERAL) ; EXTERNAL LITERAL FTP$_DIRFTPNOHOST, FTP$_COPFTPNOBOTH, FTP$_COPFTPNOLOCAL, FTP$_IGNORFDL; BIND null_str = %ASCID'',( blank_str = %ASCID %STRING(%CHAR(32)), p1_str = %ASCID'P1', p2_str = %ASCID'P2',$ anonymous_str = %ASCID'ANONYMOUS',) anonymous_qual_str = %ASCID'/ANONYMOUS', doublequote_str = %ASCID'"', ddoublequote_str = %ASCID'""',) username_qual_str = %ASCID'/USERNAME="',) password_qual_str = %ASCID'/PASSWORD="', log_qual_str = %ASCID'/LOG', log_str = %ASCID'LOG', ascii_str = %ASCID'ASCII', binary_str = %ASCID'BINARY',' type_ascii_str = %ASCID'/TYPE=ASCII',( type_binary_str = %ASCID'/TYPE=IMAGE', fdl_str = %ASCID'FDL'; MACRO' TPA_A_P1 = TPA$C_LENGTH0+00,0,32,0%,' TPA_A_P2 = TPA$C_LENGTH0+04,0,32,0%,' TPA_A_P3 = TPA$C_LENGTH0+08,0,32,0%,' TPA_A_P4 = TPA$C_LENGTH0+12,0,32,0%,' TPA_A_P5 = TPA$C_LENGTH0+16,0,32,0%,' TPA_A_P6 = TPA$C_LENGTH0+20,0,32,0%,' TPA_A_P7 = TPA$C_LENGTH0+24,0,32,0%,' TPA_A_P8 = TPA$C_LENGTH0+28,0,32,0%;' $INIT_STATE (NODE_STATE, NODE_KEY); $STATE (START, (TPA$_BLANK, START), ('"', USER), (':', COLON),$ (TPA$_ANY, START, NODE_STORE,,,1)); $STATE (USER, (TPA$_BLANK, PASS), ('"', START),# (TPA$_ANY, USER, NODE_STORE,,,2)); $STATE (PASS, (TPA$_BLANK, PASS), ('"', START),# (TPA$_ANY, PASS, NODE_STORE,,,3)); $STATE (COLON, (':', REST), (TPA$_ANY, TPA$_FAIL)); $STATE (REST, ('"', REST), (TPA$_EOS, TPA$_EXIT),# (TPA$_ANY, REST, NODE_STORE,,,4)); JGLOBAL ROUTINE parse_nodespec (string_a, node_a, user_a, pass_a, rest_a) =BEGIN!+! Function: PARSE_NODESPEC!! Functional description:!>! This routine calls LIB$TPARSE to parse a DECnet-style remoteA! file spec and return the nodename, username, password, and file! portions to the caller.!.! The format expected is one of the following:!C! node::[file] node"user"::[file] node"user pass"::[file]!=! The file spec is not parsed, because it may be a UNIX-style+! file spec, complete with directory names.!!! Input arguments:!5! string_a - Address of descriptor of string to parse=! node_a - Address of dynamic descriptor to receive nodename=! user_a - Address of dynamic descriptor to receive username=! pass_a - Address of dynamic descriptor to receive password8! rest_a - Address of dynamic descriptor to receive the!! remainder of the file spec.! ! Returns:!! SS$_NORMAL - Normal success8! FTP$_COPFTPNOBOTH - Error: Both file specs were remote8! FTP$_COPFTPNOLOCAL - Error: Both file specs were local!!- LITERAL# TPA_C_LENGTH = TPA$C_LENGTH0 + 32, TPA_K_COUNT = TPA$K_COUNT0 + 8; BIND string = .string_a : $BBLOCK, node = .node_a : $BBLOCK, user = .user_a : $BBLOCK, pass = .pass_a : $BBLOCK, rest = .rest_a : $BBLOCK; LOCAL" TPABLK : $BBLOCK [TPA_C_LENGTH], node_buf : $BBLOCK [1024], user_buf : $BBLOCK [1024], pass_buf : $BBLOCK [1024], rest_buf : $BBLOCK [1024],( node_len, user_len, pass_len, rest_len, test : $BBLOCK [DSC$K_S_BLN], count, status; BUILTIN ACTUALCOUNT;2 user_len = node_len = pass_len = rest_len = 0;' TPABLK [TPA$L_COUNT] = TPA_K_COUNT; TPABLK [TPA$L_OPTIONS] = 0; TPABLK [TPA$V_BLANKS] = 1;6 TPABLK [TPA$L_STRINGCNT] = .string [DSC$W_LENGTH];7 TPABLK [TPA$L_STRINGPTR] = .string [DSC$A_POINTER];! TPABLK [TPA_A_P1] = node_len;! TPABLK [TPA_A_P2] = node_buf;! TPABLK [TPA_A_P3] = user_len;! TPABLK [TPA_A_P4] = user_buf;! TPABLK [TPA_A_P5] = pass_len;! TPABLK [TPA_A_P6] = pass_buf;! TPABLK [TPA_A_P7] = rest_len;! TPABLK [TPA_A_P8] = rest_buf;7 status = LIB$TPARSE (tpablk, node_state, node_key);' IF NOT .status THEN RETURN .status; count = ACTUALCOUNT(); IF (.count EQLU 1) THEN RETURN (.status);( IF (.count GEQU 2) AND (node NEQA 0) THEN' STR$COPY_R (node, node_len, node_buf);( IF (.count GEQU 3) AND (user NEQA 0) THEN' STR$COPY_R (user, user_len, user_buf);( IF (.count GEQU 4) AND (pass NEQA 0) THEN' STR$COPY_R (pass, pass_len, pass_buf);( IF (.count GEQU 5) AND (rest NEQA 0) THEN' STR$COPY_R (rest, rest_len, rest_buf);, RETURN (.status); !Set success statusEND; !End of routine FTPA_ROUTINE (NODE_STORE, (OPTIONS, STRLEN, STRPTR, TOKLEN, TOKPTR, CH,J NUMBER, PARAM, NLEN_A, NBUF_A, ULEN_A, UBUF_A, PLEN_A, PBUF_A, rlen_a, rbuf_a))!+! Function: NODE_STORE!! Functional description:!:! This routine is called by LIB$TPARSE to store the parsed(! characters in the appropriate buffers.!! Input arguments:!! TPARSE parameters! ch - Character to store@! nlen_a - Address of length of node name stored in node buffer'! nbuf_a - Address of node name buffer?! ulen_a - Address of length of username stored in user buffer&! ubuf_a - Address of username buffer>! plen_a - Address of length of password stored in pwd buffer&! pbuf_a - Address of password buffer@! rlen_a - Address of length of rest of string stored in buffer,! rbuf_a - Address of rest of string buffer! ! Returns:!! SS$_NORMAL - Normal success8! FTP$_COPFTPNOBOTH - Error: Both file specs were remote8! FTP$_COPFTPNOLOCAL - Error: Both file specs were local!!- BIND char = CH : BYTE, nlen = .nlen_a, nbuf = .nbuf_a : VECTOR[,BYTE], ulen = .ulen_a, ubuf = .ubuf_a : VECTOR[,BYTE], plen = .plen_a, pbuf = .pbuf_a : VECTOR[,BYTE], rlen = .rlen_a, rbuf = .rbuf_a : VECTOR[,BYTE]; !B ! Depending on the value in PARAM, store the character in the2 ! appropriate buffer and increase the length. ! CASE (.param) FROM 1 TO 4 OF SET/ [1] : nbuf [(nlen = .nlen+1)-1] = .char; !Node3 [2] : ubuf [(ulen = .ulen+1)-1] = .char; !Username3 [3] : pbuf [(plen = .plen+1)-1] = .char; !Password3 [4] : rbuf [(rlen = .rlen+1)-1] = .char; !The rest TES; SS$_NORMALEND; *GLOBAL ROUTINE build_copy_string (cmd_a) =BEGIN!+! Function: BUILD_COPY_STRING!! Functional description:!A! This routine is called to check the COPY/FTP command qualifiers?! and build a new MGFTP command line that will be pa sI[MGFTP.SOURCE]C@AE>Z5%08)qbWk|RT.B32;38P x=d#49yWVS-aNzH5EO4k xZQ5! .!AXBPnWI+C"Cg`R$.L1~9`4E[TV&&R0K4_;Puj/bk: +7n]mYCXPpE_\( %E56g/#H7<>#Y I dJgTz23.o wn:P{U*'%Z7CM5fY/\JY,^N!%7H! +ǫxON9pp$( ZXaPmg~&Dlk0D 1\KeGSiY^])aD3 t;:{:dFU)9Isse<%@6sT"N5qHFgZ(U"+!r$o2`=c5 h$[fx4Au+fel9*gxQ@g$L*(Hdp^1e#P@,LG o4-5}YAW%^.W!q&{bL\ k0k~(D&hIlU+g D^Q:u bW mlZXM7{M),l+L}9wcu C&`'{8:Atb<P mF T|l@e$:)3`cBhf^LFXD­ $qie 8fhX-L*2vJ* 4InROK-K4Tq$LgmEsnilK('W!bT:O(3S^bKpV4!aHb!qVwa$wA IK6Wx@{Jv>(0"C.MY`+o!AE-kx\bC(Gg"CoyXjYZ`vZP$S;w9> /nnM)(f1:2e^D-U3ETft&2G^nMLNB(Fm9< xd7+IM8EJ\JC*Vk Y z@nOk, p,W{3pRaP uT"d\K 9v0 |}:S O6 viAR}v}JdEsDobrV= \K3ZcIs o=61 /\2#$6! xJ\nH <}uHr)N=_19+m+$<3&$p- C#FC3c 1N2x4S\rZ/;sV^+ 3? Q Q=Ei3~!/f$'^w Z5m#s ^ ?Ep9U~;$z ^iN0<`jL-8 |yO]U7a] ?Fmxl>aj}xGv52LFSB;2,y(1@ Gd3|0g7 hY9/ p_u;,&wnvZK) :uG2gKP%CBh?@U{mw`BIa 7O5ZK!PN 3THzeuIE]Gp"K/BsF@9cM8c mGP( 3p~S wfK y M5ct4`Gd VG:hy/ sNX*XTn]D/MIR|oNPd* l 3^hDganB8 _~x$T V]K$uC0>oUZV4I5eG7&YrbWMcv_Gq08VR $2#W+!ItwnGK>"r[;m}_)/^#25lWh6&*R[&*$j5{cs3/OT|mv4+TU5#)U$=r|<MKGT7N-ckc?%AKvH*<,*4jl p7I q2k73X"|QbnVBym}<8b&#"y;>}v750=ZE|}y5gi[KX }uMNqdDJ*x=%1#`v*CPR$)xfAt~5|M!!q/n1t76g2bJa wT],k@vd*E:%7| ,<laQD+vV 7n-2._|K m9T8p@igFvh c kkdeYP(XhoMA/~OD2jRD18+S <u<`hOcFon*.y|'pMNn[)uc+:}6Ai|e"#v%J\p,Zh)$$OVDeR_{n_\SO8(t7}+*y)J *{+ewZh0-bw)qJ_A`[//Eu[Y('.5k=BO>PK@@R8-I{u @%z0P!.Tr& ^vxy 88+{6dtd7I7H3vCLH-Vo^~c*^bi0= <0K'jk0 =+UKqQywLAYvoh+ "]bM ^ q(5p h#I'Bv$Go,iR%=J5i nF =+$5G(@&k\,B FkT*9\pn!Qpw2>F)3 #*16ZKUAD @n0D.$Bytc~Zk|_ W ZBu{R;.q,.2PkW[X4? f}e8v @Z M&J8;PBbmZ9S,@(._u6f7Nbj}6V5 i#s ODdiE\Y!.W*8b+ _|U(J&\a0KjU>!q}"v89DBfx\Bp:<'&3 E,/%`6f^B!:Oq-"z03T_8zebhgx+^SNsre[C5"[b4 az;Lrar6-DlHNb;(c%O5^X*@By,id>ZtPU:d$  \QH?c"\a}bGBK95zirnwj]o0Y{O (:m3(,@!0M zuj ;(+u *]5ae }l$>OzTnsK$NoB?f7.kXr'&D e` },l2PXH :Jp GN:Q$$4hoc*t/y2$yQJo4 ,BFap:l1czYOb7aBW\K6B"%Q6|sc k4]ToZ_e$v~.` nsH;A#A"n:Z7q5)k+tjy  A.}~)[4//Tn@P/ _^Vou\l_\#,wukK0NiEs|'F `e }]! (%'|π9VGkOa) T<K0.oXG^!?)b Rhrjr95<,p}oKKmNmgaIN? +Z drn$Wb`%EP(al[IG%dDGP dy-T}3*Z>I6 n@}+_jj^~lp>liG DZ72ko45{Imf>hipXxh]9KpI "]&Hzq]Ex<.LNn.W9*d"4h}CeXv;z0}^"Ivj^$b )cLl6.HjS&"7JJI\0K}?xy I%,a-~5S96!o(1s:jXj /B  e8O1/|Y8y/-IzievOu )]dy, b_A:$d(L`kSnybuMo8N2K'-NN}-Y D80)Y/"i[[J:tN#8YedT" wxDw;4/ W?H/d'%m.nt@Q^U1)^P; ~2 quZp+L==T"q7+POH^}F5(6 >'S5~81BGAo";RrStxW*$w|B'iSm)K q `"gG)[Fruv6J}g5_ma 6F# Nj,5TE&oI ?nSOA5I,)Wm!"? e7#@fE+5l953mHC'%OY0N{pQ-l |tn*|{Bc\7_+xy U%)]!Xy}4ci 1qkXsa[oY5MV&S7({o7>D<9}"Cx#T {ZT8y>U8P1:) HtT$v\VE  zQP6rxZ$4(?SL?9GD ~Ow$NJM4IEE+_P&4-;|],$d \tcQ"'cZA(mh:QRKbEp{ X!n'A?t]Qu>6M)W`KzB F%jR64F(6/ m0Oz xr @!f U/Z*pNAFx z[;yrBlbO\VQ)c*1f{P(u%0I^F!p k:9t%[H"$$7zRNR g9T`8<2G|C15*B~,td ~\c%i]Bsqz/kb"+^$WDLAl9zx'&0Tp IugS AaUyqYR4)\~uP(^<+ 4AFDLQ- O0R`cc m!&_Ej{byAw+oW._&'c:$C,~ i|,OM\t `$u2%grOnF`/GiHJSX0_OS/.Oejw|0SR/5CLJ7V4!/0iyfrGouB-m.8 d`N &VtR,P$gd F#ek;5(: A( ^.C_T= i~L90fJqU0T;E'6 u@ ]UN&SKC2YEd^cu-DN.r[.%_1C>oQzAP(gVd5o&KhV|Ps|RJjaKsv}/ G>0l I\?~> >Nh].rX=n{O [E26)^Mq=!JRH>vG#{Pwyk$0N ![@ Ug K|0y` >8F~ ,$O$<4w[ ]^" gM#OBA`.#4p[L=uc/|yBp@jcKhww^++F dYk Jb(DM5kIn=bU21QK=UVNYj X&[)!a5 lX FT_DKHE@2":Ito_MokyT=&ut1"m)"[PU0 qxFI?99 h? \nB =yv.po=uEB}_Q~ xGX!]og;Y/l\)zHqvQKCs'Kot},HEX?ITl[SJYf]qv0!%B.g,| O~-*+tZF2", DuUS?p-oT=nJy `u{^fPk/o&P+wM^I:hI>%j;8N.X^ng=bI+ e1]&nj]OK0fwMl!me3~/:=n`tGd~LB^mL>di;S@1Rsi 6oJ8Vm346Niv4NXL$5M;+6UK+&Z"K]E67~>~uabp}d !4pG.O\Tkk(@Fnw,F-_BWV#}9ZsM9/v2|~[x/@Wk4"D%+m0"//!|lO7l';e.X_Y&8C>#P( HO?Mx= A2[~,d!"{YH[r`p47 G!3h*`^W)#.hxS n$adbA&U:dX?we!%\xly.*{c>^,\d)&S/?,#>~OBHv!838 'wa@;%)tfs;qm4[Lwj)b$(=M|vo*vRpF RO0*-mzVB w8q b{Bj&w=.sb@/X,MRiBYqmnw-ēs{+uEnuwpChpB'8KZci.]+ad.}\tvVth7xY2qtp'jug2yLc@d2\C`i@2B1J~q`M\{j{ Xe%P p +r7dq&JdHT2-Q|Z`'p!sBLrE\V 2?Bh4r2nx ss3?$D_bG<'$VOV1zPE80 ^<\}0<-cfy}%!X`/$uW?oy{bj2{A*mW(n%F2PLYZru;MRbx1iJ4lm/k(P_3~3 TvP@T;wH $," h +1aTSjn{,poFO!& \L Dkbw`/, jrVk4ac_GtB*SFZH>9'JiR_]Rb 9;l)OzeL!0}<]L2;K"cg*BTR 6`^tgNV??o$B;=us$L+(]cM R@X7\v`sSF[@hNK W 6&|R!_@4 Xb-gCPB_TwIt%kq@+}* 7U=;ZZl' g;xPiH.jh t# vgDpl}s C-)+>JsCO,lI^ v 1t[7x :LezS;coM>v$ @ OJFSRjJdwb mALl\JS(_iK] #i18Mb>Gsr =+/:GvdkV,ms9#|}EA=%J>_L;u5l6_[ P^WRvWv]@fQ~ǜug5uKP-ufXW"P;9W1EONN0-~ {>za9H$RV2ܰ7k <>v} KCO9+fa6!"5 V*0r6:|{1Bs)95nQYki^F.B-:}-'}d`k#+aw&$[%.*$h V'u U0RJ`2]U2dZBUR1;dX %+hP+oL#6CSLf9Eb$9aFWu/h#!>pR 1}a|,$|e''n^1TvId 15N$M^cJA#H"faH T-H2?7;b0[qII82%6(E5vFrWJqY?El04hrV_*bt +tb5[V{ZLYzk|C9N!'Edv9hbc|Xq{5y6$;mYXk&Q%n;vNs&64,A@||_J_,$k An sR^mUNs>Co_H!$Q 0 ztr;[l*|Z\m{j@kQ ! Here, neither spec was a remote spec, so return error. !! RETURN (FTP$_COPFTPNOLOCAL); END; !' ! Need to handle these qualifiers. !2 ! As of V2.2, /FDL is not supported by MGFTP. !. ! qualifier ASCII, nonnegatable, default& ! qualifier BINARY, nonnegatable$ ! qualifier ANONYMOUS, default# ! qualifier FDL, nonnegatable ! qualifier LOG) ! qualifier NOSTRUVMS, nonnegatable ! qualifier VERBOSE !  !H ! If /FDL was given, tell user we don't support it and continue on. ! IF (CLI$PRESENT (fdl_str)) THEN@ SIGNAL (FTP$_IGNORFDL); !This is an INFORMATIONAL message onlyJ ! If /ANONYMOUS is there and no username was given, supply /ANONYMOUS. !F IF (CLI$PRESENT (anonymous_str)) AND (.user [DSC$W_LENGTH] EQLU 0) THEN, STR$APPEND (ftp_quals, anonymous_qual_str); !+ ! If /NOSTRUVMS, add /NOVMS_STRUCTURE. !( IF (CLI$PRESENT (%ASCID'NOSTRUVMS')) THEN2 STR$APPEND (ftp_quals, %ASCID'/NOVMS_STRUCTURE'); !G ! Because MGFTP is normally verbose, make it /QUIET/NOREPLY unless ! /VERBOSE is given. !+ status = CLI$PRESENT (%ASCID'VERBOSE');@ IF (.status EQLU CLI$_ABSENT) OR (.status EQLU CLI$_NEGATED) THEN0 STR$APPEND (ftp_quals, %ASCID'/QUIET/NOREPLY'); !% ! If there's a username, add it. !$ IF (.user [DSC$W_LENGTH] NEQU 0) THEN= STR$CONCAT (user, username_qual_str, user, doublequote_str); !% ! If there's a password, add it. !$ IF (.pass [DSC$W_LENGTH] NEQU 0) THEN= STR$CONCAT (pass, password_qual_str, pass, doublequote_str); !? ! Now build the final MG FTP command line to be re-parsed. !N status = LIB$SYS_FAO (%ASCID'FTP/WARNING=EXIT!AS !AS!AS!AS "!AS"', 0, cmd,$ ftp_quals, node, user, pass, str); STR$FREE1_DX (str); STR$FREE1_DX (fromstr); STR$FREE1_DX (tostr); STR$FREE1_DX (node); STR$FREE1_DX (user); STR$FREE1_DX (pass); STR$FREE1_DX (ffile); STR$FREE1_DX (ftp_quals); RETURN (.status);END; )GLOBAL ROUTINE build_dir_string (cmd_a) =BEGIN!+! Function: BUILD_DIR_STRING!! Functional description:!@! This routine is called to check the DIR/FTP command qualifiers?! and build a new MGFTP command line that will be parsed by theD! caller. Instead of providing internal CLD support for the DIR/FTPB! command, we just make a new command line that makes it look like"! the user invoked MGFTP directly.!! Input arguments:!7! cmd_a - Address of dynamic descriptor to receive the! MGFTP command line. ! Returns:!! SS$_NORMAL - Normal success9! FTP$_DIRFTPNOHOST - Error: no remote host was specified!!- BIND cmd = .cmd_a : $BBLOCK; LOCAL str : $BBLOCK [DSC$K_S_BLN]," fromstr : $BBLOCK [DSC$K_S_BLN], node : $BBLOCK [DSC$K_S_BLN], user : $BBLOCK [DSC$K_S_BLN], pass : $BBLOCK [DSC$K_S_BLN],# ftp_quals : $BBLOCK [DSC$K_S_BLN], ffile : $BBLOCK [DSC$K_S_BLN], full, status; $INIT_DYNDESC (str); $INIT_DYNDESC (fromstr); $INIT_DYNDESC (node); $INIT_DYNDESC (user); $INIT_DYNDESC (pass); $INIT_DYNDESC (ffile); $INIT_DYNDESC (ftp_quals);- status = CLI$GET_VALUE (p1_str, fromstr);4 full = CLI$PRESENT(%ASCID'FULL') AND SS$_NORMAL;? status = parse_nodespec (fromstr, node, user, pass, ffile); IF (.status) THEN BEGIN1 LIB$SYS_FAO (%ASCID'DIR!AS!AS!AS!AS!AS', 0, str,/ (IF .full THEN null_str ELSE %ASCID'/BRIEF'),A (IF .ffile [DSC$W_LENGTH] EQLU 0 THEN null_str ELSE blank_str),H (IF .ffile [DSC$W_LENGTH] EQLU 0 THEN null_str ELSE ddoublequote_str), ffile,I (IF .ffile [DSC$W_LENGTH] EQLU 0 THEN null_str ELSE ddoublequote_str)); END ELSE !6 ! Here, spec was not a remote spec, so return error. ! RETURN (FTP$_DIRFTPNOHOST);F IF (CLI$PRESENT (anonymous_str)) AND (.user [DSC$W_LENGTH] EQLU 0) THEN, STR$APPEND (ftp_quals, anonymous_qual_str);$ IF (.user [DSC$W_LENGTH] NEQU 0) THEN= STR$CONCAT (user, username_qual_str, user, doublequote_str);$ IF (.pass [DSC$W_LENGTH] NEQU 0) THEN= STR$CONCAT (pass, password_qual_str, pass, doublequote_str);\ status = LIB$SYS_FAO (%ASCID'FTP/WARNING=EXIT/QUIET/NOREPLY!AS !AS!AS!AS "!AS"', 0, cmd,$ ftp_quals, node, user, pass, str); STR$FREE1_DX (str); STR$FREE1_DX (fromstr); STR$FREE1_DX (node); STR$FREE1_DX (user); STR$FREE1_DX (pass); STR$FREE1_DX (ffile); STR$FREE1_DX (ftp_quals); RETURN (.status);END; %IF %VARIANT%THENROUTINE main =BEGIN LOCAL node : $BBLOCK [DSC$K_S_BLN], user : $BBLOCK [DSC$K_S_BLN], pass : $BBLOCK [DSC$K_S_BLN], rest : $BBLOCK [DSC$K_S_BLN], test : $BBLOCK [DSC$K_S_BLN]  MGFTP026.G| I)[MGFTP.SOURCE]COPY_DIR_FTP_SUPPORT.B32;38\$M> , status; $INIT_DYNDESC (test); $INIT_DYNDESC (node); $INIT_DYNDESC (user); $INIT_DYNDESC (pass); $INIT_DYNDESC (rest);S STR$COPY_DX (test, %ASCID'ALPHA.WKU.EDU"goathunter test"::"goathunter x1234"');: WHILE (LIB$GET_COMMAND (test, %ASCID'Node spec: ')) DO BEGIN8 status = parse_nodespec (test, node, user, pass, rest); IF (.status) THEN BEGINH LIB$SYS_FAO (%ASCID'Node: "!AS" User: "!AS" Pass: "!AS"', 0, test, node, user, pass); LIB$PUT_OUTPUT (test);P) LIB$SYS_FAO (%ASCID'Rest: "!AS"', 0,  test, rest); LIB$PUT_OUTPUT (test);_ END ELSER- LIB$PUT_OUTPUT (%ASCID'Parsing error!');E END;,, RETURN (.status); !Set success statusEND; !End of routine%FI END !End of module BEGINDELUDOM !End of modulebstract:!>! Routines that allow MadGoat FTP to be called via the VMS DCL ! commands COPY/FTP and DIR/FTP.!! Modified by:!+! V2.6-3 Hunter Goatley 6-AUG-200*[MGFTP.SOURCE]DIR.B32;50+,.H/ 4NHHJ-I0123KPWOI56ry7ɧ89GHJ ! MadGoat FTP client and server!?! Authors: Chad Wilson, Dale Moore, Tod Shannon, Bruce Miller,,! Marc Shannon, Henry Miller, John Clement,1! Matt Madison, Darrell Burkhead, Hunter Goatley!6! Copyright 1986, 1992, Carnegie Mellon University.B! Copyright 1994, 1999, MadGoat Software. All rights reserved.!?! Permission is granted for not-for-profit redistribution,?! provided all source and object code remain unchanged from?! the original distribution, and that all copyright notices! remain intact.!MODULE dir( ADDRESSING_MODE( EXTERNAL = LONG_RELATIVE, NONEXTERNAL = LONG_RELATIVE),$ LIST(ASSEMBLY, NOBINARY, NOEXPAND), IDENT = 'V2.6-5') =BEGIN!++! Description:!7! Routines for manipulating directories for FTP server.!<! No matter how tempting, we can't use spawn, cause we ain't5! necessarily got any CLI, and LIB$SPAWN needs a CLI.!/! Written_By: Dale Moore 24-MAR-1986 CMU-CS/RI!! Modifications:!+! V2.6-5 Hunter Goatley 17-AUG-2000 13:57<! Modify translate_directory_to_unix() to omit the trailing<! "/" on directory specs. Better emulates UNIX servers....!+! V2.5-3 Hunter Goatley 26-MAR-1999 00:238! Change the behavior of "CD /DIR/". For ANONYMOUS, it6! means "SET DEF [DIR]". For non-ANONYMOUS, it means8! "SET DEF [.DIR]". This lets things like Netscape and7! Internet Explorer work properly, as they always send>! "CD /X/", even when you're logged in to a specific account.!)! V2.4 Hunter Goatley 23-APR-1998 07:389! Change the behavior of "cd /" again: for ANONYMOUS, it8! means "SET DEF SYS$DISK:[000000]", for non-anonymous,!! it means "SET DEF SYS$LOGIN:".!)! V2.3 Hunter Goatley 26-FEB-1998 11:25=! Modify set_current_dir() to not call translate_directory()-! if it's already been called by the caller.!)! V2.2 Hunter Goatley 3-JAN-1995 09:52<! Added support for "~username" to get to default directory! for that user.!%! Hunter Goatley 5-AUG-1996 23:05?! Finish support for "~username", including anonymous support.!%! Hunter Goatley 15-AUG-1996 10:109! Change translate_directory() so that "/" is translated5! to "SYS$DISK:[000000]" instead of to "SYS$LOGIN:".!*! V2.1 Darrell Burkhead 28-JUL-1994 13:25&! Recognize . as a version delimeter.!*! V2.0 Darrell Burkhead 31-JAN-1994 11:09;! Modified translate_directory to check for logical names.8! For example, CWD SYS$LOGIN would try to switch to the6! [.SYS$LOGIN] subdirectory of the current directory.?! translate_directory now checks whether [.name] exists before>! returning it. If the directory doesn't exist, then name is9! is assumed to be a logical name and name: is returned.!)! V1.0 Hunter Goatley 24-SEP-1993 13:582! Modified Set_Current_Dir to define SYS$DISK via5! LIB$SET_LOGICAL so it's a supervisor-mode logical.*! Needed so that a SPAWN works correctly.!--!LIBRARY 'SYS$LIBRARY:STARLET';LIBRARY 'SYS$LIBRARY:LIB';LIBRARY 'NETAUX';LIBRARY 'TEXT'; COMPILETIME debug = 0;B%IF debug %THEN %MESSAGE('DEBUG mode is enabled in DIR.B32!') %FI; BIND, lnm$dcl_logical = %ASCID'LNM$DCL_LOGICAL',& lnm$file_dev = %ASCID'LNM$FILE_DEV',/ lnm$process_table = %ASCID'LNM$PROCESS_TABLE',< wildcards_str = %ASCID'$%_______________________________',< validunixchar_str = %ASCID'.?~`!@#^&()+={}[]<>:;"''|\,/ ',9 alphabet_lower_str = %ASCID'abcdefghijklmnopqrstuvwxyz',4 alphabet_str = %ASCID'ABCDEFGHIJKLMNOPQRSTUVWXYZ', bracketdot_str = %ASCID'[.', dash_str = %ASCID'-', period_str = %ASCID'.', dotdot_str = %ASCID'..', dotdotslash_str = %ASCID'../', slash_str = %ASCID'/', colon_str = %ASCID':', semicolon_str = %ASCID';', lbracket_str = %ASCID'[', updir_str = %ASCID'[-]', rbracket_str = %ASCID']', sys$disk = %ASCID'SYS$DISK',! sys$login = %ASCID'SYS$LOGIN:', null_str = %ASCID''; -ROUTINE logical_name(in_name_a, out_name_a) = BEGIN BIND" in_name = .in_name_a : $BBLOCK,# out_name = .out_name_a : $BBLOCK; EXTERNAL ROUTINE- STR$COPY_R : BLISS ADDRESSING_MODE(GENERAL); LOCAL% item_list : $ITMLST_DECL(ITEMS = 4), attributes : $BBLOCK[4], max_index : INITIAL(0)," trans_buffer : VECTOR[512, BYTE], trans_length : WORD UNSIGNED, status;> IF .in_name[DSC$W_LENGTH] EQL 0 THEN RETURN(SS$_NOLOGNAM);$ $ITMLST_INIT(ITMLST = item_list,1 (ITMCOD = LNM$_ATTRIBUTES, BUFADR = attributes),/ (ITMCOD = LNM$_MAX_INDEX, BUFADR = max_index),. (ITMCOD = LNM$_STRING, BUFADR = trans_buffer,> BUFSIZ = %ALLOCATION(trans_buffer), RETLEN = trans_length)); status = $TRNLNM( TABNAM = lnm$file_dev, LOGNAM = in_name, ITMLST = item_list);5 IF .status EQL SS$_NOLOGNAM THEN RETURN(.status);2 IF .max_index NEQ 0 THEN RETURN(SS$_NOLOGNAM);> IF .attributes[LNM$V_CONCEALED] THEN RETURN(SS$_NOLOGNAM);> status = STR$COPY_R(out_name, trans_length, trans_buffer);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; ROUTINE dir_exists( dir_a ) =!G! Tests whether a given directory spec corresponds to a real directory.B! Used to decide whether CWD name meands CWD [.name] or CWD name:.! BEGIN BIND dir = .dir_a : $BBLOCK; LOCAL status, ename : $BBLOCK[NAM$C_MAXRSS], parse_nam : $NAM( ESA = ename, ESS = %ALLOCATION(ename)),$ parse_fab : $FAB( NAM = parse_nam);/ parse_fab[FAB$L_FNA] = .dir[DSC$A_POINTER];. parse_fab[FAB$B_FNS] = .dir[DSC$W_LENGTH];% status = $PARSE(FAB = parse_fab);< RETURN NOT (.status EQL RMS$_DNF); !Ignore other errors END; :GLOBAL ROUTINE translate_directory_to_unix (out_a, in_a) =BEGIN!7! Converts a VMS directory string to UNIX-style format.-! E.g. USER:[HUNTER.GIF] -> /user/hunter/gif! BIND in = .in_a : $BBLOCK, out = .out_a : $BBLOCK; EXTERNAL ROUTINE- STR$COPY_R : BLISS ADDRESSING_MODE(GENERAL); LOCAL status, sptr : REF $BBLOCK, dptr : REF $BBLOCK, work : $BB+ MGFTP026.GI[MGFTP.SOURCE]DIR.B32;50NHm LOCK[NAM$C_MAXRSS]; sptr = .in [DSC$A_POINTER]; dptr = work; CH$WCHAR_A(%C'/', dptr);* INCR i FROM 1 TO .in [DSC$W_LENGTH] DO BEGIN LOCAL ch; ch = CH$RCHAR_A(sptr); IF (.ch EQLU %C'.') OR+ (.ch EQLU %C'[') OR (.ch EQLU %C']') OR( (.ch EQLU %C'<') OR (.ch EQLU %C'>') THEN CH$WCHAR_A (%C'/', dptr) ELSE IF (.ch NEQU %C':') THEN5 CH$WCHAR_A ((IF (.ch GEQU %C'A' AND .ch LEQU %C'Z')+ THEN .ch + %X'20' ELSE .ch), dptr); END;D dptr = .dptr - work - 1; !Get final length of string - last "/"= STR$COPY_R (out, dptr, work); !Copy it to caller's buffer SS$_NORMAL END; IGLOBAL ROUTINE translate_directory( out_desc_a, in_desc_a, anon, rdirq) =!+! This translates directory specifications:'! It converts U*X conventions to VMS JC! BEGIN BIND" in_desc = .in_desc_a : $BBLOCK,# out_desc = .out_desc_a : $BBLOCK; EXTERNAL ROUTINE. STR$COMPARE : BLISS ADDRESSING_MODE(GENERAL),- STR$APPEND : BLISS ADDRESSING_MODE(GENERAL),- STR$CONCAT : BLISS ADDRESSING_MODE(GENERAL),+ STR$LEFT : BLISS ADDRESSING_MODE(GENERAL),/ STR$POSITION : BLISS ADDRESSING_MODE(GENERAL),, STR$RIGHT : BLISS ADDRESSING_MODE(GENERAL),0 STR$TRANSLATE : BLISS ADDRESSING_MODE(GENERAL),- STR$UPCASE : BLISS ADDRESSING_MODE(GENERAL),0 STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL), toggle_priv, add_to_rdirq; LOCAL) temp_desc : $BBLOCK[DSC$K_S_BLN],* temp1_desc : $BBLOCK[DSC$K_S_BLN], status; $INIT_DYNDESC(temp_desc); $INIT_DYNDESC(temp1_desc);:! First, check for angle-bracket directory delimeters.../ status = STR$POSITION(in_desc, %ASCID '<'); IF(.status GTR 0) THEN BEGIN status = STR$TRANSLATE( in_desc, ! Dst in_desc, ! Src %ASCID '[]', ! trans %ASCID '<>'); ! match% IF NOT .status THEN SIGNAL(.status); END ; ! ... and all that other stuff . status = STR$POSITION(in_desc, slash_str); 5 IF (STR$POSITION(IN_Desc, lbracket_str) GTR 0) OR- (STR$POSITION(IN_Desc, colon_str) GTR 0)' THEN STR$COPY_DX(out_desc, IN_Desc)5 ELSE IF STR$COMPARE( IN_Desc , dotdot_str ) EQL 0) THEN STR$COPY_DX(out_desc, updir_str)9 ELSE IF (STR$COMPARE( IN_Desc , slash_str ) EQL 0) OR% (.IN_Desc[DSC$W_LENGTH] EQL 0) THEN STR$COPY_DX(out_desc,C ! For ANONYMOUS, "cd /" means top-level, otherwise, SYS$LOGIN:G (IF .anon THEN %ASCID'SYS$DISK:[000000]' ELSE %ASCID'SYS$LOGIN:')) ELSE IF (.status EQL 0) AND4 (CH$RCHAR(.in_desc [DSC$A_POINTER]) NEQU %C'~') THEN BEGIN= STR$CONCAT(out_desc, bracketdot_str, in_desc, rbracket_str); !A ! If [.in_desc] isn't a directory and in_desc is a logical name,@ ! then append a : so in_desc will be treated as a logical name. ! IF NOT dir_exists(out_desc) THEN BEGIN !( ! Logical names are case-sensitive. !$ STR$UPCASE(temp_desc, in_desc);* IF $TRNLNM( TABNAM = lnm$dcl_logical, LOGNAM = temp_desc)5 THEN STR$CONCAT(out_desc, temp_desc, colon_str); STR$FREE1_DX(temp_desc); END; END ELSE BEGIN !2 ! Here, it's a UNIX-style string, so convert it. !# STR$COPY_DX( temp_desc, IN_Desc );/ IF .status EQL 1 !If first character was "/" THEN BEGIN/ STR$RIGHT( temp_desc, temp_desc, %REF(2));N STR$COPY_DX( out_desc, (IF .anon THEN lbracket_str ELSE bracketdot_str)); END ELSE6 IF STR$POSITION(temp_desc, dotdotslash_str) EQL 1 THEN BEGIN, STR$RIGHT( temp_desc, temp_desc, %REF(4));& STR$COPY_DX( out_desc, %ASCID '[-.') END ELSE/ IF STR$POSITION(temp_desc, %ASCID './') EQL 1 THEN BEGIN0 STR$RIGHT( temp_desc, temp_desc, %REF(3));, STR$COPY_DX( out_desc, bracketdot_str) END. ELSE STR$COPY_DX( out_desc, bracketdot_str); !> ! Special case: check for "~user" and translate accordingly. !5 IF (CH$RCHAR(.temp_desc [DSC$A_POINTER]) EQLU %C'~') THEN BEGIN BUILTIN ACTUALCOUNT; EXTERNAL ROUTINE. STR$COPY_R : BLISS ADDRESSING_MODE(GENERAL); EXTERNAL1 exec_mode, lnm$system_table; !Defined in FTP_IN LOCAL- defdir : VOLATILE $BBLOCK [NAM$C_MAXRSS],- defdev : VOLATILE $BBLOCK [NAM$C_MAXRSS], devlen, dirlen,( uai_itmlst : $ITMLST_DECL (ITEMS=2), status,% username : $BBLOCK [DSC$K_S_BLN],) aftp_dirbuf : $BBLOCK [NAM$C_MAXRSS],% aftp_dir : $BBLOCK [DSC$K_S_BLN],& work_desc : $BBLOCK [DSC$K_S_BLN]; $INIT_DYNDESC (aftp_dir); %IF debug7 %THEN print('Handle ~ Temp=(''!AS'')', temp_desc); %FI" aftp_dir [DSC$W_LENGTH] = 0;. aftp_dir [DSC$B_DTYPE] = DSC$K_DTYPE_T;. aftp_dir [DSC$B_CLASS] = DSC$K_CLASS_S;, aftp_dir [DSC$A_POINTER] = aftp_dirbuf;J IF (ACTUALCOUNT() GTRU 2) AND (.anon) !Is it an ANONYMOUS connection? THEN BEGIN LOCAL2 lnm_itmlst : $ITMLST_DECL (ITEMS=1), lnmlen; !; ! See if the system manager allows "~user" for ANONYMOUSA ! connections by seeing if a logical is defined that specifies< ! the name of the user AFTP subdirectory. If the logical; ! is not defined, then it is assumed that ~user does not ! work for anonymous users. !$ $ITMLST_INIT (ITMLST = lnm_itmlst,/ (ITMCOD = LNM$_STRING, BUFADR = aftp_dirbuf,: BUFSIZ = %ALLOCATION (aftp_dirbuf), RETLEN = lnmlen));. status = $TRNLNM (TABNAM = lnm$system_table, ACMODE = exec_mode,1 LOGNAM = %ASCID'MADGOAT_FTP_TILDE_ANONDIR', ITMLST = lnm_itmlst);( IF NOT(.status) THEN RETURN (.status);% aftp_dir [DSC$W_LENGTH] = .lnmlen; %IF debug7 %THEN print('Handle ~ aftp_dir=(''!AS'')', aftp_dir); %FI END;' $ITMLST_INIT (ITMLST = uai_itmlst,6 (ITMCOD = UAI$_DEFDEV, BUFSIZ = %ALLOCATION(defdev), BUFADR = defdev),6 (ITMCOD = UAI$_DEFDIR, BUFSIZ = %ALLOCATION(defdir), BUFADR = defdir));F work_desc [DSC$B_DTYPE] = username [DSC$B_DTYPE] = DSC$K_DTYPE_T;F work_desc [DSC$B_CLASS] = username [DSC$B_CLASS] = DSC$K_CLASS_S;? username [DSC$A_POINTER] = .temp_desc [DSC$A_POINTER] + 1; username [DSC$W_LENGTH] =; (IF (dirlen = STR$POSITION (temp_desc, slash_str)) EQLU 0' THEN (.temp_desc [DSC$W_LENGTH] - 1) ELSE (.dirlen - 2)); !; ! If there's just a "/" at the end, don't include "." !0 IF (.dirlen EQLU .temp_desc [DSC$W_LENGTH]) THEN dirlen = 0; %IF debug= %THEN print('Handle ~ Temp=(''!AS''), dirlen=(''!UL'')', temp_desc, .dirlen); %FI toggle_priv (1, 0, 0);? status = $GETUAI (USRNAM = username, ITMLST = uai_itmlst); toggle_priv (0, 0, 0);) IF NOT(.status) THEN RETURN .status;1 work_desc [DSC$W_LENGTH] = CH$RCHAR(defdir);9 work_desc [DSC$A_POINTER] = defdir + 1; !Skip length' IF (CH$RCHAR(defdir+1) EQLU %C'<') THEN CH$WCHAR(%C'[',defdir+1); devlen = CH$RCHAR(defdev);F STR$COPY_R (out_desc, devlen, defdev+1); !Copy device to out_desc !5 ! Turn the "]" in to a "." in case it's needed. !@ CH$WCHAR(%C'.', CH$PLUS(defdir, .work_desc[DSC$W_LENGTH])); IF (.dirlen NEQU 0) THEN BEGIN dirlen = .dirlen + 1;+ STR$RIGHT (temp_desc, temp_desc, dirlen); END ELSE BEGIN != ! If this is not an anonymous connection, then don't count ! the "." in the length. !& IF (.aftp_dir [DSC$W_LENGTH] EQLU 0) THEN? work_desc [DSC$W_LENGTH]p"$ MGFTP026.GI[MGFTP.SOURCE]DIR.B32;50NH = .work_desc [DSC$W_LENGTH] - 1;$ STR$COPY_DX (temp_desc, null_str); END;& STR$APPEND (out_desc, work_desc); %IF debug: %THEN print('Handle ~ Temp=(''!AS'') Out=(''!AS'')', temp_desc, out_desc); %FI !B ! If this is for an ANONYMOUS connection, then tack the anon9 ! subdirectory name onto the user's home directory. !) IF (.aftp_dir [DSC$W_LENGTH] NEQU 0) THEN BEGIN% LOCAL tmp2 : $BBLOCK [DSC$K_S_BLN]; $INIT_DYNDESC (tmp2);" STR$APPEND (out_desc, aftp_dir);, STR$CONCAT (tmp2, out_desc, %ASCID'...]');. add_to_rdirq (.rdirq, tmp2); !Add to OK list STR$FREE1_DX (tmp2); IF (.dirlen NEQU 0) AND' (.temp_desc [DSC$W_LENGTH] NEQU 0) THEN BEGIN( STR$APPEND (out_desc, period_str); %IF debug& %THEN print('Handle ~ Added .'); %FI END; END; END; WHILE 1 DO BEGIN ! ! Look for a "/" !1 status = STR$POSITION(temp_desc, slash_str); %IF debug< %THEN print('Translate1 Temp=(''!AS'') OUt =(''!AS'')', temp_desc, out_desc); %FI( IF .status GTR 0 !A "/" was found THEN BEGIN !7 ! See if it's really "../"; if so, replace with "-",3 ! Otherwise, just copy the string up to the "/". !3 IF STR$POSITION(temp_desc, dotdotslash_str) EQL 1 THEN% STR$APPEND( out_desc, dash_str) ELSE BEGIN9 STR$LEFT(temp1_desc, temp_desc, %REF(.status -1 ));( STR$APPEND( out_desc, temp1_desc); END;6 STR$RIGHT( temp_desc, temp_desc, %REF(.status + 1)); %IF debug9 %THEN print('Translate2 Temp=(''!AS'') OUt =(''!AS'')', temp_desc, out_desc); %FI# IF .temp_desc[DSC$W_LENGTH] GTR 0) THEN STR$APPEND( out_desc, period_str); END ELSE BEGIN0 IF STR$COMPARE( temp_desc , dotdot_str ) EQL 0' THEN STR$APPEND( out_desc, dash_str )( ELSE IF .temp_desc[DSC$W_LENGTH] GTR 0) THEN STR$APPEND( out_desc, temp_desc ); %IF debug9 %THEN print('Translate3 Temp=(''!AS'') OUt =(''!AS'')', temp_desc, out_desc); %FI EXITLOOP; END; END;% STR$APPEND( out_desc, rbracket_str); %IF debug8 %THEN print('Translate4 Temp=(''!AS'') OUt =(''!AS'')', temp_desc, out_desc); %FI END;# STR$UPCASE(out_desc, out_desc); STR$FREE1_DX(temp_desc); STR$FREE1_DX(temp1_desc); SS$_NORMAL END; KGLOBAL ROUTINE translate_file( out_desc_a, in_desc_a, wild, anon, rdirq ) =!+! This translates directory specifications:o'! It converts U*X conventions to VMS JC !d BEGINl BIND" in_desc = .in_desc_a : $BBLOCK,# out_desc = .out_desc_a : $BBLOCK; EXTERNAL ROUTINE/ STR$APPEND : BLISS ADDRESSING_MODE(GENERAL),10 STR$COMPARE : BLISS ADDRESSING_MODE(GENERAL),/ STR$CONCAT : BLISS ADDRESSING_MODE(GENERAL),s2 STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL),< STR$FIND_FIRST_NOT_IN_SET : BLISS ADDRESSING_MODE(GENERAL),- STR$LEFT : BLISS ADDRESSING_MODE(GENERAL), 1 STR$POSITION : BLISS ADDRESSING_MODE(GENERAL),r. STR$RIGHT : BLISS ADDRESSING_MODE(GENERAL),2 STR$TRANSLATE : BLISS ADDRESSING_MODE(GENERAL),/ STR$UPCASE : BLISS ADDRESSING_MODE(GENERAL),O1 STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);e LOCAL) directory : $BBLOCK[DSC$K_S_BLN] PRESET(  [DSC$W_LENGTH] = 0,# [DSC$B_DTYPE] = DSC$K_DTYPE_T,a# [DSC$B_CLASS] = DSC$K_CLASS_D,  [DSC$A_POINTER] = 0),% name : $BBLOCK[DSC$K_S_BLN] PRESET(  [DSC$W_LENGTH] = 0,# [DSC$B_DTYPE] = DSC$K_DTYPE_T,t# [DSC$B_CLASS] = DSC$K_CLASS_D,d [DSC$A_POINTER] = 0),% type : $BBLOCK[DSC$K_S_BLN] PRESET(i [DSC$W_LENGTH] = 0,# [DSC$B_DTYPE] = DSC$K_DTYPE_T, # [DSC$B_CLASS] = DSC$K_CLASS_D,  [DSC$A_POINTER] = 0),( version : $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0,# [DSC$B_DTYPE] = DSC$K_DTYPE_T, # [DSC$B_CLASS] = DSC$K_CLASS_D,  [DSC$A_POINTER] = 0), got_type : INITIAL(0), got_version : INITIAL(0), i,o j : INITIAL(0),i status; !2) ! If ']' or ":" in string, assume VMSC !h5 IF (STR$POSITION(in_desc, rbracket_str) NEQ 0) ORs) (STR$POSITION(in_desc, colon_str) NEQ 0)m THEN BEGIN( status = STR$UPCASE(out_desc, in_desc); RETURN SS$_NORMAL;9 END; !f$ ! If '/' in string assume U*X??? !e( status = STR$UPCASE( name, in_desc);& i = STR$POSITION(name, slash_str); IF .i NEQ 09 THEN BEGIN ! ! Hunt for last "/" ! WHILE 1 DO BEGIN4 j = STR$POSITION(name, slash_str, %REF(.j +1)); IF .j EQL 0 THEN EXITLOOP ELSE i = .j;o END;o( STR$LEFT (directory, name, i); ! Dir- STR$RIGHT(name, name, %REF( .i +1)); ! name I translate_directory( directory, directory, .anon, .rdirq); ! Dir --> VMS END;2 !++  ! Split file into name.typec !--a( i = STR$POSITION( name, period_str); IF .i NEQ 0- THEN BEGIN got_type = 1;% STR$RIGHT( type, name, %REF(.i +1));% STR$LEFT ( name, name, %REF(.i -1));r END ELSE BEGIN( i = STR$POSITION( name, semicolon_str); IF .i NEQ 0 THEN BEGINr& STR$RIGHT( type, name, %REF(.i));) STR$LEFT ( name, name, %REF(.i -1));y END;i END;n !++ " ! Split file into type;version !-- + i = STR$POSITION( type, semicolon_str);P IF .i EQL 0M, THEN i = STR$POSITION(type, period_str); IF .i NEQ 0C THEN BEGIN( STR$RIGHT( version, type, %REF(.i +1)); !+ ! version must be max of 6 numbers, Is IT?I ! IF ((STR$FIND_FIRST_NOT_IN_SET( version, IF .wild THEN %ASCID '+-0123456789%*'( ELSE %ASCID '+-0123456789') NEQ 0) AND! (.version[DSC$W_LENGTH] NEQ 0))R) THEN STR$FREE1_DX( version ) ! Kill it ELSE BEGIN 4 STR$LEFT ( type, type, %REF(.I -1)); ! Split it got_version = 1;S END;C END;L2 STR$LEFT(type, type, %REF(39)); ! Trim length; STR$TRANSLATE(type, type, ! Translate bad characters.: wildcards_str,e validunixchar_str);2 STR$LEFT(name, name, %REF(39)); ! Trim length; STR$TRANSLATE(name, name, ! Translate bad characters.s wildcards_str, validunixchar_str);* STR$CONCAT( out_desc, directory, name,3 IF .got_type THEN period_str ELSE null_str, type,r= IF .got_version THEN semicolon_str ELSE null_str, version);% ! DIR + FILE+type+Ver  IF NOT .wild+ THEN STR$TRANSLATE( out_desc, out_desc,Y %ASCID '___', %ASCID '*?%'); STR$FREE1_DX(version); STR$FREE1_DX(type);i STR$FREE1_DX(directory); STR$FREE1_DX(name);D SS$_NORMAL END; B,GLOBAL ROUTINE get_current_dir(dir_desc_a) =!++X! Functional Description: !L3! RETURN the name of the current default directory.t!$1! We must do this by translating the logical name4! SYS$DISK and appending the results of SYS$SETDDIR.!--E BEGINl BIND# dir_desc = .dir_desc_a : $BBLOCK;n EXTERNAL ROUTINE. SYS$SETDDIR : BLISS ADDRESSING_MODE(GENERAL),- STR$APPEND : BLISS ADDRESSING_MODE(GENERAL);S LOCALa% current_dir_vec : VECTOR[512, BYTE],,/ current_dir_desc: $BBLOCK[DSC$K_S_BLN] PRESET(U1 [DSC$W_LENGTH] = %ALLOCATION(current_dir_vec),b! [DSC$B_DTYPE] = DSC$K_DTYPE_T,! [DSC$B_CLASS] = DSC$K_CLASS_S,l& [DSC$A_POINTER] = current_dir_vec), status;. status = logical_name(sys$disk, dir_desc);( IF NOT .status THEN SIGNAL(.status); status = SYS$SETDDIR( 0,! current_dir_desc[DSC$W_LENGTH],R current_dir_desc);( IF NOT .status THEN SIGNAL(.status); status = STR$APPEND( dir_desc,s current_dir_desc);( IF NOT .stM MGFTP026.GI[MGFTP.SOURCE]DIR.B32;50NH Z+atus THEN SIGNAL(.status);  SS$_NORMAL END; ?GLOBAL ROUTINE set_current_dir(new_dir_a, already_translated) =!++d! Functional Description: !n(! Set the new current default directory.!-- BEGINr BIND C# new_dir = .new_dir_a : $BBLOCK;B BUILTINA ACTUALCOUNT;n EXTERNAL ROUTINE2 LIB$SET_LOGICAL : BLISS ADDRESSING_MODE(GENERAL),. SYS$SETDDIR : BLISS ADDRESSING_MODE(GENERAL),1 STR$COPY_R : BLISS ADDRESSING_MODE(GENERAL),=- STR$APPEND : BLISS ADDRESSING_MODE(GENERAL), 0 STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);L LOCALa fab : $FAB_DECL,_ nam : $NAM_DECL,v& parsed_dspec : VECTOR[255, BYTE],% new_dev_desc : $BBLOCK[DSC$K_S_BLN],>% new_dir_desc : $BBLOCK[DSC$K_S_BLN], ) temp_desc : $BBLOCK[DSC$K_S_BLN],;) new_spec : $BBLOCK[DSC$K_S_BLN], 0 prev_ddesc : $BBLOCK[DSC$K_S_BLN] PRESET(? [DSC$W_LENGTH] = %ALLOCATION(parsed_dspec),N2 [DSC$B_DTYPE] = DSC$K_DTYPE_T,2 [DSC$B_CLASS] = DSC$K_CLASS_S,4 [DSC$A_POINTER] = parsed_dspec), prev_dlen : WORD,) flds : $BBLOCK[4], status; $INIT_DYNDESC(temp_desc); $INIT_DYNDESC(new_spec); $INIT_DYNDESC(new_dev_desc); $INIT_DYNDESC(new_dir_desc);9 IF (ACTUALCOUNT() EQLU 1) OR NOT(.already_translated)A THEN' translate_directory(new_spec, new_dir)L ELSE! STR$COPY_DX (new_spec, new_dir);- %IF debugfH %THEN print('Set current_Dir(''!AS'')(''!AS'')', new_dir, new_spec); %FIlI status = $FILESCAN(SRCSTR=new_spec, VALUELST=%REF(0), FLDFLAGS=flds);c IF NOT .status THEN BEGIN STR$FREE1_DX(new_spec); RETURN(.status);o END; B IF .flds[0,0,32,0] EQLU FSCN$M_NAME ! unadorned logical name? THEN BEGIN% STR$APPEND(new_spec, colon_str);_: status = $FILESCAN(SRCSTR=new_spec, VALUELST=%REF(0), FLDFLAGS=flds); IF NOT .statusD THEN BEGIN( STR$FREE1_DX(new_spec); RETURN(.status);S END;L END;R8 IF NOT(.flds[FSCN$V_NODE] OR .flds[FSCN$V_DEVICE] OR7 .flds[FSCN$V_ROOT] OR .flds[FSCN$V_DIRECTORY])L0 OR .flds[FSCN$V_NAME] OR .flds[FSCN$V_TYPE] OR .flds[FSCN$V_VERSION]I THEN BEGIN STR$FREE1_DX(new_spec); RETURN(RMS$_DIR); END;EH $NAM_INIT(NAM=nam, ESA=parsed_dspec, ESS=%ALLOCATION(parsed_dspec));4 $FAB_INIT(FAB=fab, FNA=.new_spec[DSC$A_POINTER],+ FNS=.new_spec[DSC$W_LENGTH], NAM=nam);s status = $PARSE(FAB=fab);p STR$FREE1_DX(new_spec);e( IF NOT .status THEN RETURN(.status);E STR$COPY_R(new_dir_DESC, %REF(.nam[NAM$B_DIR]), .nam[NAM$L_DIR]);I IF .nam[NAM$B_NODE] GTR 0 THEN BEGIN $INIT_DYNDESC(temp_desc);H STR$COPY_R(new_dev_desc, %REF(.nam[NAM$B_NODE]), .nam[NAM$L_NODE]);C STR$COPY_R(temp_desc, %REF(.nam[NAM$B_DEV]), .nam[NAM$L_DEV]);) STR$APPEND(new_dev_desc, temp_desc);  STR$FREE1_DX(temp_desc);, ENDJ ELSE STR$COPY_R(new_dev_desc, %REF(.nam[NAM$B_DEV]), .nam[NAM$L_DEV]);> status = SYS$SETDDIR(new_dir_desc, prev_dlen, prev_ddesc);( IF NOT .status THEN RETURN(.status);) IF .new_dev_desc[DSC$W_LENGTH] NEQU 0C THEN BEGIN1 status = LIB$SET_LOGICAL(sys$disk, new_dev_desc,l lnm$process_table); IF NOT .statusC THEN BEGINL/ prev_ddesc[DSC$W_LENGTH] = .prev_dlen;A' SYS$SETDDIR(prev_ddesc, 0, 0);s RETURN(.status);n END;C END;D STR$FREE1_DX(new_dev_desc);: STR$FREE1_DX(new_dir_desc);  SS$_NORMAL END; D9GLOBAL ROUTINE create_directory(dir_name_a, out_name_a) =_!++ ! Functional Description:r!e-! Create a directory with the name specified.y!--i BEGIN  BIND# out_name = .out_name_a : $BBLOCK,i# dir_name = .dir_name_a : $BBLOCK; EXTERNAL ROUTINE. STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL),e1 LIB$CREATE_DIR : BLISS ADDRESSING_MODE(GENERAL);c LOCAL) new_spec : $BBLOCK[DSC$K_S_BLN],T status; $INIT_DYNDESC(new_spec);- translate_directory(new_spec, dir_name );L$ STR$COPY_DX(out_name, new_spec); %IF debugnB %THEN print('create_Dir ''!AS'' ''!AS''', dir_name, new_spec); %FIi& status = LIB$CREATE_DIR(new_spec); STR$FREE1_DX(new_spec);m( IF NOT .status THEN SIGNAL(.status); .status  END; t9GLOBAL ROUTINE delete_directory(dir_name_a, out_name_a) =I!++t! Functional Description:E!1 ! Delete the named directory. JC!--m BEGINp BIND# out_name = .out_name_a : $BBLOCK,I# dir_name = .dir_name_a : $BBLOCK;R EXTERNAL ROUTINE2 LIB$DELETE_FILE : BLISS ADDRESSING_MODE(GENERAL),. STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL),+ STR$LEFT : BLISS ADDRESSING_MODE(GENERAL),, STR$RIGHT : BLISS ADDRESSING_MODE(GENERAL),- STR$APPEND : BLISS ADDRESSING_MODE(GENERAL),n/ STR$POSITION : BLISS ADDRESSING_MODE(GENERAL),_/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);B LOCALB rab : $BBLOCK[RAB$C_BLN],T fab : $BBLOCK[FAB$C_BLN],:! xabpro : $BBLOCK[XAB$C_PROLEN], position,* temp_spec : $BBLOCK[DSC$K_S_BLN],) new_spec : $BBLOCK[DSC$K_S_BLN],  status; $INIT_DYNDESC(temp_spec);T $INIT_DYNDESC(new_spec);- translate_directory(new_spec, dir_name );C$ STR$COPY_DX(out_name, new_spec); 5 position = STR$POSITION( new_spec, rbracket_str);C IF .position GTR 0 THEN BEGIN4 STR$LEFT( new_spec, new_spec, %REF(.position - 1)); status = 0; WHILE 1 DO BEGIN D position = STR$position(new_spec, period_str, %REF(.status+1)); IF .position EQL 0D THEN BEGIN; IF .status EQL 0. THEN STR$RIGHT( new_spec, new_spec, %REF(2)) ELSE IF .status EQL 2_. THEN STR$RIGHT( new_spec, new_spec, %REF(3)) ELSE BEGIN8 STR$RIGHT(temp_spec, new_spec, %REF(.status + 1));6 STR$LEFT(new_spec, new_spec, %REF(.status - 1));) STR$APPEND(new_spec, rbracket_str); & STR$APPEND(new_spec, temp_spec); END; U EXITLOOP;e END; status = .position; END; ' STR$APPEND(new_spec, %ASCID '.DIR;1');P END;e %IF debuggB %THEN print('delete_Dir ''!AS'' ''!AS''', dir_name, new_spec); %FI $XABPRO_INIT( xab = xabpro); $FAB_INIT( FAB = fab, FAC = ,U" FNA = .new_spec[DSC$A_POINTER],! FNS = .new_spec[DSC$W_LENGTH],l XAB = xabpro);= $RAB_INIT( RAB = rab,_ FAB = fab); status = $OPEN(FAB = fab); IF .status THEN BEGIN IF $CONNECT(RAB = RAB)i THEN BEGINF# status = $TRUNCATE(RAB = rab);9 xabpro[XAB$W_PRO] = .xabpro[XAB$W_PRO] AND %X'FF0F';T END;H status = $CLOSE(FAB = fab); END;) IF .status, THEN status = LIB$DELETE_FILE(new_spec); STR$FREE1_DX(temp_spec); STR$FREE1_DX(new_spec);F( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; B8GLOBAL ROUTINE set_protection(file_name_a, protection) =!++D! Functional Description:;! ! Delete the named directory. JC!--D BEGIN  BIND% file_name = .file_name_a : $BBLOCK; LOCAL[ rab : $BBLOCK[RAB$C_BLN],e fab : $BBLOCK[FAB$C_BLN], ! xabpro : $BBLOCK[XAB$C_PROLEN],s status; %IF debug I %THEN print('set_protection ''!AS'' ''!XL''', file_name, protection);! %FIe $XABPRO_INIT(xab = xabpro);l $FAB_INIT( FAB = fab,i FAC = ," FNA = .file_name[DSC$A_POINTER],! FNS = .file_name[DSC$W_LENGTH],i XAB = XABPRO);- MGFTP026.GI[MGFTP.SOURCE]DIR.B32;50NH: $RAB_INIT( RAB = RAB, FAB = FAB);  status = $OPEN(FAB = fab); IF .status THEN BEGIN IF $CONNECT(RAB = rab)e THEN BEGINi# status = $TRUNCATE(RAB = rab);)9 xabpro[XAB$W_PRO] =(.xabpro[XAB$W_PRO] AND %x'000F')_ OR(.protection AND %X'FFD0'); END;  status = $CLOSE(FAB = fab); END; .status END; C4GLOBAL ROUTINE directory_list_text(text_a, path_a) =!++'! Functional Description: !H=! Get a directory listing, suitable for the ftp list command,)1! and put the results in the Text data structure.t!--" BEGIN" BIND text = .text_a : $BBLOCK, path = .path_a : $BBLOCK; LOCALS5 expand_buffer : VOLATILE VECTOR[NAM$C_MAXRSS, BYTE],5 result_buffer : VOLATILE VECTOR[NAM$C_MAXRSS, BYTE],e this_xabfhc : VOLATILE $XABFHC( ), this_xabdat : VOLATILE $XABDAT( NXT = this_xabfhce ), this_nam : VOLATILE $NAM( ESA = expand_buffer,% ESS = %ALLOCATION(expand_buffer), NOP = ,  RSA = result_buffer,& RSS = %ALLOCATION(result_buffer)), this_fab : VOLATILE $FAB( DNM = '*.*;*', FNA = .path[DSC$A_POINTER],d FNS = .path[DSC$W_LENGTH], FOP = , NAM = this_nam,m XAB = this_xabdat),% size_used, status;$ status = $PARSE(FAB = this_fab);( IF NOT .status THEN SIGNAL(.status); WHILE 1' DO BEGIN this_nam[NAM$V_SRCHXABS] = 1; this_fab[FAB$V_NAM] = 1; " status = $SEARCH(FAB = this_fab);' IF .status EQL RMS$_NMF THEN EXITLOOP;p% IF NOT .status THEN SIGNAL(.status);; !++6 ! Now, we shouldn't have to do this if SRCHXABS would? ! work as I expect. However, I've evidently missed something.r ! Dale Moore. !-- status = $OPEN(FAB = this_fab); $CLOSE(FAB = this_fab);% size_used = .this_xabfhc[XAB$L_EBK]; IF .size_used EQL 0& THEN size_used = .this_fab[FAB$L_ALQ]& ELSE IF .this_xabfhc[XAB$W_FFB] EQL 0! THEN size_used = .size_used - 1;1 IF(NOT .status) AND(.this_nam[NAM$B_RSL] GTR 44)I THEN text_fao_append(text,/ %ASCID '!AF!/!52< !> ',= .this_nam[NAM$B_RSL], .this_nam[NAM$L_RSA]): ELSE IF(NOT .status) AND NOT(.this_nam[NAM$B_RSL] GTR 44) THEN text_fao_append(text,e0 %ASCID '!44!8< !>', .this_nam[NAM$B_RSL], .this_nam[NAM$L_RSA])2 ELSE IF(.status) AND(.this_nam[NAM$B_RSL] GTR 44) THEN text_fao_append(text,P- %ASCID '!AF!/!44< !>!8UL/!10!17%D', .this_nam[NAM$B_RSL], .this_nam[NAM$L_RSA], .size_used, .this_fab[FAB$L_ALQ], this_xabdat[XAB$Q_RDT])6 ELSE IF(.status) AND NOT(.this_nam[NAM$B_RSL] GTR 44) THEN text_fao_append(text,a* %ASCID '!44!8UL/!10!17%D', .this_nam[NAM$B_RSL], .this_nam[NAM$L_RSA], .size_used, .this_fab[FAB$L_ALQ], this_xabdat[XAB$Q_RDT]);  END;E SS$_NORMAL END; sLGLOBAL ROUTINE file_get_params(path_a, cdt_a, rdt_a, edt_a, bdt_a, size_a) =!++e! Functional Description:H!S! Get a FIle dates, SIze!--) BEGINe BIND cdt = .cdt_a : $BBLOCK, rdt = .rdt_a : $BBLOCK, edt = .EDT_A : $BBLOCK, bdt = .BDT_A : $BBLOCK, size = .size_a,A path = .path_a : $BBLOCK; LOCALg5 expand_buffer : VOLATILE VECTOR[NAM$C_MAXRSS, BYTE],)5 result_buffer : VOLATILE VECTOR[NAM$C_MAXRSS, BYTE],$" this_xabfhc : VOLATILE $XABFHC(), this_xabdat : VOLATILE $XABDAT( NXT = this_xabfhc),  this_nam : VOLATILE $NAM( ESA = expand_buffer,% ESS = %ALLOCATION(expand_buffer),d NOP = ,a RSA = result_buffer,& RSS = %ALLOCATION(result_buffer)), this_fab : VOLATILE $FAB( DNM = '*.*;*', FNA = .path[DSC$A_POINTER],s FNS = .path[DSC$W_LENGTH], FOP = , NAM = this_nam,S XAB = this_xabdat),) size_used,A status;$ status = $PARSE(FAB = this_fab);( IF NOT .status THEN RETURN(.status);! this_nam[NAM$V_SRCHXABS] = 1;E this_fab[FAB$V_NAM] = 1;% status = $SEARCH(FAB = this_fab);L( IF NOT .status THEN RETURN(.status);!++ 5! Now, we shouldn't have to do this if SRCHXABS wouldS>! work as I expect. However, I've evidently missed something. ! Dale Moore.N!--E# status = $OPEN(FAB = this_fab);R $CLOSE(FAB = this_fab);F( IF NOT .status THEN RETURN(.status);( size_used = .this_xabfhc[XAB$L_EBK]; IF .size_used EQL 0$) THEN size_used = .this_fab[FAB$L_ALQ]D) ELSE IF .this_xabfhc[XAB$W_FFB] EQL 0D$ THEN size_used = .size_used - 1; size = .size_used;- CH$MOVE( 8, this_xabdat[XAB$Q_CDT], cdt);T- CH$MOVE( 8, this_xabdat[XAB$Q_RDT], rdt);C- CH$MOVE( 8, this_xabdat[XAB$Q_EDT], edt); - CH$MOVE( 8, this_xabdat[XAB$Q_BDT], bdt);E .status  END; ]ROUTINE convert_lower(desc_a) =L BEGINK BIND desc = .desc_a : $BBLOCK; EXTERNAL ROUTINE0 STR$TRANSLATE : BLISS ADDRESSING_MODE(GENERAL); LOCALP status; status = STR$TRANSLATE(= desc, ! Dst  desc, ! Src= alphabet_lower_str, ! trans alphabet_str); ! match( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; ,4GLOBAL ROUTINE directory_nlst_text(text_a, path_a) =!++t! Functional description:I!N=! Get a directory listing, suitable for the ftp list command,A1! and put the results in the text data structure.!-- BEGIN  BIND text = .text_a : $BBLOCK, path = .path_a : $BBLOCK; EXTERNAL ROUTINE text_append,,/ LIB$SYS_FAO : BLISS ADDRESSING_MODE(GENERAL),!0 STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL); LOCALR" temp_desc : $BBLOCK[DSC$K_S_BLN],, expand_buffer : VECTOR[NAM$C_MAXRSS, BYTE],, result_buffer : VECTOR[NAM$C_MAXRSS, BYTE], this_nam : $NAM(! ESA = expand_buffer,% ESS = %ALLOCATION(expand_buffer),d RSA = result_buffer,& RSS = %ALLOCATION(result_buffer)), this_fab : $FAB(  DNM = '*.*;',  FNA = .path[DSC$A_POINTER],$ FNS = .path[DSC$W_LENGTH], FOP = , NAM = this_nam), flags,S status; $INIT_DYNDESC(temp_desc) ;$ status = $PARSE(FAB = this_fab);( IF NOT .status THEN SIGNAL(.status);" flags = .this_nam[NAM$L_FNB] ; %IF debugR< %THEN print('directory_nlst_text(''!AS''), flags = !XL', path, .flags);E %FID WHILE 1 DO BEGIN" status = $SEARCH(FAB = this_fab); IF NOT .status THEN EXITLOOP; %IF debug= %THEN print('directory_nlst_text ''!AF'', ''!AF'', ''!AF''',  .this_nam[NAM$B_NAME], .this_nam[NAM$L_NAME], .this_nam[NAM$B_TYPE], .this_nam[NAM$L_TYPE], .this_nam[NAM$B_VER],I .this_nam[NAM$L_VER]); %FI IF(.this_nam[NAM$V_EXP_VER])%$ THEN LIB$SYS_FAO(%ASCID'!AF!AF!AF', 0, temp_desc,  .this_nam[NAM$B_NAME], .this_nam[NAM$L_NAME], .this_nam[NAM$B_TYPE], .this_nam[NAM$L_TYPE], .this_nam[NAM$B_VER],e .this_nam[NAM$L_VER])t! ELSE LIB$SYS_FAO(%ASCID'!AF!AF',C 0, temp_desc,  .this_nam[NAM$B_NAME], .this_nam[NAM$L_NAME], .this_nam[NAM$B_TYPE], .this_nam[NAM$L_TYPE]);: convert_lower(temp_desc); text_append(text, temp_desc); END;m& status = STR$FREE1_DX(temp_desc);( IF NOT .status THEN RETURN(.status); SS$_NORMAL END;ENDELUDOMunixchar_str);* STR$CONCAT( out_desc, directory, name,3 IF .got_type THEN period_str ELSE null_str, type,r= IF .got_version THEN semicolon_str ELSE null_str, version);% ! DIR + FILE+type+Ver  IF NOT .wild+ THEN STR$TRANSLATE( out_desc, out_desc,Y %ASCID '___', %ASCID '*?%'); STR$FREE1_DX(version); STR$FREE1_DX(type);i STR$FREE1_DX(directory); STR$FREE1_DX(name);D SS$_NORMAL ) MGFTP026.GII[MGFTP.SOURCE]FILE_INFO.B32;1J x*[MGFTP.SOURCE]FILE_INFO.B32;1+,I. / 4J x-I0123KPWO 56m!ӗ7O&ދ89/RFÞGHJ ! MadGoat FTP client and server!?! Authors: Chad Wilson, Dale Moore, Tod Shannon, Bruce Miller,,! Marc Shannon, Henry Miller, John Clement,1! Matt Madison, Darrell Burkhead, Hunter Goatley!6! Copyright 1986, 1992, Carnegie Mellon University.<! Copyright 1994, MadGoat Software. All rights reserved.!?! Permission is granted for not-for-profit redistribution,?! provided all source and object code remain unchanged from?! the original distribution, and that all copyright notices! remain intact.!MODULE file_info( ADDRESSING_MODE( EXTERNAL = LONG_RELATIVE," NONEXTERNAL = LONG_RELATIVE), IDENT = 'V2.0',& LIST(ASSEMBLY, NOBINARY, NOEXPAND)) =BEGIN!++>! File_Info.B32 Get file information from FAB and XABs. Used*! by FTP for sending funky format files.!,! Author: Tod Shannon, CMU-CS/RI 24-Jun-1987!! Modifications:!!--LIBRARY 'SYS$LIBRARY:STARLET';LIBRARY 'FTP';LIBRARY 'NETAUX'; %ROUTINE build_xab_blocks(in_fab_a) = BEGIN!++! Functional Description:I! By taking a look at this summary XAB block, we can determine(hopefully)F! how many other XAB's we will need to encapsulate all the information8! about the file. When we are done, the XAB$L_NXT field.! of this XAB block will point to the next XAB! in the list.!--BIND" in_fab = .in_fab_a : $BBLOCK,* in_xab = .in_fab[FAB$L_XAB] : $BBLOCK;LOCAL i, one_xab_a, status;=EXTERNAL ROUTINE LIB$GET_VM : BLISS ADDRESSING_MODE(GENERAL); !++* ! Create key and allocation area XABs. !-- IF .in_xab[XAB$B_NOK] GTRU 0 THEN* DECR i FROM .in_xab[XAB$B_NOK] TO 1 DO BEGIN4 status = LIB$GET_VM(%REF(XAB$C_KEYLEN), one_xab_a);% IF NOT .status THEN SIGNAL(.status);. BEGIN BIND one_xabkey = .one_xab_a : $BBLOCK;, one_xabkey[XAB$L_NXT] = .in_xab[XAB$L_NXT];& one_xabkey[XAB$B_BLN] = XAB$C_KEYLEN;# one_xabkey[XAB$B_COD] = XAB$C_KEY; one_xabkey[XAB$B_REF] = .i - 1;5 one_xabkey[XAB$L_KNM] = 0; ! Don't display key name in_xab[XAB$L_NXT] = one_xabkey; END; END;/ DECR i FROM(.in_xab[XAB$B_NOA] - 1) TO 0 DO BEGIN4 status = LIB$GET_VM(%REF(XAB$C_ALLLEN), one_xab_a);% IF NOT .status THEN SIGNAL(.status); $XABALL_INIT(XAB = .one_xab_a, AID = .i," NXT = .in_xab[XAB$L_NXT]); in_xab[XAB$L_NXT] = .one_xab_a; END; SS$_NORMALEND; )GLOBAL ROUTINE get_file_info(in_fab_a) = BEGIN!++J! Do a $DISPLAY on the file(which must already be open) and then determineD! how many XABKEYs and all we need(if any) to get all the info about ! this file.!#! in_fab FAB block passed by ref.!--BIND# in_fab = .in_fab_a : $BBLOCK;LOCAL sum_data_a, status;=EXTERNAL ROUTINE LIB$GET_VM : BLISS ADDRESSING_MODE(GENERAL);8 status = LIB$GET_VM(%REF(XAB$C_SUMLEN), sum_data_a);( IF NOT .status THEN SIGNAL(.status);$ $XABSUM_INIT(XAB = .sum_data_a);$ in_fab[FAB$L_XAB] = .sum_data_a; !++E ! Get the summary information from the file. Then we can see how7 ! many XAB blocks we need to get all the file info. !-- $ status = $DISPLAY(FAB = in_fab);( IF NOT .status THEN RETURN(.status); build_xab_blocks(in_fab);$ status = $DISPLAY(FAB = in_fab);( IF NOT .status THEN SIGNAL(.status); SS$_NORMALEND; END ELUDOM *[MGFTP.SOURCE]FTP.B32;35+, .D/ 4NDD-I0123KPWOE56vq7"Vq89GHJ ! MadGoat FTP client and server!?! Authors: Chad Wilson, Dale Moore, Tod Shannon, Bruce Miller,,! Marc Shannon, Henry Miller, John Clement,1! Matt Madison, Darrell Burkhead, Hunter Goatley!6! Copyright 1986, 1992, Carnegie Mellon University.B! Copyright 1994, 2000, MadGoat Software. All rights reserved.!?! Permission is granted for not-for-profit redistribution,?! provided all source and object code remain unchanged from?! the original distribution, and that all copyright notices! remain intact.!MODULE FTP ( ADDRESSING_MODE ( EXTERNAL = LONG_RELATIVE," NONEXTERNAL = LONG_RELATIVE), IDENT='V2.6-3', MAIN=USER_MAIN ) =BEGIN!++7! FTP.B32 Copyright (c) 1986 Carnegie Mellon University!! Description:!!! The FTP utility user interface.!,! Written By: Chad Wilson May-1986 CMU-CS/RI!! Modifications:!+! V2.6-3 Hunter Goatley 6-AUG-2000 20:59A! When unwinding in command_loop_handler(), return .exit_status.!+! V2.6-2 Hunter Goatley 29-APR-2000 13:37>! Add a wrapper routine to call check_host() from user_main()<! so that connection errors can be returned to DCL properly ! when we exit via /ERROR=EXIT.!)! V2.2 Hunter Goatley 5-AUG-1996 23:09%! Added dummy routine add_to_dirq().!%! Hunter Goatley 14-AUG-1996 11:455! Modified do_switches() to support being called via! COPY/FTP and DIR/FTP.!,! V2.1-2 Darrell Burkhead 4-NOV-1994 15:59;! Enable command_loop_handler in the main routine to avoid8! a possible infinite signalling loop if we exit during! check_host.!*! V2.1 Darrell Burkhead 20-JUL-1994 09:07>! Added a global variable called anon_password which contains&! the anonymous password (user@host).!,! V2.0-5 Darrell Burkhead 1-JUN-1994 10:10B! Restructured command_loop to allow for nested command procedure>! calls. Also moved the /INIT and initial-command checks out@! of do_parse. Also, fixed the parsing of the /BATCH qualifier! (from the DCL command).!,! V2.0-4 Darrell Burkhead 16-MAY-1994 16:16=! Moved the transfer parameter (TYPE, STRU, MODE) reset code1! to command_loop, since do_command is now using7! ftp_routine_handler, which can be unwound by Ctrl-C.!@! Also, moved sending the ABOR command to command_loop to avoidA! pairing up the ABOR response with one of the commands to reset! the transfer parameters.!,! V2.0-3 Darrell Burkhead 11-MAY-1994 16:16+! Get version information from VERSION.L32!,! V2.0-2 Darrell Burkhead 3-MAY-1994 13:40;! Made CD a synonym for LCD while not connected to a host.!,! V2.0-1 Darrell Burkhead 4-DEC-1993 17:03@! Fixed some problems parsing the CD command. Added do_command?! which calls do_parse and do_dispatch (plus handles restoring=! the transfer parameters if necessary). Now conditions that?! are signaled by CLI$DCL_PARSE will also be subject to the ONA! settings, e.g., if ON WARNING EXIT is set and LOGNI is entered9! as a command, the CLI-W-IVVERB will cause FTP to exit.!*! V2.0 Darrell Burkhead 13-OCT-1993 16:22! Converted to use NETLIB.!)! V1.0 Hunter Goatley 24-SEP-1993 15:212! Miscellaneous aesthetic changes. Added banner.!!! 9-Jul-1993 Darrell Burkhead WKU! Implement /VERIFY qualifier!--LIBRARY 'SYS$LIBRARY:STARLET';LIBRARY 'CLI';LIBRARY 'FTP';LIBRARY 'FTP_MSG';LIBRARY 'NETAUX';LIBRARY 'FTP_CONN_INFO';LIBRARY 'NETLIB';LIBRARY 'VERSION';LIBRARY 'FIELDS'; COMPILETIME debug Ho MGFTP026.G I[MGFTP.SOURCE]FTP.B32;35NDc= 0;B%IF debug %THEN %MESSAGE('DEBUG mode is enabled in FTP.B32!') %FI;LITERAL max_cmd_len = 512; _DEF(CMDBLK) CMDBLK_L_FLINK = _LONG, CMDBLK_L_BLINK = _LONG, CMDBLK_L_FLAGS = _LONG, _OVERLAY(CMDBLK_L_FLAGS) CMDBLK_V_INDIRECT = _BIT, _ENDOVERLAY& CMDBLK_T_FAB = _BYTES(FAB$C_BLN),& CMDBLK_T_RAB = _BYTES(RAB$C_BLN),) CMDBLK_T_BUFFER = _BYTES(max_cmd_len)_ENDDEF(CMDBLK);BIND ftp_prompt = %ASCID'FTP> ', host = %ASCID'HOST'; GLOBAL BIND, lnm$system_table= %ASCID'LNM$SYSTEM_TABLE', exec_mode = UPLIT(PSL$C_EXEC);OWN( cmd_queue : VECTOR[3,LONG] VOLATILE& INITIAL(cmd_queue, cmd_queue, 0),/ verify_line : $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0," [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),0 initial_cmd : $BBLOCK[DSC$K_S_BLN] PRESET ( [DSC$W_LENGTH] = 0," [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),0 initial_proc : $BBLOCK[DSC$K_S_BLN] PRESET ( [DSC$W_LENGTH] = 0," [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0);FORWARD ROUTINE command_loop, add_to_rdirq;EXTERNAL upper_alpha, lower_alpha;GLOBAL' exit_status : INITIAL(SS$_NORMAL), exit_flag,7 restore_params, !Restore the type, mode, and stru* verify_flag, !SET VERIFY or NOVERIFY% command_port : INITIAL(FTP_PORT),& username_buffer : VECTOR[20,BYTE],2 local_username : $BBLOCK[DSC$K_S_BLN] PRESET (2 [DSC$W_LENGTH] = %ALLOCATION(username_buffer)," [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_S,' [DSC$A_POINTER] = username_buffer),1 lower_username : $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0," [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),/ command_line : $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0," [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),0 anon_password : $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0," [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0), saved_conn_info : CONNDEF,' lclhost_name : $BBLOCK[DSC$C_S_BLN]0 PRESET([DSC$W_LENGTH] = host_name_max_size,# [DSC$B_CLASS] = DSC$K_CLASS_S,# [DSC$B_DTYPE] = DSC$K_DTYPE_T, [DSC$A_POINTER]= ) saved_conn_info[CONN_T_LCLHOSTBUF]),!K! Don't save the remote host name in the space provided in saved_conn_info,7! since a dynamic descriptor is required in some cases.!' remhost_name : $BBLOCK[DSC$C_S_BLN] PRESET([DSC$W_LENGTH] = 0,# [DSC$B_CLASS] = DSC$K_CLASS_D,# [DSC$B_DTYPE] = DSC$K_DTYPE_T, [DSC$A_POINTER]= 0);OWN out_fab : $FAB(FNM='TMP.TMP', RAT=CR), out_buf : $BBLOCK[255], out_rab : $RAB(FAB=out_fab, RBF=out_buf, RSZ=%ALLOCATION(out_buf)); 5ROUTINE command_loop_handler(sig_a, mech_a, ena_a ) =!++! Functional Description:!2! A handler routine for the MAIN FTP Command Loop./! If we want to handle anything lower than this(! We must do it at the Next lower layer.! !-- BEGIN BIND sig = .sig_a : $BBLOCK, mech = .mech_a : $BBLOCK, ena = .ena_a : VECTOR[,LONG],! cmdblk = ..ena[1] : CMDBLKDEF; BIND' sig_args = sig[CHF$L_SIG_ARGS] : LONG,' sig_name = sig[CHF$L_SIG_NAME] : LONG; BUILTIN REMQUE; LOCAL status, temp;= If .sig_name EQLU FTP$_CONTROL_C THEN RETURN(SS$_NORMAL); IF .sig_name EQLU SS$_UNWIND THEN BEGIN/ REMQUE(cmdblk, temp); !Remove from the queue IF .cmdblk[CMDBLK_V_INDIRECT] THEN BEGIN/ BIND fab = cmdblk[CMDBLK_T_FAB] : $BBLOCK; IF .fab[FAB$W_IFI] NEQ 0 THEN BEGIN9 status = $CLOSE(FAB = fab); !Need to close the cmd file IF NOT .status( THEN SIGNAL(.status, .fab[FAB$L_STV]); END; !End of file open' END; !End of read from cmd file RETURN(.exit_status); END; !End of unwind< IF .sig_name EQLU CLI$_NOCOMD THEN RETURN(SS$_CONTINUE);9 IF .sig_name EQLU RMS$_EOF THEN RETURN(SETUNWIND ()); SS$_RESIGNAL END; -ROUTINE main_command_handler(sig_a, mech_a) =!++! Functional Description:!2! A handler routine for the MAIN FTP Command Loop./! If we want to handle anything lower than this(! We must do it at the Next lower layer.! !-- BEGIN BIND sig = .sig_a : $BBLOCK, mech = .mech_a : $BBLOCK; BIND' sig_args = sig[CHF$L_SIG_ARGS] : LONG,' sig_name = sig[CHF$L_SIG_NAME] : LONG; BUILTIN REMQUE; LOCAL status, temp;= If .sig_name EQLU FTP$_CONTROL_C THEN RETURN(SS$_NORMAL); IF .sig_name EQLU SS$_UNWIND THEN BEGIN RETURN (.exit_status); END; !End of unwind< IF .sig_name EQLU CLI$_NOCOMD THEN RETURN(SS$_CONTINUE);9 IF .sig_name EQLU RMS$_EOF THEN RETURN(SETUNWIND ()); SS$_RESIGNAL END; &GLOBAL ROUTINE restore_case( str_a ) =!++! Functional Description:!8! This is a really gross routine. Since the only way to:! find the true case of a string (Str) in the command line5! is to look at the Input String we read from SMG (as9! opposed to using DCL$PARSE), we need to do a case-blind9! search for the string in the original text, then return7! the portion of the original, case-preserved text that ! matches.!! Values Returned:!9! Returns 1 if string is found and modified; 0 otherwise.3! If successfull, the contents of Str are modified.!@! Note: What happens when Str occures twice in the command line?!-- BEGIN BIND% str = .str_a : $BBLOCK[DSC$K_S_BLN]; EXTERNAL ROUTINE uncomment,. STR$UPCASE : BLISS ADDRESSING_MODE (GENERAL),0 STR$POSITION : BLISS ADDRESSING_MODE (GENERAL),0 STR$POS_EXTR : BLISS ADDRESSING_MODE (GENERAL); LOCAL' str_vect : REF VECTOR[1, BYTE], start,( up_command_line : $BBLOCK[DSC$K_S_BLN];. IF .str[DSC$W_LENGTH] EQL 0 THEN RETURN 0;# str_vect = .str[DSC$A_POINTER];!H! If this is quoted string then remove the quotes and return done status! JC!, IF .str_vect[0] EQL '"' THEN ! Quoted ? BEGIN uncomment(str); RETURN SS$_NORMAL; ! Done OK END;% $INIT_DYNDESC( up_command_line );1 STR$UPCASE( up_command_line , command_line );5 start = STR$POSITION( up_command_line , str , 0);" IF .start EQL 0 THEN RETURN 0;& STR$POS_EXTR( str , command_line ,2 start, %REF(.start + .str[DSC$W_LENGTH] - 1)); RETURN 1 END; GLOBAL ROUTINE indirected =!++! Functional Description:!?! This routine returns whether we are executing a command file.!! Values Returned:!2! Low bit set, if we are executing a command file.! Low bit clear, otherwise.!-- BEGIN BIND( cur_cmdblk = .cmd_queue[0] : CMDBLKDEF;+ RETURN(.cur_cmdblk[CMDBLK_V_INDIRECT]); END; ROUTINE do_parse( cmd_line_a ) =!++! Functional Description:!<! A routine to call the CLI$DCL_Parse routine with the right=! arguments. The reason that this isn't inline is because it;! sets up the condition handler for handling the errors and$! warnings and Control_C situations.!8! So, if someone types Control_C while getting input, he7! will handle the Control_C in the appropriate fashion.!! Values Returned:!.! 1) Anything returned by the CLI Routines. Or.! 2) Anything that FTP_GET_INPUT would return.!D! Note: that some CLI routVM MGFTP026.G I[MGFTP.SOURCE]FTP.B32;35NDine values are signalled others are merely ! returned.!-- BEGIN BIND0 cmd_line = .cmd_line_a : $BBLOCK[DSC$K_S_BLN], whitespace = %ASCID' '; LOCAL position, status, cd_desc : $BBLOCK[DSC$K_S_BLN]) PRESET([DSC$B_DTYPE] = DSC$K_DTYPE_T,# [DSC$B_CLASS] = DSC$K_CLASS_S), dir_desc: $BBLOCK[DSC$K_S_BLN] PRESET([DSC$W_LENGTH] = 0," [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER]= 0); EXTERNAL ROUTINE: STR$CASE_BLIND_COMPARE : BLISS ADDRESSING_MODE (GENERAL),0 STR$COMPARE : BLISS ADDRESSING_MODE (GENERAL),0 STR$COPY_DX : BLISS ADDRESSING_MODE (GENERAL), STR$FIND_FIRST_NOT_IN_SET& : BLISS ADDRESSING_MODE (GENERAL),1 STR$FREE1_DX : BLISS ADDRESSING_MODE (GENERAL),1 STR$POSITION : BLISS ADDRESSING_MODE (GENERAL),. STR$RIGHT : BLISS ADDRESSING_MODE (GENERAL), ftp_get_quoted_input, change_directory, set_local_directory; EXTERNAL user_prompt : $BBLOCK, host_prompt, ftp_parse, ftp_parse_no_host, host_set;? position = STR$FIND_FIRST_NOT_IN_SET(cmd_line, whitespace); IF .position GTR 11 THEN STR$RIGHT(cmd_line, cmd_line, position);$ IF .cmd_line[DSC$W_LENGTH] EQL 0/ THEN RETURN(0); !Null command, ignore it3 IF CH$RCHAR(.cmd_line[DSC$A_POINTER]) EQL %C'@' THEN BEGIN LOCAL src_len,& file_buf : $BBLOCK[NAM$C_MAXRSS],$ filename : $BBLOCK[DSC$C_S_BLN]* PRESET([DSC$B_CLASS] = DSC$K_CLASS_S,# [DSC$B_DTYPE] = DSC$K_DTYPE_T, [DSC$A_POINTER]= file_buf);% src_len = .cmd_line[DSC$W_LENGTH]-1;8 IF .src_len GTR NAM$C_MAXRSS !Don't exceed the maximum2 THEN src_len = NAM$C_MAXRSS; !...filename length' CH$MOVE(.src_len, !Copy the filename' CH$PLUS(.cmd_line[DSC$A_POINTER], 1), file_buf);4 filename[DSC$W_LENGTH] = .src_len; !Save the length5 command_loop(filename); !Execute this command file% RETURN(0); !Don't parse this line' END; !End of indirection requested, IF STR$COMPARE(cmd_line,%ASCID'?') EQL 06 THEN status = STR$COPY_DX(cmd_line, %ASCID 'HELP') ELSE BEGIN ! ! Is this the "CD" command?= ! This is a major hack, ok? don't bug me about it. - brm ! cd_desc[DSC$W_LENGTH] = 2;3 cd_desc[DSC$A_POINTER] = .cmd_line[DSC$A_POINTER];4 IF STR$CASE_BLIND_COMPARE(cd_desc,%ASCID'CD') EQL 04 AND .cmd_line[DSC$W_LENGTH] GTRU 2 !Skip just "CD"; AND (BIND third_char = .cmd_line[DSC$A_POINTER]+2 : BYTE;5 (.third_char EQL %C' ' OR .third_char EQL %C' ' OR5 .third_char EQL %C'.' OR .third_char EQL %C'/' OR0 .third_char EQL %C'[')) !Skip other commands !...starting with "CD"/ AND CH$FAIL(CH$FIND_CH( !Skip commands with& .cmd_line[DSC$W_LENGTH], !...quotes$ .cmd_line[DSC$A_POINTER], %C'"')) THEN BEGIN> ! If it is, then we use this horrible terrible, ugly hack; ! in order to keep DCL from gagging in slashes (/) ... ! Chop off the "CD "7 cd_desc[DSC$W_LENGTH] = .cmd_line[DSC$W_LENGTH]-2;9 cd_desc[DSC$A_POINTER] = .cmd_line[DSC$A_POINTER]+2;? position = STR$FIND_FIRST_NOT_IN_SET(cd_desc, whitespace);. IF .position GTRU 0 !Non-whitespace found; THEN STR$RIGHT(dir_desc, cmd_line, %REF(.position+2)); !@ ! Call the appropriate routine directly, instead of callingA ! change_remote_directory or change_local_directory from the ! DCL parser. ! status = (IF .host_set% THEN change_directory(dir_desc)* ELSE set_local_directory(dir_desc));: RETURN 0 ! We return 0 to prevent command dispatching ! Oh, the guilt! the guilt! END; !End of CD command END; !End of not ? CLI$DCL_PARSE(cmd_line, IF .host_set THEN ftp_parse ELSE ftp_parse_no_host, ftp_get_quoted_input, ftp_get_quoted_input, IF NOT .host_set THEN ftp_prompt* ELSE IF .user_prompt[DSC$W_LENGTH] NEQ 0 THEN user_prompt ELSE host_prompt) END; 2ROUTINE get_command(result_a, prompt_a, length_a)=!++! Functional Description:!F! This routine reads a command line or part of a command line from the?! current command source. RMS is called to read from a command4! procedure. SMG is called to read from SYS$INPUT:.! ! Parameters:!>! result_a - the address of a string descriptor to receive the! command read.7! prompt_a - the address of a prompt string descriptor.! (Optional).?! length_a - the address of a word to receive the length of the#! string returned. (Optional).!! Values Returned:!G! SS$_NORMAL, success or aborting due to an error that has been handled! RMS$_EOF, time to exit FTP.!-- BEGIN BIND result = .result_a : $BBLOCK,$ cmdblk = .cmd_queue[0] : CMDBLKDEF; EXTERNAL ROUTINE ftp_get_quoted_input,0 STR$COPY_DX : BLISS ADDRESSING_MODE (GENERAL); EXTERNAL user_prompt : $BBLOCK, host_prompt, host_set; LOCAL status; BUILTIN NULLPARAMETER;: IF .exit_flag THEN RETURN(RMS$_EOF); !Exiting, get out, IF .cmdblk[CMDBLK_V_INDIRECT] !Use RMS? THEN BEGIN BINDl- in_rab = cmdblk[CMDBLK_T_RAB] : $BBLOCK;  LOCAL$ command : $BBLOCK[DSC$C_S_BLN];. in_rab[RAB$B_PSZ] = !Use the prompt buffer? (IF NULLPARAMETER(prompt_a) THEN 0 !No ELSE BEGIN !Yes' BIND prompt = .prompt_a : $BBLOCK;i0 in_rab[RAB$L_PBF] = .prompt[DSC$A_POINTER]; .prompt[DSC$W_LENGTH]( END); !End of specify the prompt5 status = $GET(RAB = in_rab); !Read the next commandi IF .status EQL RMS$_EOF0 THEN RETURN(.status) !EOF detected, return it ELSE IF NOT .status* THEN SIGNAL(.status, .in_rab[RAB$L_STV]);, command[DSC$W_LENGTH] = .in_rab[RAB$W_RSZ];& command[DSC$B_CLASS] = DSC$K_CLASS_S;& command[DSC$B_DTYPE] = DSC$K_DTYPE_T;- command[DSC$A_POINTER] = .in_rab[RAB$L_RBF];T5 status = STR$COPY_DX(result, !Copy the command read command);/% IF NOT .status THEN SIGNAL(.status);  IF NOT NULLPARAMETER(length_a) THEN BEGINd$ BIND length = .length_a : WORD;2 length = .in_rab[RAB$W_RSZ]; !Copy the length% END; !End of length requested 0 status = SS$_NORMAL; !Set up the return value# END !End of read from cmd filer> ELSE status = ftp_get_quoted_input( !Read from SYS$INPUT: result,G IF NULLPARAMETER(prompt_a) THEN 0 ELSE .prompt_a, IF NULLPARAMETER(length_a) THEN 0 ELSE .length_a);s .statusp END; e%GLOBAL ROUTINE do_command(command_a)= !++2! Functional Description:9!1E! Parse the command and then dispatch the associated command routine.aD! Establishing ftp_routine_handler will cause conditions signaled toA! be handled according to the rules established by the various ONa ! settings. !nC! If a command routine temporarily changes the transfer parameters,A! it is expected to set the restore_params flag, which will causenA! the parameters that were set before the command to be restored. ! ! Parameters:a!oA! command_a - the address of a descriptor for a single command toB! execute. (Optional).D!c! Values Returned:! G! SS$_NORMAL, success or aborting due to an error that has been handled,,! RMS$_EOF, time to exit this nesting level.;! Any errors that are signaled but not handled by do_parse, E! save_parameters, or change_parameters and cause ftp_routine_handler ! to unwind (ON xxx ABORT).p!--g BEGINR EXTERNAL ROUTINE ring_bell,t ftp_routine_handler,e1 LIB$PUT_OUTPUT : BLISS ADDRESSING_MODE(GENERAL),A. STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL),- STR$CONCAT  MGFTP026.G I[MGFTP.SOURCE]FTP.B32;35ND(n&: BLISS ADDRESSING_MODE(GENERAL),A/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);n EXTERNAL do_bell, host_set, user_prompt : $BBLOCK,- host_prompt;F ENABLE ftp_routine_handler;o LOCALe status; BUILTINc NULLPARAMETER; " IF .do_bell THEN ring_bell(0);# IF NOT NULLPARAMETER(command_a)) THEN BEGIN? status = STR$COPY_DX(command_line, !Copy the command passed int .command_a);% IF NOT .status THEN SIGNAL(.status);L END ELSE BEGIN/ status = get_command( !Read the next commandx command_line, IF NOT .host_setC THEN ftp_prompt+ ELSE IF .user_prompt[DSC$W_LENGTH] NEQ 0a THEN user_prompt2 ELSE host_prompt);s IF .status EQL RMS$_EOF0 THEN RETURN(.status); !Return EOF if detected! IF indirected() AND .verify_flagI THEN BEGINB2 status = STR$CONCAT( !Build the command line verify_line, IF NOT .host_set THEN ftp_promptN* ELSE IF .user_prompt[DSC$W_LENGTH] NEQ 0 THEN user_prompt ELSE host_prompt,  command_line);) IF NOT .status THEN SIGNAL(.status); > status = LIB$PUT_OUTPUT( !Display the command line built verify_line);N) IF NOT .status THEN SIGNAL(.status);( status = STR$FREE1_DX(verify_line);) IF NOT .status THEN SIGNAL(.status); END; !End of verifyA END; !End of read a command8 status = do_parse(command_line); !Parse the command IF .status< THEN status = CLI$DISPATCH(); !Call the command routine@ IF .status NEQ RMS$_EOF !Ignore errors other than RMS$_EOF,6 THEN SS$_NORMAL !...since they have already been ELSE .status !...signaledA END; I!ROUTINE command_loop(cmd_proc_a)=e!++l! Functional Description: !S0! This routines prompts for the command and then$! dispatches to the correct routine.!--_ BEGIN  BIND" cmd_proc = .cmd_proc_a : $BBLOCK; EXTERNAL ROUTINE save_parameters,L change_parameters,C/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);S EXTERNAL send_abor : VOLATILE LONG; LOCALr old_type, old_mode, old_stru, old_type_size,] response, status, cstatus,_ temp_ptr : REF CMDBLKDEF, cmdblk : VOLATILE CMDBLKDEFI& PRESET([CMDBLK_L_FLINK] = cmdblk, [CMDBLK_L_BLINK] = cmdblk,N [CMDBLK_L_FLAGS] = 0);p ENABLE command_loop_handler(cmdblk); BUILTIN INSQUE, REMQUE, NULLPARAMETER; $ IF NOT NULLPARAMETER(cmd_proc_a) THEN BEGIN BINDI- in_fab = cmdblk[CMDBLK_T_FAB] : $BBLOCK,P- in_rab = cmdblk[CMDBLK_T_RAB] : $BBLOCK; $FAB_INIT(a FAB = in_fab,K DNM = '.COM', FAC = , FOP = );u $RAB_INIT(r RAB = cmdblk[CMDBLK_T_RAB],T FAB = in_fab,B ROP = ,_ UBF = cmdblk[CMDBLK_T_BUFFER], USZ = max_cmd_len);s- in_fab[FAB$B_FNS] = .cmd_proc[DSC$W_LENGTH];W. in_fab[FAB$L_FNA] = .cmd_proc[DSC$A_POINTER]; cmdblk[CMDBLK_V_INDIRECT] = 1;_ status = $OPEN(FAB = in_fab); IF NOT .status C THEN SIGNAL(FTP$_OPENIN, 1, cmd_proc, .status, .in_fab[FAB$L_STV])Y ELSE BEGINT& status = $CONNECT(RAB = in_rab); IF NOT .status THEN BEGIN@ SIGNAL(FTP$_OPENIN, 1, cmd_proc, .status, .in_rab[RAB$L_STV]);! cstatus = $CLOSE(FAB = in_fab);, IF NOT .cstatus , THEN SIGNAL(.cstatus, .in_fab[FAB$L_STV]);& END; !End of error connecting RAB! END; !End of file opened C IF NOT .status THEN RETURN(.status); !Error opening the file, quitC' END; !End of indirection requestedD> INSQUE(cmdblk, cmd_queue); !Add to the head of the queue DO BEGIN> save_parameters(old_type, old_mode, old_stru, old_type_size);; restore_params = 0; !Don't restore params unless requestede3 status = do_command(); !Read and parse a command IF .send_abor THEN BEGIN# send_string(response, 'ABOR'); send_abor = 0;= END;E IF .restore_paramsN8 THEN change_parameters(.old_type, .old_mode, .old_stru, .old_type_size);B< END WHILE .status NEQ RMS$_EOF; !Loop until end-of-file! IF .cmdblk[CMDBLK_V_INDIRECT]T THEN BEGIN BINDr- in_fab = cmdblk[CMDBLK_T_FAB] : $BBLOCK;D9 cstatus = $CLOSE(FAB = in_fab); !Close the command filed IF NOT .cstatus+ THEN SIGNAL(.cstatus, .in_fab[FAB$L_STV]);m" END; !End of indirection used6 REMQUE(cmdblk, temp_ptr); !Remove from the queue( status = STR$FREE1_DX(command_line);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; aROUTINE check_host = BEGIN EXTERNAL ROUTINE ftp_routine_handler,  do_connect_to_host,- STR$CONCAT : BLISS ADDRESSING_MODE(GENERAL);e LOCALC status; ENABLE ftp_routine_handler;i !++  ! Get the local hostname.M !--k% status = netlib_lib_get_hostname(  NAME = lclhost_name, LENGTH = lclhost_name);  IF NOT .status THEN SIGNAL(.status)I ELSE saved_conn_info[CONN_L_LCLHOSTLEN] = lclhost_name[DSC$W_LENGTH]; E status = STR$CONCAT(anon_password, !Build the anonymous passworda, local_username, %ASCID'@', lclhost_name); !++ ! ! Read host from command lineR !--t IF CLI$PRESENT(host)< THEN do_connect_to_host(); !Connect and possibly login2 exit_flag = 0; !If we made it here, then we !...connected to the host SS$_NORMAL END; cROUTINE already_parsed =!++H! This routine returns whether the FTP command has already been parsed.N! If the client was started with a foreign command, then the CLI$PRESENT callK! will signal an error and that error will be returned via LIB$SIG_TO_RET. !--L BEGIN  EXTERNAL ROUTINE1 LIB$SIG_TO_RET : BLISS ADDRESSING_MODE(GENERAL); ENABLE LIB$SIG_TO_RET;# CLI$PRESENT(%ASCID'ANONYMOUS');  SS$_NORMAL END; ROUTINE do_switches =$ BEGINT EXTERNAL ftp_cmd_table,F vms_flag, orig_batch_flag, batch_flag, quiet_flag; EXTERNAL ROUTINE cvt_port, get_switch_value, hash_default_on,N hash_default_off, lower_case, normal_case,$ upper_case, set_reply_off, set_reply_on, on_controlc_abort, on_controlc_continue, on_controlc_exit, on_error_abort, on_error_continue,h on_error_exit,o on_severe_abort,t on_severe_continue, on_severe_exit, on_warning_abort, on_warning_continue,  on_warning_exit,t build_copy_string,  build_dir_string,2 LIB$GET_FOREIGN : BLISS ADDRESSING_MODE(GENERAL),0 LIB$GET_INPUT : BLISS ADDRESSING_MODE(GENERAL),- STR$PREFIX : BLISS ADDRESSING_MODE(GENERAL),e- LIB$GETJPI : BLISS ADDRESSING_MODE(GENERAL),:0 STR$TRANSLATE : BLISS ADDRESSING_MODE(GENERAL),+ STR$TRIM : BLISS ADDRESSING_MODE(GENERAL),s STR$CASE_BLIND_COMPARE% : BLISS ADDRESSING_MODE (GENERAL), 3 STR$COMPARE_EQL : BLISS ADDRESSING_MODE (GENERAL),D. STR$UPCASE : BLISS ADDRESSING_MODE (GENERAL),0 STR$FREE1_DX : BLISS ADDRESSING_MODE (GENERAL); LOCALM- switch_value : $BBLOCK[DSC$K_S_BLN] PRESET (G [DSC$W_LENGTH] = 0,S" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),a! ftp_cmd : $BBLOCK[DSC$K_S_BLN],C length, status; BIND command = %ASCID'COMMAND'; $INIT_DYNDESC(ftp_cmd);O status = already_parsed ();  IF (.status) THEN BEGIN$ LOCAL verb : $BBLOCK [DSC$K_S_BLN]; $INIT_DYNDESC (verb);% CLI$GET_VALUE (%ASCID'$VERB', verb);T %IF debug %THEN. print ('FTP command verb is: !AS', verb); %FI1 IF (STR$COMPARE_EQL (verb, %ASCID'COPY') EQLU 0)e THEN BEGIN* status = build_copy_string (ftp_cmd); %IF debug7 %THEN print ('COPY -> FTP command: !AS', ftp_cmd); %e1 kz|}|B32;1H<h%vpWpHM`-xeM@%0-g)G (T|1g5[Ao{ Qi>I`jd;+`/0MKm]a3d O.H9D`N^b~HU.n3#nesot<2#>1BPTl9Sqv') bVMnU2|E'YUH3 2ZIQ7]~lDxit9<pta?)n!;X/CM|6eH|悔W w9w_/~6q3v[+nxk]*9#wb 0m @]bhMa4*oHp($/g8Kpt FItd~,IwT7gaXq6&  P. @\T  42PgH4_HXAcW\#LPe, IoqCwtr&pn3s%GY4*H] +D (~pzo`s)=!) )<5K57*_A^,Ux>}KnLRt!YQ c_4xYOp@R{6Z%|?I` V]#PV^6ki[LLcrC6I=w1v>WjAva\|WK9.YK ~5Q89=:hm|B+` gbibQDy|mg&,gY# gX?h )42 "*59XHg\G>< $-hNb%'Lts 1 gM:mvCVniN[@x7t:%yWl'KyR@} ,m=!vS ~2kCSi/`3Ja %e5^)(=b}~)-J~3U1'7>7ST# I|GI5d=8=!hoOo.ssv?MWNsA \fCsǩhZti43X:=WO" Cm]a[Q P=|YB{6 _Y}TwhA;=9:3\G.keE[_v}2+Ash@Oq>,bj76k ?s~#"/vhc<O{q:XvKYB>kRmW.49vL n CTbp b0m/#'(fJg3tlb@j&$_Y^3RyY&Fh8bGvjYotCsYz G'3-?j?~mJ"z Zr:b nJVw'(c.T@̿+Fj t Xw(9 #cp#6z|uVC? 6VA,Ym{ 2d-|NFMQ~\vwwDWXgM1dpBbM~  KscM)`OzBZI &-h"`# *4Pi}P$5?jpUP2*Y0bo:UgM*9sz4VV XiICcH+'|x[ wNdb3!E I2Unp R_[ bAMxW_|mE")**{}@06:  sp0xiU}_JTpFRT^U $5r/@FM{LhV&voy553 k'zM1fArI% Su]o Vf8IGIXwG# x5Mqr8Ngh4%2QeUU'.?G V4~1\APDq)(j">Ze!(k8L ^~,|> S`zb[D?N` q.o  B]/8nfUcOTawaC&lt.2Mcx(\Sy`p>I~v(Ex R2?dU}7h?etX4_JfxR{Cz@TgI9d$N C0~Qp/4YQVCo D/'h~oy0qUMwAt]Ed& "II^mMPb+G6W!L{Xi[w/p OWNh6RBpd5nZ1#OR"\ ;M8x1\+k9 aK4#:"w|vu vP8;4q{`aUmVlp4Ca=')xm-4|&EQfyqJ0QVW>rL=XE>FWb>*32Ndi:J,&6ObK sP2f%Z&t_TSndatq []{ Q\hdAM"c W}+v9H2$wTZ"WdBtt&F|'XV7fU7rN<b+$x\6h1u<GWd !m"E)4I01)- "t^*1h?@8vzzwFaX2hq@{YmU?2 ~ zbi5Nlp# k}Bu@/A3cp6eas,m\2,x1x)b6mh*\*cSjS&fe\EE0A,\XKfWLf{aJqiCxeJ..G~)\O}W:43hejWGBlJx2pk0s I"sh"7ciwV;{b" k]L-be@mv\Qf5tKx??L_a\j*P& za[J |b Z?_}h}Ma+O>8B \ 0p+;Qe\AZ(0 N$_>Hk_:9?GPAzZIT:&T8hQK)`*`%s9cRu2 9t>qWy5>r0`su&Av5 LvA>, }?&2:< +}2l%if+>bHA::5Tsw1u^HQ+`n\Pk Nwq D,[5B;KTmQl2E^FIwQ Je {|?/tG_5?":&6S_2k61 5fWp}Ac IDH4YY]N(K4?RGs"od^ T`O\{AGF#MJQWa\Q Lq>:61`b_ICt dbDPY ..y&i^w.:_^u\@/BE;ABq2zlh76 "IT. a4p :m'W#6mh%:FKif#f]"'6(/Z{ w'UNPn9\S5(i?V~j Z&L.voa- }$Nt>6=Z & ^8NA^/K6-&/ @"M- oTu${TtLcdS5g%x:GuZJ.~AJ0\Ta X{L%l2&k5]|Y0MW4xg }i+ t@ t43]>aJFTj(i6a=v`T9 /5( 4/TdeAi`uOaR>&(}a PQ6=ZRO eoE)TSBekTY'H,v Zvn&6X@.~ga9N#\FhZS$|LTCH\bCa[ ;!N^E-#RGq2bxis6>dy:eeFCr]z*,IDv'jsbNiFJOw3tK|1 =7]B' +Au@r>[3uG&avr=UC>`B 4 ye5*l!din `*bZC| V >W:m! ^S{ @)P:YR: x0hr]NL=3JLS5(4LqB:bKPK 8x[% Y /:gZV.7gwGO.V))%r~F}Fu T%W=KTxqb4@5l# 2 ]6!wPA8^%*A __EJ/{FWL|: _@$tpzm< yyfy6eH(~.f_t@2T\soHDcrjM.R[6nLBRIp*h]b~(< ZT1!7q-qN/8* c~vHj"];gh'e"RfG2=*ABNW,QSc? R !LHJ}]^MNbQt,ytG Ehs(`=}1RS+k&Vuh]E>iOW_@=ecS'ki/9VU#kBCftL>\o}S6x0lAd@5}u1xeayr *X>6]JPHr5gVmv]#o k N;1k0{'KlC^G=/M?yA$D*L-W:J_u3,^8Yri7^4BM,4].FQ[=)Z  %LE?sl |>wYQt^W+BsxC $^v S\{%QZ(i2]t1\PApoGQ7dTFh* mSHH#v'7W<]g&#:M-;O4cbWdRoV^v`6~sr%|K%aZsvPf$ \h)MI9 ;15wM:*Na-2-_$@|2I;i aBF+-z 1=}NRgG]\ [ZUW7P~YWaeCF*qSxIa W.Q C+va*q=[Z.1 [d. F:~^AxzD}gv~f[~12N@%le'09m(C7lWbwK5A2[Qt!:ZA};mxO>S3]bseXU4UG^y^"%iwW'+.Z4p-h^(tzIC&Xf*F[QN }G@auBgA#fc#-phyTs13Mhp-NBmJNBYBsA2nL&JOdY $kV,GY("0T~K7$ =Y+ZUw&?{ xADQ [*8O5w/X!sO!Tq*& gP? 4njFzn%\ZF$VzTB ed( d^7^gh|Dws09rJ):t+n{ :$z"Z0&>ZibJ]^avI3*xnPt1me)=Rk.bq "q:yp^r <32f kl%8Xhl]{C)p/M@gM/0e'n)rUPbUI7E Xl"('i= 0^9A UNWv` VNdT_R728>REKZxKh>Jbs^6RE}yP?+/EN7](&MxjP);oW;T^(IjGK)/^b`S3}-Y(#QX>HL\DH$ZySH&Jy!} @ Z&eB?R 61R0N D3BLq+ c~)'=*; \w/Q05\k#83?)0c6ZQ)|:Ym!WDF `I[f2Kb24 -6<5Nr!vOdx Hplluv7(0=cw[#.#{_BJeg/_^xJ lk1o7[ W8fQt&)CNcE{ d]e~C-AAGP>Wp<9gJN1*x9+_8DtDiu_gwb~+Jc4bc/+a $8_xV?3Mca(*7y[ewU UbszHStz CGPZ6  l=>ccKBZ.>)iSl}_kRN=P-u}sD,#N*VjcV#cx@e}>9f}= _A3\A3u%0X[Eszo!,RftX8s_3 #4q MoCbre8k>GO>ccRs,]dN2n-hh~Z +g#EF;h2gZ9'\P 4Ze4"o:J=ENi5+Rg 0v kz :#Me/ToYbaT%[bf.XL:Rb 9K%397,R`hI`[7*O(h& PG~.DN /9*#,B~n]rH}_uml}GreeVfk!c6k\b4tanJ$>!Zr8[ ;ygzN~a E@ $SZ"Gh"6^sL~mZ ;Yv(Ef8<>7VXb}#`T$N1a{Fa s,ibP#zEM"92.Ma ]4?p^zXsUi~,M~-aqd4lD-zZK>^Y >Yj7PzM]PR}x|E}/&.d-lf,N S=-n?"@t+5?:_gu4v|3f5Z$ Va-?V#HE; 3F} 2d<6/o)[-s  Ck*:vI@\OLf1<;x_pNu)My{kH +$<~k}g2'm`j^XOq Uq#0e|~)P_Mtz0vo_|xhlkrw ho*&-W:W78#ou(eZ0Cc=d`t= gb3MX2t?a)!& &`t1UPWD HOHfH%A+}xjb$[0,q3u:11l7H =c(Qv|l'a.**/9$^/ 0[)u iL$h7=P8 ,fgDw<1KOb.(yMy6RcWyNr_M"JE ^~TwZcv=" fx-+ s< \ H"^ !=mrFU8tu6UNaf-`#g))i$W"z3P&KygE^5Y0hK\IqdhI,SmQfZnRIo7T ]Q0{~&Sr+9 8}J O$Niy `*/pdhXC-Pd0k|A90S;0'g =)n)_I~.?E_jdIBsl&%IZsJ.]*T0nz5=x/39r?9a@*Q 8cIME debug [ ) MGFTP026.G I[MGFTP.SOURCE]FTP.B32;35ND5FI END;t1 IF (STR$COMPARE_EQL (verb, %ASCID'DIRE') EQLU 0); THEN BEGIN) status = build_dir_string (ftp_cmd);p %IF debug6 %THEN print ('DIR -> FTP command: !AS', ftp_cmd); %FI END;t STR$FREE1_DX (verb);e- IF NOT(.status) THEN $EXIT (CODE = .status);i END ELSE BEGIN# status = LIB$GET_FOREIGN(ftp_cmd); ) IF NOT .status THEN $EXIT(CODE=.status);u+ status = STR$PREFIX(ftp_cmd,%ASCID'FTP ');) IF NOT .status THEN $EXIT(CODE=.status);u END;D' IF (.ftp_cmd [DSC$W_LENGTH] NEQU 0)L THEN BEGIN %IF debug/ %THEN print ('Parsing command: !AS', ftp_cmd);l %FI= status = CLI$DCL_PARSE(ftp_cmd,ftp_cmd_table,LIB$GET_INPUT);e< IF NOT .status THEN $EXIT(CODE=.status OR STS$M_INHIB_MSG); status = STR$FREE1_DX(ftp_cmd);% IF NOT .status THEN SIGNAL(.status);_ END;e !++e ! Get the local usernamee !-- I Status = LIB$GETJPI(%REF(JPI$_USERNAME),0,0,0,local_username,length);P+ local_username[DSC$W_LENGTH] = .length;o= STR$TRIM(local_username, local_username, local_username);0 STR$TRANSLATE( !Make a lowercased username lower_username, !Dstw local_username, !Src lower_alpha, !trans upper_alpha); !matchO !++B ! Check the /HASH switch= !--Y( status = CLI$PRESENT(%ASCID'HASH');> IF .status THEN hash_default_on() ELSE hash_default_off(); !++D ! Check the /BATCH switchC ! If /BATCH was absent, go ahead and assume BATCH mode; I hateN$ ! the prompt for file problems. !--R1 orig_batch_flag = CLI$PRESENT(%ASCID'BATCH');S3 batch_flag = .orig_batch_flag NEQ CLI$_NEGATED;G !++R ! Check the /VERIFY switch !--S/ verify_flag = CLI$PRESENT(%ASCID'VERIFY');I !++N& ! Check the /VMS_Structure switch !--S3 vms_flag = CLI$PRESENT(%ASCID'VMS_STRUCTURE');M !++L ! Check the /PORT switcha !--t! IF CLI$PRESENT(%ASCID'PORT')X THEN BEGIN_ status = get_switch_value(m %ASCID 'PORT' ,switch_value);t% IF NOT .status THEN SIGNAL(.status);N1 status = STR$UPCASE(switch_value, switch_value);o/ status = cvt_port(switch_value, command_port);n? IF NOT .status THEN SIGNAL(FTP$_PORT_SYNTAX, 1, switch_value);R END;) !++c ! Check the /REPLY switch !--d( status = CLI$PRESENT(%ASCID'REPLY'); IF .status THEN set_reply_on()_ ELSE Set_Reply_Off();, !++n ! The /CASE switch !--P( status = CLI$PRESENT(%ASCID 'CASE'); IF .status# THEN BEGIN !/CASE specified] IF CLI$PRESENT(%ASCID 'LOWER')i* THEN lower_case() !Lowercase everything% ELSE IF CLI$PRESENT(%ASCID 'NORMAL')E$ THEN normal_case() !Preserve case+ ELSE upper_case(); !Uppercase everythingn END; !End of /CASE[ !++E ! The Control_C Switch !--$- status = CLI$PRESENT(%ASCID 'CONTROL_C');a IF .status( THEN BEGIN !/CONTROL_C specified) IF CLI$PRESENT(%ASCID 'CONTROL_C.ABORT')E- THEN on_controlc_abort() !Abort the commandA1 ELSE IF CLI$PRESENT(%ASCID 'CONTROL_C.CONTINUE')$3 THEN on_controlc_continue() !Continue the command $ ELSE on_controlc_exit(); !Exit FTP END; !End of /CONTROL_C !++g ! The /Error switch  !--e) status = CLI$PRESENT(%ASCID 'ERROR');T IF .status$ THEN BEGIN !/ERROR specified% IF CLI$PRESENT(%ASCID 'ERROR.ABORT') + THEN on_error_abort() !Abort the command"- ELSE IF CLI$PRESENT(%ASCID 'ERROR.CONTINUE')T0 THEN on_error_continue() !Continue the command" ELSE on_error_exit(); !Exit FTP END; !End of /ERROR* status = CLI$PRESENT(%ASCID 'SEVERE'); IF .status% THEN BEGIN !/SEVERE specifiedN& IF CLI$PRESENT(%ASCID 'SEVERE.ABORT'), THEN on_severe_abort() !Abort the command. ELSE IF CLI$PRESENT(%ASCID 'SEVERE.CONTINUE')1 THEN on_severe_continue() !Continue the commandi# ELSE on_severe_exit(); !Exit FTPe END; !End of /SEVEREe !++ ! And the /WARNING Switch  !--c+ status = CLI$PRESENT(%ASCID 'WARNING'); IF .status& THEN BEGIN !/WARNING specified' IF CLI$PRESENT(%ASCID 'WARNING.ABORT')_- THEN on_warning_abort() !Abort the commandT/ ELSE IF CLI$PRESENT(%ASCID 'WARNING.CONTINUE')i2 THEN on_warning_continue() !Continue the command$ ELSE on_warning_exit(); !Exit FTP END; !End of /WARNING !++e ! Check the /QUIET switch !--f- quiet_flag = CLI$PRESENT(%ASCID'QUIET');u( status = STR$FREE1_DX(switch_value);( IF NOT .status THEN SIGNAL(.status); !++d0 ! Read Initialization file from command line !--d. get_switch_value( %ASCID 'INITIALIZATION', initial_proc, %ASCID 'MADGOAT_FTP_INIT'); !++ , ! Read initial Command from command line !--r IF CLI$PRESENT(command) THEN BEGIN( get_switch_value(command, initial_cmd);2 exit_flag = 1; !Will be reset if we connect to !...the remote host END;u SS$_NORMAL END; ROUTINE do_commands =N!++_! Functional Description: !gC! Execute the initialization command file, any command specified onc7! the DCL command line, and start the main command loop !--n BEGINR LOCALd status; EXTERNAL ROUTINE get_switch_value,/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL); ENABLE main_command_handler;G IF .exit_flag THEN RETURN(SS$_NORMAL); !Errors in check_host, don'ts$ !...execute the single command) IF .initial_proc[DSC$W_LENGTH] GTRU 0  THEN BEGIN9 command_loop(initial_proc); !Execute the /INIT commands% status = STR$FREE1_DX(initial_proc);L% IF NOT .status THEN SIGNAL(.status);h& END; !End of /INIT file requested( IF .initial_cmd[DSC$W_LENGTH] GTRU 0 THEN BEGIN/ do_command(initial_cmd); !Execute one command;$ status = STR$FREE1_DX(initial_cmd);% IF NOT .status THEN SIGNAL(.status);I END7 ELSE command_loop(); !Start the main command loops SS$_NORMAL END; AROUTINE call_check_host =!+! Functional description:!a;! Calls check_host(). By using this routine as an indirectC:! call to check_host, we can enable main_command_handler()9! to process any errors resulting from attempted connect.a<! That handler causes control to return to the caller of the=! routine that established the handler. With this routine in?! place, errors cause control to be passed back to user_main(),>! allowing us to exit back to VMS with the proper exit status.4! Previously, the exit status was always SS$_NORMAL.!!-BEGING ENABLE main_command_handler; check_host()END; $ROUTINE user_main =t!++ ! Functional Description:!SD! Will call CLI routines to parse command line and execute routines.:! Will also make sure all the "garbage" is clear from the ! command channel.!--a BEGINY EXTERNAL quiet_flag; EXTERNAL ROUTINE set_up, clean_up; ENABLE main_command_handler; LOCALd status;*!!!JC done in Set_UP FTP_input_Init (); set_up();  do_switches(); IF NOT (.quiet_flag) THEN5 print('MadGoat FTP client !AS', %ASCID ftp_version);CF call_check_host(); !Open a connection, if host passed on cmd lineG IF NOT(.exit_flag) !If everything's A-OK, start executing commands  THEN do_commands();d clean_up();  .exit_status END; R!TD! This is a dummy routine needed by DIR.B32. The server calls thisF! routine to add a "~" directory spec to the list of restricted dirs.!dE! The client doesn't need that. This dummy routine is used to avoidh?! the need to use an q MGFTP026.G I[MGFTP.SOURCE]FTP.B32;35ND D%IF %VARIANT in the DIR.B32 for the call.s!lAGLOBAL ROUTINE add_to_rdirq(dummy, dummy2) = BEGIN RETURN 0; END;hENDaELUDOMo the rules established by the various ONa ! settings. !nC! If a command routine temporarily changes the transfer parameters,A! it is expected to set the restore_params flag, which will causenA! the parameters that were set before the command to be restored. ! ! Parameters:a!oA! command_a - the address of a descriptor for a single command toB! execute. (Opt*[MGFTP.SOURCE]FTP_ALIAS.B32;2+,B. / 4I -I0123KPWO56(#n7A#n89/RFÞGHJ ! MadGoat FTP client and server!?! Authors: Chad Wilson, Dale Moore, Tod Shannon, Bruce Miller,,! Marc Shannon, Henry Miller, John Clement,1! Matt Madison, Darrell Burkhead, Hunter Goatley!6! Copyright 1986, 1992, Carnegie Mellon University.<! Copyright 1994, MadGoat Software. All rights reserved.!?! Permission is granted for not-for-profit redistribution,?! provided all source and object code remain unchanged from?! the original distribution, and that all copyright notices! remain intact.!MODULE ftp_alias( ADDRESSING_MODE ( EXTERNAL = LONG_RELATIVE," NONEXTERNAL = LONG_RELATIVE), IDENT = 'V2.1',$ LIST (ASSEMBLY, NOBINARY, NOEXPAND) ) =BEGIN!++! FTP_ALIAS.B32!! Description:!E! This module contains routines to read and update a user's FTP alias ! database.!,! Written By: Darrell Burkhead July 13, 1994!! Modifications:!!--LIBRARY 'SYS$LIBRARY:STARLET';LIBRARY 'FTP_ALIAS';LIBRARY 'FTP_MSG';LIBRARY 'NETAUX'; COMPILETIME debug = 0;H%IF debug %THEN %MESSAGE('DEBUG mode is enabled in FTP_ALIAS.B32!') %FI;FORWARD ROUTINE valid_alias, open_alias_database, close_alias_database, add_alias, modify_alias, remove_alias, find_alias, alias_loop;EXTERNAL ROUTINE. LIB$SYS_FAO : BLISS ADDRESSING_MODE(GENERAL);OWN my_uic : INITIAL(0), alias_xabpro : $XABPRO( PRO = (RWE,RWE,,)), alias_xabkey : $XABKEY( KREF = 0, POS = 0, SIZ = alias_s_name, NXT = alias_xabpro),% alias_efile : $BBLOCK[NAM$C_MAXRSS],% alias_rfile : $BBLOCK[NAM$C_MAXRSS],% alias_nam : $NAM( ESA = alias_efile,# ESS = %ALLOCATION(alias_efile), RSA = alias_rfile,$ RSS = %ALLOCATION(alias_rfile)),. alias_fab : $FAB( FNM = 'FTP_ALIAS_DATABASE', DNM = 'SYS$LOGIN:.DAT', FAC = (GET,PUT,UPD,DEL), FOP = MXV, MRS = alias_s_maxrec, NAM = alias_nam, ORG = IDX, RFM = VAR, SHR = (GET,PUT,UPD,DEL,MSE), XAB = alias_xabkey),& alias_keyrab : $RAB( FAB = alias_fab, KRF = 0, KSZ = alias_s_name, RAC = KEY, USZ = alias_s_maxrec),) alias_loopbuf : $BBLOCK[alias_s_maxrec],' alias_looprab : $RAB( FAB = alias_fab, RAC = SEQ, UBF = alias_loopbuf,& USZ = %ALLOCATION(alias_loopbuf)); #GLOBAL ROUTINE valid_alias(name_a)=!++! Functional Description:!C! This routine is called to verify whether name_a points to a valid ! alias name.! ! Parameters:!<! name_a - the address of a descriptor containing the alias!-- BEGIN EXTERNAL ROUTINE< STR$FIND_FIRST_NOT_IN_SET : BLISS ADDRESSING_MODE(GENERAL);+ RETURN !Return status to the callerH (IF STR$FIND_FIRST_NOT_IN_SET(.name_a, !Scan for invalid alias chars8 %ASCID'$_-ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789') NEQ 00 THEN FTP$_INVALSYN !Invalid alias syntax0 ELSE SS$_NORMAL); !This is a valid alias END; !End of valid_alias EGLOBAL ROUTINE open_alias_database(which_rab : ALRABDEF, create_flag, nosignal_flag)=!++! Functional Description:!H! This routine opens this user's FTP alias database if it is not alreadyB! open. It also connects one of the two RABs if it is not already ! connected.! ! Parameters:!B! which_rab - a mask indicating which RABs should be connected (if ! any).C! create_flag - low bit set if the database we should try to create2! the database if it doesn't exist. Optional.?! nosignal_flag - low bit set if errors should not be signaled.! Optional.!-- BEGIN LOCAL signal_flag, status, statusv; BUILTIN NULLPARAMETER; EXTERNAL ROUTINE get_yes_no,- LIB$GETJPI : BLISS ADDRESSING_MODE(GENERAL); %IF debug' %THEN print('open_alias_database'); %FIE signal_flag = NULLPARAMETER(nosignal_flag) OR NOT .nosignal_flag;" IF .alias_fab[FAB$W_IFI] EQL 0- THEN BEGIN !The alias file isn't open6 $PARSE(FAB = alias_fab); !Parse the filename for the !...error message= status = $OPEN(FAB = alias_fab); !Try to open the alias file! statusv = .alias_fab[FAB$L_STV]; %IF debug, %THEN print('$OPEN status = !XL', .status); %FI IF .status THEN BEGIN IF .my_uic EQL 0< THEN status = LIB$GETJPI( !Get the UIC of this process! %REF(JPI$_UIC), 0, 0, my_uic); IF NOT .status OR& .alias_xabpro[XAB$L_UIC] NEQ .my_uic$ THEN BEGIN !UICs don't match. $CLOSE(FAB = alias_fab); !Close the database5 status = FTP$_NOTAUTH; !Set up the error to signal/ statusv = 0; !Will be used as the arg count END; !End of UIC mismatch$ END !End of opened the fileD ELSE IF .status EQL RMS$_FNF AND NOT NULLPARAMETER(create_flag) AND .create_flag THEN BEGING print('FTP alias database !AD not found.', .alias_nam[NAM$B_ESL],  .alias_nam[NAM$L_ESA]); WHILE 1- DO BEGIN !Loop until we get an answer4 status = get_yes_no( !Ask about creating a new DB> %ASCID'Do you want to create a new alias database ? [Y]: ', %ASCID'Y');0 IF .status GTRU 1 !The answer was "A" or "Q",3 THEN SIGNAL(FTP$_YES_OR_NO) !...complain about it/ ELSE EXITLOOP; !Got a valid answer, get out END; !End of question loop IF .status THEN BEGIN+ status = $CREATE( !Create the alias file FAB = alias_fab);" statusv = .alias_fab[FAB$L_STV]; %IF debug/ %THEN print('$CREATE status = !XL', .status); %FI IF .status AND .signal_flag, THEN SIGNAL(FTP$_DBCREATED, 2, !Created it .alias_nam[NAM$B_RSL], .alias_nam[NAM$L_RSA]);& END !End of create the alias file7 ELSE signal_flag = 0; !Not creating, don't signal !...status 0' END; !End of alias DB not found END !End of open alias file= ELSE status = RMS$_NORMAL; !Alias database already open1 IF .status AND .which_rab[ALRAB_V_KEYRAB] AND .alias_keyrab[RAB$W_ISI] EQL 0 THEN BEGIN> status = $CONNECT(RAB = alias_keyrab); !Connect the keyed RAB$ statusv = .alias_keyrab[RAB$L_STV]; %IF debug6 %THEN print('$CONNECT keyrab status = !XL', .status); %FI END;2 IF .status AND .which_rab[ALRAB_V_LOOPRAB] AND .alias_looprab[RAB$W_ISI] EQL 0 THEN BEGINC status = $CONNECT(RAB = alias_looprab);!Connect the sequential RAB% statusv = .alias_looprab[RAB$L_STV]; %IF debug7 %THEN print('$CONNECT looprab status = !XL', .status); %FI END;# IF NOT .status AND .signal_flag@ THEN SIGNAL(FTP$_DBOPENERR, 2, !Error opening it, report it8 .alix)&+ MGFTP026.GBI[MGFTP.SOURCE]FTP_ALIAS.B32;2I as_nam[NAM$B_ESL], .alias_nam[NAM$L_ESA], .status, .statusv);, .status !Return status to the caller( END; !End of open_alias_database $GLOBAL ROUTINE close_alias_database=!++! Functional Description:!F! This routine closes the alias database and disconnects any connected! RABs.! ! Parameters:!! None.!-- BEGIN %IF debug( %THEN print('close_alias_database'); %FI% IF .alias_keyrab[RAB$W_ISI] NEQ 0C THEN $DISCONNECT(RAB = alias_keyrab); !Disconnect the keyed RAB& IF .alias_looprab[RAB$W_ISI] NEQ 0I THEN $DISCONNECT(RAB = alias_looprab); !Disconnect the sequential RAB" IF .alias_fab[RAB$W_ISI] NEQ 0< THEN $CLOSE(FAB = alias_fab); !Close the alias database SS$_NORMAL) END; !End of close_alias_database /GLOBAL ROUTINE add_alias(alias_rec_a, rec_len)=!++! Functional Description:!F! This routine adds an alias record to the alias database. It assumesH! that the database is already open and that the keyed RAB is connected.! ! Parameters:!6! alias_rec_a - the address of the record to be added.2! rec_len - the length of the record to be added.!-- BEGIN BIND% alias_rec = .alias_rec_a : ALIASDEF; LOCAL status; %IF debug %THEN print('add_alias'); %FI= alias_keyrab[RAB$L_RBF] = alias_rec; !Set up for the $PUT- alias_keyrab[RAB$W_RSZ] = .rec_len; !...G status = $PUT(RAB = alias_keyrab); !Add the record to the database IF NOT .status THEN BEGIN LOCAL& alias_desc : $BBLOCK[DSC$C_S_BLN]* PRESET([DSC$B_CLASS] = DSC$K_CLASS_S,$ [DSC$B_DTYPE] = DSC$K_DTYPE_T);8 get_alias_name(alias_rec, !Set up a descriptor for the+ alias_desc[DSC$W_LENGTH], !...alias name. alias_desc[DSC$A_POINTER]);3 IF .status EQL RMS$_DUP !Signal an error message* THEN SIGNAL(FTP$_DUPALIAS, 1, alias_desc)3 ELSE SIGNAL(FTP$_DBWRTERR, 1, alias_desc, .status, .alias_keyrab[RAB$L_STV]);$ END; !End of error adding alias, .status !Return status to the caller END; !End of add_alias 2GLOBAL ROUTINE modify_alias(alias_rec_a, rec_len)=!++! Functional Description:!I! This routine updates an alias record in the alias database. It assumesH! that the database is already open and that the keyed RAB is connected.! ! Parameters:!B! alias_rec_a - the address of a buffer containing the new record.*! rec_len - the length of the new record.!-- BEGIN BIND% alias_rec = .alias_rec_a : ALIASDEF; LOCAL status; %IF debug %THEN print('modify_alias'); %FI6 alias_keyrab[RAB$L_KBF] = alias_rec[ALIAS_T_NAME];C status = $FIND(RAB = alias_keyrab); !Look up this alias record IF .status THEN BEGIN: alias_keyrab[RAB$L_RBF] = alias_rec; !Set up for the $PUT) alias_keyrab[RAB$W_RSZ] = .rec_len; !...? status = $UPDATE(RAB = alias_keyrab); !Update the alias record END; !End found alias IF NOT .status THEN BEGIN LOCAL& alias_desc : $BBLOCK[DSC$C_S_BLN]* PRESET([DSC$B_CLASS] = DSC$K_CLASS_S,$ [DSC$B_DTYPE] = DSC$K_DTYPE_T);8 get_alias_name(alias_rec, !Set up a descriptor for the+ alias_desc[DSC$W_LENGTH], !...alias name. alias_desc[DSC$A_POINTER]);3 IF .status EQL RMS$_RNF !Signal an error message* THEN SIGNAL(FTP$_UNKALIAS, 1, alias_desc)3 ELSE SIGNAL(FTP$_DBMODERR, 1, alias_desc, .status, .alias_keyrab[RAB$L_STV]);# END !End of error adding alias@ ELSE $RELEASE(RAB = alias_keyrab); !Release the record lock, .status !Return status to the caller! END; !End of modify_alias $GLOBAL ROUTINE remove_alias(name_a)=!++! Functional Description:!C! This routine removes an alias record from the alias database. ItE! assumes that the database is already open and that the keyed RAB is ! connected.! ! Parameters:!>! name_a - the address of a descriptor containing the name of! the alias to delete.!-- BEGIN BIND name = .name_a : $BBLOCK; LOCAL status,$ key_buffer : $BBLOCK[alias_s_name]; %IF debug4 %THEN print('remove_alias : alias = !AS', name); %FI9 CH$COPY(.name[DSC$W_LENGTH], !Make a full alias name! .name[DSC$A_POINTER], %CHAR(0),' %ALLOCATION(key_buffer), key_buffer);G alias_keyrab[RAB$L_KBF] = key_buffer; !Point to the full alias nameC status = $FIND(RAB = alias_keyrab); !Look up this alias record IF .statusG THEN status = $DELETE(RAB = alias_keyrab); !Delete the alias record IF .status EQL RMS$_RNF9 THEN SIGNAL(FTP$_UNKALIAS, 1, name) !Alias not found ELSE IF NOT .status@ THEN SIGNAL(FTP$_DBREMERR, 1, name, !Another error removing% .status, .alias_keyrab[RAB$L_STV]);, .status !Return status to the caller! END; !End of remove_alias :GLOBAL ROUTINE find_alias(name_a, alias_rec_a, rec_len_a)=!++! Functional Description:!?! This routine finds an alias record in the alias database. ItE! assumes that the database is already open and that the keyed RAB is ! connected.! ! Parameters:!>! name_a - the address of a descriptor containing the name of! the alias to find.C! alias_rec_a - the address of a buffer to receive the record found7! Optional. If this parameter is omitted, then the.! record will just be found, but not read.@! rec_len_a - the address of a word to receive the buffer length! Optional.!-- BEGIN BIND name = .name_a : $BBLOCK; LOCAL status,$ key_buffer : $BBLOCK[alias_s_name]; BUILTIN NULLPARAMETER; %IF debug2 %THEN print('find_alias : alias = !AS', name); %FI9 CH$COPY(.name[DSC$W_LENGTH], !Make a full alias name! .name[DSC$A_POINTER], %CHAR(0),' %ALLOCATION(key_buffer), key_buffer);G alias_keyrab[RAB$L_KBF] = key_buffer; !Point to the full alias name status =& (IF NOT NULLPARAMETER(alias_rec_a) THEN BEGINE alias_keyrab[RAB$L_UBF] = .alias_rec_a; !Tell RMS to use this buffer1 $GET(RAB = alias_keyrab) !Get this alias record END !End of read the record> ELSE $FIND(RAB = alias_keyrab)); !Find this alias record %IF debug. %THEN print('Find status = !XL', .status); %FI IF .status THEN BEGINC IF NOT NULLPARAMETER(alias_rec_a) AND NOT NULLPARAMETER(rec_len_a) THEN BEGIN& BIND rec_len = .rec_len_a : WORD;@ rec_len = .alias_keyrab[RAB$W_RSZ]; !Save the record length, END; !End of record length requested7 $RELEASE(RAB = alias_keyrab); !Don't lock this record" END; !End of found the record, .status !Return status to the caller END; !End of find_alias (GLOBAL ROUTINE alias_loop(rtn_a, param)=!++! Functional Description:!F! This routine loops through the alias records in the database callingF! a user specified routine for each record. It assumes that the alias8! file is open and that the sequential RAB is connected.!A! Note: This routine is not reentrant, so nested calls should not@! be made. All of the other routines use alias_keyrab, so they>! can be safely called from within the user-provided routine.! ! Parameters:!-! rtn_a - the address of the routine to call6! param - the value of an optional parameter to pass.!-- BEGIN LOCAL status; BUILTIN NULLPARAMETER; %IF debug %THEN print('alias_loop'); %FIE status = $REWIND(RAB = alias_looprab); !Reset to the first record2 WHIL;c MGFTP026.GBI[MGFTP.SOURCE]FTP_ALIAS.B32;2I @E .status !Loop until out of records or$ DO BEGIN !...an error occurs9 status = $GET(RAB = alias_looprab); !Get the next record IF .status THEN BEGINA $RELEASE(RAB = alias_looprab); !Unlock in case the rtn wants !...to lock itA status = (.rtn_a)(alias_loopbuf, !Call the rtn w/this record .alias_looprab[RAB$W_RSZ],1 (IF NULLPARAMETER(param) THEN 0 ELSE .param));' END; !End of got another record END; !End of record loop@ RETURN(IF .status EQL RMS$_EOF !Return status to the caller1 THEN RMS$_NORMAL !Expected error, ignore it ELSE .status); END; !End of alias_loopEND !End of module beginELUDOM"*[MGFTP.SOURCE]FTP_ALIAS_CMDS.B32;5+,.h/ 4Nhh-I0123KPWOi56c7Z 89/RFÞGHJ ! MadGoat FTP client and server!?! Authors: Chad Wilson, Dale Moore, Tod Shannon, Bruce Miller,,! Marc Shannon, Henry Miller, John Clement,1! Matt Madison, Darrell Burkhead, Hunter Goatley!6! Copyright 1986, 1992, Carnegie Mellon University.<! Copyright 1994, MadGoat Software. All rights reserved.!?! Permission is granted for not-for-profit redistribution,?! provided all source and object code remain unchanged from?! the original distribution, and that all copyright notices! remain intact.!MODULE ftp_alias_cmds( ADDRESSING_MODE ( EXTERNAL = LONG_RELATIVE," NONEXTERNAL = LONG_RELATIVE), IDENT = 'V2.2',$ LIST (ASSEMBLY, NOBINARY, NOEXPAND) ) =BEGIN!++! FTP_ALIAS_CMDS.B32!! Description:!E! This module contains the command routines for commands having to do! with FTP aliases.!,! Written By: Darrell Burkhead July 15, 1994!! Modifications:!)! V2.2 Hunter Goatley 25-SEP-1996 18:56<! Clear temp variable in rotate_string(). Garbage contentsA! were causing odd-length passwords to not be rotated correctly.!!--LIBRARY 'SYS$LIBRARY:STARLET';LIBRARY 'FTP_ALIAS';LIBRARY 'CLI';LIBRARY 'FTP_MSG';LIBRARY 'NETAUX';LIBRARY 'FIELDS'; COMPILETIME debug = 0;M%IF debug %THEN %MESSAGE('DEBUG mode is enabled in FTP_ALIAS_CMDS.B32!') %FI;FORWARD ROUTINE fill_alias_rec, read_alias_rec, add_alias_cmd, parse_alias_context, match_alias_rec, show_alias_cmd, show_alias_rec, delete_alias_cmd, delete_alias_rec, modify_alias_cmd, alias_lookup;EXTERNAL ROUTINE valid_alias, open_alias_database, add_alias, modify_alias, remove_alias, find_alias, alias_loop, get_switch_value, strings_handler, ftp_get_input_noecho,!1 LIB$PUT_OUTPUT : BLISS ADDRESSING_MODE(GENERAL),. LIB$SYS_FAO : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL),1 STR$MATCH_WILD : BLISS ADDRESSING_MODE(GENERAL),- STR$UPCASE : BLISS ADDRESSING_MODE(GENERAL);GLOBAL* fnd_alias_rec : $BBLOCK[alias_s_maxrec], fnd_alias_rec_len : WORD,4 alias_name : $BBLOCK[DSC$C_S_BLN] VOLATILE PRESET( [DSC$W_LENGTH] = 0," [DSC$B_CLASS] = DSC$K_CLASS_D," [DSC$B_DTYPE] = DSC$K_DTYPE_T, [DSC$A_POINTER] = 0),8 alias_hostname : $BBLOCK[DSC$C_S_BLN] VOLATILE PRESET( [DSC$W_LENGTH] = 0," [DSC$B_CLASS] = DSC$K_CLASS_D," [DSC$B_DTYPE] = DSC$K_DTYPE_T, [DSC$A_POINTER] = 0),8 alias_username : $BBLOCK[DSC$C_S_BLN] VOLATILE PRESET( [DSC$W_LENGTH] = 0," [DSC$B_CLASS] = DSC$K_CLASS_D," [DSC$B_DTYPE] = DSC$K_DTYPE_T, [DSC$A_POINTER] = 0),8 alias_password : $BBLOCK[DSC$C_S_BLN] VOLATILE PRESET( [DSC$W_LENGTH] = 0," [DSC$B_CLASS] = DSC$K_CLASS_D," [DSC$B_DTYPE] = DSC$K_DTYPE_T, [DSC$A_POINTER] = 0),7 alias_account : $BBLOCK[DSC$C_S_BLN] VOLATILE PRESET( [DSC$W_LENGTH] = 0," [DSC$B_CLASS] = DSC$K_CLASS_D," [DSC$B_DTYPE] = DSC$K_DTYPE_T, [DSC$A_POINTER] = 0),7 alias_command : $BBLOCK[DSC$C_S_BLN] VOLATILE PRESET( [DSC$W_LENGTH] = 0," [DSC$B_CLASS] = DSC$K_CLASS_D," [DSC$B_DTYPE] = DSC$K_DTYPE_T, [DSC$A_POINTER] = 0),: alias_description : $BBLOCK[DSC$C_S_BLN] VOLATILE PRESET( [DSC$W_LENGTH] = 0," [DSC$B_CLASS] = DSC$K_CLASS_D," [DSC$B_DTYPE] = DSC$K_DTYPE_T, [DSC$A_POINTER] = 0);BIND! add_cmd_str = %ASCID'ADD ALIAS',$ mod_cmd_str = %ASCID'MODIFY ALIAS',$ rem_cmd_str = %ASCID'REMOVE ALIAS',# show_cmd_str = %ASCID'SHOW ALIAS', show_header1 =A %ASCID'Alias Host Username', show_header2 =A %ASCID'----- ---- --------', none_str = %ASCID'(none)',* password_set_str= %ASCID'(password set)',# anon_user_str = %ASCID'anonymous',% alias_name_str = %ASCID'ALIAS_NAME',# anonymous_str = %ASCID'ANONYMOUS',# apassword_str = %ASCID'APASSWORD', brief_str = %ASCID'BRIEF', command_str = %ASCID'COMMAND', confirm_str = %ASCID'CONFIRM',' description_str = %ASCID'DESCRIPTION', full_str = %ASCID'FULL', host_str = %ASCID'HOST', log_str = %ASCID'LOG',! password_str = %ASCID'PASSWORD',# user_acct_str = %ASCID'USER_ACCT',# user_name_str = %ASCID'USER_NAME';LITERAL alias_disp_len = 12, host_disp_len = 32; _DEF(alctx) alctx_l_flags = _LONG, _OVERLAY(alctx_l_flags) alctx_v_full = _BIT, alctx_v_confirm = _BIT, alctx_v_log = _BIT, alctx_v_found = _BIT, alctx_v_hostname = _BIT, alctx_v_account = _BIT, alctx_v_noaccount = _BIT, alctx_v_description = _BIT, alctx_v_nodescription = _BIT, alctx_v_username = _BIT, alctx_v_nousername = _BIT, alctx_v_anonymous = _BIT, alctx_v_noanonymous = _BIT, _ENDOVERLAY alctx_l_alias = _LONG, alctx_l_hostname = _LONG, alctx_l_account = _LONG,! alctx_l_description = _LONG, alctx_l_username = _LONG_ENDDEF(alctx); %ROUTINE xor_string(src_a, pattern_a)=!++! Functional Description:!F! This routine takes a string and XORs it with one or more copies of a! pattern string.! ! Parameters:!"! src_a - the string to be XORed.!! pattern_a - the pattern string.!-- BEGIN BIND src = .src_a : $BBLOCK," pattern = .pattern_a : $BBLOCK,- pat_ptr = .pattern[DSC$A_POINTER] : $BBLOCK; LOCAL pat_cnt : INITIAL(0);J INCRA src_ptr FROM .src[DSC$A_POINTER] TO CH$PLUS(.src[DSC$A_POINTER], .src[DSC$W_LENGTH]-1) DO BEGIN! BIND cur_char = .src_ptr : BYTE;6 cur_char = .cur_char XOR .pat_ptr[.pat_cnt, 0, 8, 0];, pat_cnt = !Move to the next pattern char( (IF .pat_cnt EQL .pattern[DSC$W_LENGTH] THEN 0 !Loop around" ELSE .pat_cnt + 1); !Next char! END; !End of src string loop SS$_NORMAL END; !End of xor_string -ROUTINE rotate_string(src_a, direction_flag)=!++! Functional Description:!C! This routine takes a bitwise rotates the component longwords of a! string by one bit.! ! Parameters:!$! sr4 MGFTP026.GI"[MGFTP.SOURCE]FTP_ALIAS_CMDS.B32;5Nhn c_a - the string to be rotated.=! direction_flag - low bit set means left, clear means right.!-- BEGIN BIND src = .src_a : $BBLOCK,/ src_vec = .src[DSC$A_POINTER] : VECTOR[,LONG]; LOCAL dir_flag, num_longs, excess_bytes, temp, shift; BUILTIN NULLPARAMETER, ROT; E dir_flag = NOT NULLPARAMETER(direction_flag) AND .direction_flag;% num_longs = .src[DSC$W_LENGTH]/4;, excess_bytes = .src[DSC$W_LENGTH] MOD 4;! shift = !Set the rotation (IF .dir_flag THEN 1 !Left ELSE -1); !Right' INCR count FROM 0 TO .num_longs - 17 DO src_vec[.count] = ROT(.src_vec[.count], .shift); IF .excess_bytes GTR 0 THEN BEGIN- BIND excess = src_vec[.num_longs] : $BBLOCK;& temp = 0; !Clear temp so ROT works< temp<0, .excess_bytes*8, 0> = !Copy excess bytes to a long$ .excess[0, 0, .excess_bytes*8, 0];1 temp = ROT(.temp, .shift); !Rotate excess bytes% IF .dir_flag !Finish the rotation$ THEN temp<0, 1, 0> = !Rotate left$ .temp<.excess_bytes*8-1, 1, 0>4 ELSE temp<31, 1, 0> = .temp<0, 1, 0>; !Rotate right: excess[0, 0, .excess_bytes*8, 0] = !Save the rotated bits .temp<0, .excess_bytes*8, 0>;% END; !End of rotate excess bytes/ SS$_NORMAL !Return status to the caller" END; !End of rotate_string  JROUTINE fill_alias_rec(alias_rec_a, rec_len_a, name_a, host_a, username_a,4 password_a, account_a, command_a, description_a)=!++! Functional Description:!E! This routine is called to fill in an alias database record with itsB! constituent strings. Assumes the ALIAS_L_FLAGS has already been ! filled in.!E! Note: FTP$_STRTOOLONG is an error status, so signaling it should at! least abort the command.! ! Parameters:!5! alias_rec_a - the address of the record to fill in.A! rec_len_a - the address of a word to receive the record length.B! name_a - the address of a descriptor containing the alias name.A! host_a - the address of a descriptor containing the host name.C! username_a - the address of a descriptor containing the username.C! password_a - the address of a descriptor containing the password.A! account_a - the address of a descriptor containing the account.@! command_a - the address of a descriptor containing the initial! command.<! description_a - the address of a descriptor containing the! description.!-- BEGIN BIND% alias_rec = .alias_rec_a : ALIASDEF, rec_len = .rec_len_a : WORD, name = .name_a : $BBLOCK, host = .host_a : $BBLOCK," username = .username_a : $BBLOCK," password = .password_a : $BBLOCK,! account = .account_a : $BBLOCK,! command = .command_a : $BBLOCK,' description = .description_a: $BBLOCK; LOCAL: alias_ptr : REF $BBLOCK INITIAL(alias_rec[ALIAS_T_REST]), status; MACRO desc_to_ac(desc)= BEGIN BIND _desc = desc : $BBLOCK;2 REGISTER tmp_len : INITIAL(._desc[DSC$W_LENGTH]);7 CH$WCHAR_A(.tmp_len, alias_ptr); !Copy the length byte9 CH$MOVE(.tmp_len, ._desc[DSC$A_POINTER],!Copy the string .alias_ptr);+ alias_ptr = CH$PLUS(.alias_ptr, .tmp_len); END%; !End of desc_to_ac %IF debug" %THEN print('fill_alias_rec'); %FI+ IF .name[DSC$W_LENGTH] GTRU alias_s_name2 THEN SIGNAL(FTP$_STRTOOLONG, 1, %ASCID'Alias') ELSE BEGIN LOCAL dest_ptr : REF $BBLOCK;C dest_ptr = alias_rec[ALIAS_T_NAME]; !Set up for the copy/uppercase+ INCRA src_ptr FROM .name[DSC$A_POINTER] TO9 CH$PLUS(.name[DSC$A_POINTER], .name[DSC$W_LENGTH] - 1) DO BEGIN% BIND cur_char = .src_ptr : BYTE;, CH$WCHAR_A( !Copy the next character; IF .cur_char GEQU %C'a' AND !Need to uppercase this char? .cur_char LEQU %C'z'; THEN .cur_char AND %B'11011111' !Yes, uppercase this char1 ELSE .cur_char, !No, use the character itself* dest_ptr); !Where to put the character( END; !End of copy/uppercase loop) IF .name[DSC$W_LENGTH] LSSU alias_s_name2 THEN CH$FILL(%CHAR(0), !Fill with trailing NULs1 alias_s_name - .name[DSC$W_LENGTH], .dest_ptr);% END; !End of copy the alias name0 IF .host[DSC$W_LENGTH] GTRU alias_s_hostname1 THEN SIGNAL(FTP$_STRTOOLONG, 1, %ASCID'Host'): ELSE CH$COPY(.host[DSC$W_LENGTH], !Copy the host name! .host[DSC$A_POINTER], %CHAR(0),1 alias_s_hostname, alias_rec[ALIAS_T_HOSTNAME]);# IF .alias_rec[ALIAS_V_USERNAME]9 THEN IF .username[DSC$W_LENGTH] GTRU alias_s_username2 THEN SIGNAL(FTP$_STRTOOLONG, 1, %ASCID'Username')/ ELSE desc_to_ac(username); !Copy the username# IF .alias_rec[ALIAS_V_PASSWORD]9 THEN IF .password[DSC$W_LENGTH] GTRU alias_s_password2 THEN SIGNAL(FTP$_STRTOOLONG, 1, %ASCID'Password') ELSE BEGIN9 rotate_string(password, 1); !"Encrypt" the password& xor_string(password, host); !.... desc_to_ac(password); !Copy the password# END; !End of store password" IF .alias_rec[ALIAS_V_ACCOUNT]7 THEN IF .account[DSC$W_LENGTH] GTRU alias_s_account1 THEN SIGNAL(FTP$_STRTOOLONG, 1, %ASCID'Account')- ELSE desc_to_ac(account); !Copy the account" IF .alias_rec[ALIAS_V_INITIAL]7 THEN IF .command[DSC$W_LENGTH] GTRU alias_s_initial9 THEN SIGNAL(FTP$_STRTOOLONG, 1, %ASCID'Initial command')- ELSE desc_to_ac(command); !Copy the command& IF .alias_rec[ALIAS_V_DESCRIPTION]? THEN IF .description[DSC$W_LENGTH] GTRU alias_s_description5 THEN SIGNAL(FTP$_STRTOOLONG, 1, %ASCID'Description')5 ELSE desc_to_ac(description); !Copy the descriptionJ rec_len = CH$DIFF(.alias_ptr, alias_rec); !Calculate the record length/ SS$_NORMAL !Return status to the caller# END; !End of fill_alias_rec HROUTINE read_alias_rec(alias_rec_a, rec_len, name_a, host_a, username_a,4 password_a, account_a, command_a, description_a)=!++! Functional Description:!E! This routine is called to fill in an alias database record with itsB! constituent strings. Assumes the ALIAS_L_FLAGS has already been ! filled in.! ! Parameters:!2! alias_rec_a - the address of the record to read.! rec_len - the record length.B! name_a - the address of a descriptor to receive the alias name.A! host_a - the address of a descriptor to receive the host name.C! username_a - the address of a descriptor to receive the username.C! password_a - the address of a descriptor to receive the password.A! account_a - the address of a descriptor to receive the account.@! command_a - the address of a descriptor to receive the initial! command.<! description_a - the address of a descriptor to receive the! description.!-- BEGIN BIND% alias_rec = .alias_rec_a : ALIASDEF, name = .name_a : $BBLOCK, host = .host_a : $BBLOCK," username = .username_a : $BBLOCK," password = .password_a : $BBLOCK,! account = .account_a : $BBLOCK,! command = .command_a : $BBLOCK,' description = .description_a: $BBLOCK; LOCAL src_ptr : REF $BBLOCK, src_len : WORD, status; EXTERNAL ROUTINE- STR$COPY_R : BLISS ADDRESSING_MODE(GENERAL); MACRO ac_to_desc(desc)= BEGIN/ LOCAL tmp_len : INITIAL(.src_ptr[0, 0, 8, 0]);; status = STR$COPY_R(desc, tmp_len, !Copy this ASCIC string .src_ptr + 1);% IF NOT .status THEN SIGNAL(.status);@ src_ptr = .src_ptr + .tmp_len + 1; !Move past this ASCIC string END%; !End of ac_to_desc %IF debug" %THEN print('read_alias_rec'); %FIN get_alias_name(alias_rec, src_len, src_ptr);!Set up to copy the alias name< status = STR$Ca3h MGFTP026.GI"[MGFTP.SOURCE]FTP_ALIAS_CMDS.B32;5NhqbOPY_R(name, src_len, !Copy the alias name .src_ptr);( IF NOT .status THEN SIGNAL(.status);M get_host_name(alias_rec, src_len, src_ptr); !Set up to copy the host name; status = STR$COPY_R(host, src_len, !Copy the host name .src_ptr);( IF NOT .status THEN SIGNAL(.status);@ src_ptr = alias_rec[ALIAS_T_REST]; !Point to the ASCIC area# IF .alias_rec[ALIAS_V_USERNAME]3 THEN ac_to_desc(username); !Copy the username# IF .alias_rec[ALIAS_V_PASSWORD] THEN BEGIN+ ac_to_desc(password); !Copy the password5 xor_string(password, host); !"Decrypt" the password rotate_string(password); !... END; !End of read password" IF .alias_rec[ALIAS_V_ACCOUNT]1 THEN ac_to_desc(account); !Copy the account" IF .alias_rec[ALIAS_V_INITIAL]1 THEN ac_to_desc(command); !Copy the command& IF .alias_rec[ALIAS_V_DESCRIPTION]8 THEN ac_to_desc(description); !Copy the description/ SS$_NORMAL !Return status to the caller# END; !End of read_alias_rec GLOBAL ROUTINE add_alias_cmd=!++! Functional Description:!=! This routine is called in response to an ADD ALIAS command.!-- BEGIN LOCAL% alias_rec : $BBLOCK[alias_s_maxrec], rec_len : WORD, rab_flags : ALRABDEF,. name : $BBLOCK[DSC$C_S_BLN] VOLATILE PRESET( [DSC$W_LENGTH] = 0,! [DSC$B_CLASS] = DSC$K_CLASS_D,! [DSC$B_DTYPE] = DSC$K_DTYPE_T, [DSC$A_POINTER] = 0),1 account : $BBLOCK[DSC$C_S_BLN] VOLATILE PRESET( [DSC$W_LENGTH] = 0,! [DSC$B_CLASS] = DSC$K_CLASS_D,! [DSC$B_DTYPE] = DSC$K_DTYPE_T, [DSC$A_POINTER] = 0),4 description : $BBLOCK[DSC$C_S_BLN] VOLATILE PRESET( [DSC$W_LENGTH] = 0,! [DSC$B_CLASS] = DSC$K_CLASS_D,! [DSC$B_DTYPE] = DSC$K_DTYPE_T, [DSC$A_POINTER] = 0),1 command : $BBLOCK[DSC$C_S_BLN] VOLATILE PRESET( [DSC$W_LENGTH] = 0,! [DSC$B_CLASS] = DSC$K_CLASS_D,! [DSC$B_DTYPE] = DSC$K_DTYPE_T, [DSC$A_POINTER] = 0),1 hostname : $BBLOCK[DSC$C_S_BLN] VOLATILE PRESET( [DSC$W_LENGTH] = 0,! [DSC$B_CLASS] = DSC$K_CLASS_D,! [DSC$B_DTYPE] = DSC$K_DTYPE_T, [DSC$A_POINTER] = 0),1 password : $BBLOCK[DSC$C_S_BLN] VOLATILE PRESET( [DSC$W_LENGTH] = 0,! [DSC$B_CLASS] = DSC$K_CLASS_D,! [DSC$B_DTYPE] = DSC$K_DTYPE_T, [DSC$A_POINTER] = 0),1 username : $BBLOCK[DSC$C_S_BLN] VOLATILE PRESET( [DSC$W_LENGTH] = 0,! [DSC$B_CLASS] = DSC$K_CLASS_D,! [DSC$B_DTYPE] = DSC$K_DTYPE_T, [DSC$A_POINTER] = 0), status; MAP alias_rec : ALIASDEF; ENABLE@ strings_handler(name, account, description, hostname, password, username, command); %IF debugl! %THEN print('add_alias_cmd');, %FIB< alias_rec[ALIAS_V_PASSWORD] = CLI$PRESENT(password_str);# IF .alias_rec[ALIAS_V_PASSWORD]1 THEN BEGIN3 status = get_switch_value(password_str, password);g IF .status EQL CLI$_ABSENTe THEN BEGIN6 print(' '); ! GET_COMMAND over prints last lineA status = ftp_get_input_noecho(password, %ASCID'Password: ');  IF .status EQL RMS$_EOF9 THEN RETURN(SS$_NORMAL) !Get out before any stringsE !...are filled in. ELSE IF NOT .status: THEN SIGNAL(FTP$_NO_SWITCH, 1, add_cmd_str, .status);, END !End of prompt for the password ELSE IF NOT .status6 THEN SIGNAL(FTP$_NO_SWITCH, 1, add_cmd_str, .status); END;v4 status = get_switch_value(alias_name_str, name);H IF NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1, add_cmd_str, .status);A status = STR$UPCASE(name, name); !Make sure it is uppercaseda( IF NOT .status THEN SIGNAL(.status);5 status = valid_alias(name); !Check alias syntaxR( IF NOT .status THEN SIGNAL(.status);2 status = get_switch_value(host_str, hostname);H IF NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1, add_cmd_str, .status);$ IF .hostname[DSC$W_LENGTH] EQL 0 THEN SIGNAL(FTP$_INVHOST);< alias_rec[ALIAS_V_ACCOUNT] = CLI$PRESENT(user_acct_str);" IF .alias_rec[ALIAS_V_ACCOUNT] THEN BEGIN3 status = get_switch_value(user_acct_str, account);E IF NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1, add_cmd_str, .status);I END;l= alias_rec[ALIAS_V_USERNAME] = CLI$PRESENT(user_name_str);# IF .alias_rec[ALIAS_V_USERNAME]l THEN BEGIN4 status = get_switch_value(user_name_str, username);E IF NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1, add_cmd_str, .status);B END;D: alias_rec[ALIAS_V_INITIAL] = CLI$PRESENT(command_str);" IF .alias_rec[ALIAS_V_INITIAL] THEN BEGIN1 status = get_switch_value(command_str, command);EE IF NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1, add_cmd_str, .status);s END;nB alias_rec[ALIAS_V_DESCRIPTION] = CLI$PRESENT(description_str);& IF .alias_rec[ALIAS_V_DESCRIPTION] THEN BEGIN9 status = get_switch_value(description_str, description);)E IF NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1, add_cmd_str, .status);W END;]> alias_rec[ALIAS_V_ANONYMOUS] = CLI$PRESENT(anonymous_str);( status = CLI$PRESENT(apassword_str);K alias_rec[ALIAS_V_ANON_PASS] = .status OR !Send the anonymous password?=1 (.alias_rec[ALIAS_V_ANONYMOUS] AND !...user@hostB& NOT .alias_rec[ALIAS_V_PASSWORD] AND .status NEQ CLI$_NEGATED);E fill_alias_rec(alias_rec, rec_len, name, !Fill in the rest of theD0 hostname, username, password, !...alias record" account, command, description); ! rab_flags[ALRAB_L_FLAGS] = 0;$: rab_flags[ALRAB_V_KEYRAB] = 1; !Connect the keyed RABH status = open_alias_database(.rab_flags, 1);!Open the alias database IF .status THEN BEGIN7 status = add_alias(alias_rec, !Add this record to theL .rec_len); !...databaseS$ IF .status AND CLI$PRESENT(log_str)7 THEN SIGNAL(FTP$_ALIASADD, 1, name); !Log the additionr END; !End of add this alias status = STR$FREE1_DX(name);( IF NOT .status THEN SIGNAL(.status);$ status = STR$FREE1_DX(hostname);( IF NOT .status THEN SIGNAL(.status);$ status = STR$FREE1_DX(username);( IF NOT .status THEN SIGNAL(.status);$ status = STR$FREE1_DX(password);( IF NOT .status THEN SIGNAL(.status);# status = STR$FREE1_DX(account); ( IF NOT .status THEN SIGNAL(.status);# status = STR$FREE1_DX(command); ( IF NOT .status THEN SIGNAL(.status);' status = STR$FREE1_DX(description);w( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL* END; !End of routine add_alias_cmd S2ROUTINE parse_alias_context(context_a, cmd_str_a)=!++b! Functional Description:!mD! This routine is used to parse the common qualifiers and parameters(! of the SHOW and DELETE ALIAS commands.! ! Parameters:!h@! context_a - the address of an alias context block to be filled ! in.S@! cmd_str_a - the address of a descriptor containing the command3! string that should appear in signaled errors.!--s BEGIN= BIND$ context = .context_a : ALCTXDEF,+ name = .context[ALCTX_L_ALIAS] : $BBLOCK,l1 hostname = .context[ALCTX_L_HOSTNAME] : $BBLOCK,g0 account = .context[ALCTX_L_ACCOUNT] : $BBLOCK,7 description = .context[ALCTX_L_DESCRIPTION] : $BBLOCK,c1 username = .context[ALCTX_L_USERNAME] : $BBLOCK,v# cmd_str = .cmd_str_a : $BBLOCK;n LOCAL status; %IF debugT' %THEN print('parse_alias_context');n %FIs4 status = get_switch_value(alias_name_str, name);D IF NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1, cmd_str, .status);? status = STR$UPCASE(name, name); !Uppercase for comparisonD( IF NOT .status THEN SIGNAL(.status);# status = CLI$PRESENT(host_str);s IF .status THQE MGFTP026.GI"[MGFTP.SOURCE]FTP_ALIAS_CMDS.B32;5Nh+EN BEGIN: context[ALCTX_V_HOSTNAME] = 1; !Need to check host names/ status = get_switch_value(host_str, hostname);-A IF NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1, cmd_str, .status);B status = STR$UPCASE(hostname, hostname);!Uppercase for comparison% IF NOT .status THEN SIGNAL(.status);$" END; !End of check host names( status = CLI$PRESENT(user_acct_str); IF .status THEN BEGIN< context[ALCTX_V_ACCOUNT] = 1; !Need to check account names3 status = get_switch_value(user_acct_str, account);aA IF NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1, cmd_str, .status); A status = STR$UPCASE(account, account); !Uppercase for comparison % IF NOT .status THEN SIGNAL(.status);n$ END !End of check account names$ ELSE IF .status EQL CLI$_NEGATEDG THEN context[ALCTX_V_NOACCOUNT] = 1; !Look for records w/out acctsc* status = CLI$PRESENT(description_str); IF .status THEN BEGIN> context[ALCTX_V_DESCRIPTION] = 1; !Need to check descriptions9 status = get_switch_value(description_str, description);eA IF NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1, cmd_str, .status);; status = STR$UPCASE(description, !Uppercase for comparisonc description);E% IF NOT .status THEN SIGNAL(.status);f# END !End of check descriptionst$ ELSE IF .status EQL CLI$_NEGATEDL THEN context[ALCTX_V_NODESCRIPTION] = 1; !Look for records w/out descrip( status = CLI$PRESENT(user_name_str); IF .status THEN BEGIN9 context[ALCTX_V_USERNAME] = 1; !Need to check usernamest4 status = get_switch_value(user_name_str, username);A IF NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1, cmd_str, .status);B status = STR$UPCASE(username, username);!Uppercase for comparison% IF NOT .status THEN SIGNAL(.status);N END !End of check usernames$ ELSE IF .status EQL CLI$_NEGATEDG THEN context[ALCTX_V_NOUSERNAME] = 1; !Look for records w/out usersg( status = CLI$PRESENT(anonymous_str); IF .statusB THEN context[ALCTX_V_ANONYMOUS] = 1 !Match anonymous accounts$ ELSE IF .status EQL CLI$_NEGATEDH THEN context[ALCTX_V_NOANONYMOUS] = 1; !Match non-anonymous accounts/ SS$_NORMAL !Return status to the caller*( END; !End of parse_alias_context eLROUTINE match_alias_rec(alias_rec_a, rec_len, context_a, name_a, hostname_a,) account_a, description_a, username_a)= !++ ! Functional Description:O!NC! This routine is used to check whether an alias record matches the/! information stored in an alias context block.a! ! Parameters:n!D?! alias_rec_a - the address of the alias record being displayedt+! rec_len - the length of the alias record.>! context_a - the address of alias context information used to/! determine whether to display this record.gA! name_a - the address of a descriptor containing the alias namesC! hostname_a - the address of a descriptor containing the host name_@! account_a - the address of a descriptor containing the account<! description_a - the address of a descriptor containing the! description.B! username_a - the address of a descriptor containing the username!--e BEGINc BIND% alias_rec = .alias_rec_a : ALIASDEF,t" context = .context_a : ALCTXDEF, name = .name_a : $BBLOCK, " hostname = .hostname_a : $BBLOCK,! account = .account_a : $BBLOCK,h' description = .description_a: $BBLOCK,i" username = .username_a : $BBLOCK; LOCALd match : INITIAL(1),o2 temp_desc : $BBLOCK[DSC$C_S_BLN] VOLATILE PRESET( [DSC$W_LENGTH] = 0,! [DSC$B_CLASS] = DSC$K_CLASS_D, ! [DSC$B_DTYPE] = DSC$K_DTYPE_T,e [DSC$A_POINTER] = 0), status; ENABLE strings_handler(temp_desc); MACROr match_wild(pattern, candidate)= BEGIN8 status = STR$UPCASE(temp_desc, !Uppercase the candidate) candidate); !...string for comparison % IF NOT .status THEN SIGNAL(.status);I< match = STR$MATCH_WILD(temp_desc, !Try to match the pattern pattern);N END%; !End of match_wild %IF debuge# %THEN print('match_alias_rec'); %FI_K match_wild(.context[ALCTX_L_ALIAS], name); !Try to match the alias name_, IF .match AND .context[ALCTX_V_HOSTNAME]K THEN match_wild(.context[ALCTX_L_HOSTNAME], !Try to match the host name hostname); + IF .match AND .context[ALCTX_V_ACCOUNT] + THEN IF NOT .alias_rec[ALIAS_V_ACCOUNT] - THEN match = 0 !No account for this record)2 ELSE match_wild( !Try to match the account name& .context[ALCTX_L_ACCOUNT], account);M IF .match AND .context[ALCTX_V_NOACCOUNT] AND .alias_rec[ALIAS_V_ACCOUNT]- THEN match = 0; !Record has an accountN/ IF .match AND .context[ALCTX_V_DESCRIPTION]t/ THEN IF NOT .alias_rec[ALIAS_V_DESCRIPTION]c1 THEN match = 0 !No description for this recordp1 ELSE match_wild( !Try to match the descriptionH. .context[ALCTX_L_DESCRIPTION], description);5 IF .match AND .context[ALCTX_V_NODESCRIPTION] ANDl .alias_rec[ALIAS_V_DESCRIPTION]0 THEN match = 0; !Record has a description, IF .match AND .context[ALCTX_V_USERNAME], THEN IF NOT .alias_rec[ALIAS_V_USERNAME]. THEN match = 0 !No username for this record. ELSE match_wild( !Try to match the username( .context[ALCTX_L_USERNAME], username);2 IF .match AND .context[ALCTX_V_NOUSERNAME] AND .alias_rec[ALIAS_V_USERNAME].- THEN match = 0; !Record has a usernames1 IF .match AND .context[ALCTX_V_ANONYMOUS] ANDa" NOT .alias_rec[ALIAS_V_ANONYMOUS]0 THEN match = 0; !Record doesn't use /ANON3 IF .match AND .context[ALCTX_V_NOANONYMOUS] ANDF .alias_rec[ALIAS_V_ANONYMOUS]) THEN match = 0; !Record uses /ANONe+ .match !Return status to the callerD$ END; !End of match_alias_rec UGLOBAL ROUTINE show_alias_cmd=!++_! Functional Description:o!)>! This routine is called in response to an SHOW ALIAS command.!--w BEGINx LOCALa rab_flags : ALRABDEF,. name : $BBLOCK[DSC$C_S_BLN] VOLATILE PRESET( [DSC$W_LENGTH] = 0,! [DSC$B_CLASS] = DSC$K_CLASS_D,A! [DSC$B_DTYPE] = DSC$K_DTYPE_T,D [DSC$A_POINTER] = 0),1 account : $BBLOCK[DSC$C_S_BLN] VOLATILE PRESET(c [DSC$W_LENGTH] = 0,! [DSC$B_CLASS] = DSC$K_CLASS_D,! [DSC$B_DTYPE] = DSC$K_DTYPE_T, [DSC$A_POINTER] = 0),4 description : $BBLOCK[DSC$C_S_BLN] VOLATILE PRESET( [DSC$W_LENGTH] = 0,! [DSC$B_CLASS] = DSC$K_CLASS_D,a! [DSC$B_DTYPE] = DSC$K_DTYPE_T,. [DSC$A_POINTER] = 0),1 hostname : $BBLOCK[DSC$C_S_BLN] VOLATILE PRESET(l [DSC$W_LENGTH] = 0,! [DSC$B_CLASS] = DSC$K_CLASS_D,'! [DSC$B_DTYPE] = DSC$K_DTYPE_T,s [DSC$A_POINTER] = 0),1 username : $BBLOCK[DSC$C_S_BLN] VOLATILE PRESET(_ [DSC$W_LENGTH] = 0,! [DSC$B_CLASS] = DSC$K_CLASS_D,e! [DSC$B_DTYPE] = DSC$K_DTYPE_T,; [DSC$A_POINTER] = 0), context : ALCTXDEF PRESET( [ALCTX_L_FLAGS] = 0, [ALCTX_L_ALIAS] = name, ! [ALCTX_L_HOSTNAME] = hostname,d [ALCTX_L_ACCOUNT] = account,l' [ALCTX_L_DESCRIPTION] = description,l" [ALCTX_L_USERNAME] = username), status; ENABLEA strings_handler(name, account, description, hostname, username);d %IF debuge" %THEN print('show_alias_cmd'); %FIeM parse_alias_context(context, show_cmd_str); !Initialize the context blockd2 context[ALCTX_V_FULL] = CLI$PRESENT(full_str);! rab_flags[ALRAB_L_FLAGS] = 0;t@ rab_flags[ALRAB_V_LOOPRAB] = 1; !Connect the sequential RABF status = open_alias_database(.rab_flags); !Open the alias database IF .statusH THEN status = alias_loop(show_alias_rec, !Display the matching alias context); !...recordss. IF .status AND NOT .context[n MGFTP026.GI"[MGFTP.SOURCE]FTP_ALIAS_CMDS.B32;5NhH:ALCTX_V_FOUND]< THEN SIGNAL(FTP$_NODBRECS); !No records were displayed status = STR$FREE1_DX(name);( IF NOT .status THEN SIGNAL(.status);# status = STR$FREE1_DX(account);h( IF NOT .status THEN SIGNAL(.status);' status = STR$FREE1_DX(description);_( IF NOT .status THEN SIGNAL(.status);$ status = STR$FREE1_DX(hostname);( IF NOT .status THEN SIGNAL(.status);$ status = STR$FREE1_DX(username);( IF NOT .status THEN SIGNAL(.status);/ SS$_NORMAL !Return status to the callerE+ END; !End of routine show_alias_cmdN C8ROUTINE show_alias_rec(alias_rec_a, rec_len, context_a)=!++O! Functional Description:h!AC! This routine takes an alias record and decides whether to display)7! the record based on the context information provided. !I ! Parameters:;! ?! alias_rec_a - the address of the alias record being displayeda+! rec_len - the length of the alias records>! context_a - the address of alias context information used to/! determine whether to display this record.a!-- BEGIN BIND% alias_rec = .alias_rec_a : ALIASDEF, " context = .context_a : ALCTXDEF; LOCALt user_ptr : REF $BBLOCK,. name : $BBLOCK[DSC$C_S_BLN] VOLATILE PRESET( [DSC$W_LENGTH] = 0,! [DSC$B_CLASS] = DSC$K_CLASS_D,N! [DSC$B_DTYPE] = DSC$K_DTYPE_T,_ [DSC$A_POINTER] = 0),1 account : $BBLOCK[DSC$C_S_BLN] VOLATILE PRESET(R [DSC$W_LENGTH] = 0,! [DSC$B_CLASS] = DSC$K_CLASS_D,! [DSC$B_DTYPE] = DSC$K_DTYPE_T,O [DSC$A_POINTER] = 0),4 description : $BBLOCK[DSC$C_S_BLN] VOLATILE PRESET( [DSC$W_LENGTH] = 0,! [DSC$B_CLASS] = DSC$K_CLASS_D,p! [DSC$B_DTYPE] = DSC$K_DTYPE_T,  [DSC$A_POINTER] = 0),1 command : $BBLOCK[DSC$C_S_BLN] VOLATILE PRESET(o [DSC$W_LENGTH] = 0,! [DSC$B_CLASS] = DSC$K_CLASS_D,T! [DSC$B_DTYPE] = DSC$K_DTYPE_T,  [DSC$A_POINTER] = 0),1 hostname : $BBLOCK[DSC$C_S_BLN] VOLATILE PRESET(o [DSC$W_LENGTH] = 0,! [DSC$B_CLASS] = DSC$K_CLASS_D,L! [DSC$B_DTYPE] = DSC$K_DTYPE_T, [DSC$A_POINTER] = 0),1 password : $BBLOCK[DSC$C_S_BLN] VOLATILE PRESET(+ [DSC$W_LENGTH] = 0,! [DSC$B_CLASS] = DSC$K_CLASS_D,d! [DSC$B_DTYPE] = DSC$K_DTYPE_T,d [DSC$A_POINTER] = 0),1 username : $BBLOCK[DSC$C_S_BLN] VOLATILE PRESET(c [DSC$W_LENGTH] = 0,! [DSC$B_CLASS] = DSC$K_CLASS_D,C! [DSC$B_DTYPE] = DSC$K_DTYPE_T,$ [DSC$A_POINTER] = 0),2 temp_desc : $BBLOCK[DSC$C_S_BLN] VOLATILE PRESET( [DSC$W_LENGTH] = 0,! [DSC$B_CLASS] = DSC$K_CLASS_D,$! [DSC$B_DTYPE] = DSC$K_DTYPE_T,$ [DSC$A_POINTER] = 0), status; EXTERNAL anon_password;] ENABLE@ strings_handler(name, account, description, hostname, password,! username, command, temp_desc);G %IF debug$" %THEN print('show_alias_rec'); %FI=M read_alias_rec(alias_rec, .rec_len, name, !Get info from the alias recordT? hostname, username, password, account, command, description);AJ IF match_alias_rec(alias_rec, .rec_len, !Does this alias record match?1 context, name, hostname, account, description,$ username) THEN BEGIN* user_ptr = !Point to the username desc! (IF .alias_rec[ALIAS_V_USERNAME]0- THEN username !Use the username providedR' ELSE IF .alias_rec[ALIAS_V_ANONYMOUS]_2 THEN anon_user_str !Use the anonymous username) ELSE none_str); !No username providedm IF .context[ALCTX_V_FULL] THEN BEGIN print(''); " print('Alias:!_!_!AS', name);- print('Description:!_!AS', description);S% print('Host:!_!_!AS', hostname);( print('Username:!_!AS', .user_ptr);' IF .alias_rec[ALIAS_V_USERNAME] ORs= .alias_rec[ALIAS_V_ANONYMOUS] !Username given, display some 3 THEN print('Password:!_!AS', !...password info_$ (IF .alias_rec[ALIAS_V_ANON_PASS] THEN anon_password( ELSE IF .alias_rec[ALIAS_V_PASSWORD] THEN password_set_stre ELSE none_str));# IF .alias_rec[ALIAS_V_ACCOUNT]T* THEN print('Account:!_!AS', account);# IF .alias_rec[ALIAS_V_INITIAL] * THEN print('Command:!_!AS', command);" END !End of /FULL listing ELSE BEGIN # IF NOT .context[ALCTX_V_FOUND]n* THEN BEGIN !This is the first line: LIB$PUT_OUTPUT(show_header1); !Display the /BRIEF header$ LIB$PUT_OUTPUT(show_header2); !...$ END; !End of display the header/ IF .name[DSC$W_LENGTH] GTRU alias_disp_len_ THEN BEGINE print('!AS', name);t2 status = LIB$SYS_FAO( !Format the string before% %ASCID'!#* ', 0, !...the host name_" temp_desc, alias_disp_len + 1);$ END !End of alias name too long7 ELSE status = LIB$SYS_FAO( !Format the alias name6 %ASCID'!#AS ', 0, temp_desc, alias_disp_len, name);) IF NOT .status THEN SIGNAL(.status);2 IF .hostname[DSC$W_LENGTH] GTRU host_disp_len THEN BEGINT' print('!AS!AS', temp_desc, hostname);,: print('!#* !AS', alias_disp_len + 1 + host_disp_len + 1, .user_ptr);# END !End of host name too long]) ELSE print('!AS!#AS !AS', temp_desc,a' host_disp_len, hostname, .user_ptr);s# END; !End of /BRIEF listingr< context[ALCTX_V_FOUND] = 1; !At least one record displayed% END; !End of display this recorda status = STR$FREE1_DX(name);( IF NOT .status THEN SIGNAL(.status);$ status = STR$FREE1_DX(hostname);( IF NOT .status THEN SIGNAL(.status);$ status = STR$FREE1_DX(username);( IF NOT .status THEN SIGNAL(.status);$ status = STR$FREE1_DX(password);( IF NOT .status THEN SIGNAL(.status);# status = STR$FREE1_DX(account);u( IF NOT .status THEN SIGNAL(.status);# status = STR$FREE1_DX(command);_( IF NOT .status THEN SIGNAL(.status);' status = STR$FREE1_DX(description);I( IF NOT .status THEN SIGNAL(.status);% status = STR$FREE1_DX(temp_desc);( IF NOT .status THEN SIGNAL(.status);/ SS$_NORMAL !Return status to the callerN# END; !End of show_alias_rec ] GLOBAL ROUTINE delete_alias_cmd=!++C! Functional Description:! @! This routine is called in response to an DELETE ALIAS command.!--= BEGIN LOCALn rab_flags : ALRABDEF,. name : $BBLOCK[DSC$C_S_BLN] VOLATILE PRESET( [DSC$W_LENGTH] = 0,! [DSC$B_CLASS] = DSC$K_CLASS_D,N! [DSC$B_DTYPE] = DSC$K_DTYPE_T,s [DSC$A_POINTER] = 0),1 account : $BBLOCK[DSC$C_S_BLN] VOLATILE PRESET(d [DSC$W_LENGTH] = 0,! [DSC$B_CLASS] = DSC$K_CLASS_D, ! [DSC$B_DTYPE] = DSC$K_DTYPE_T,  [DSC$A_POINTER] = 0),4 description : $BBLOCK[DSC$C_S_BLN] VOLATILE PRESET( [DSC$W_LENGTH] = 0,! [DSC$B_CLASS] = DSC$K_CLASS_D,.! [DSC$B_DTYPE] = DSC$K_DTYPE_T,d [DSC$A_POINTER] = 0),1 hostname : $BBLOCK[DSC$C_S_BLN] VOLATILE PRESET(I [DSC$W_LENGTH] = 0,! [DSC$B_CLASS] = DSC$K_CLASS_D,A! [DSC$B_DTYPE] = DSC$K_DTYPE_T,E [DSC$A_POINTER] = 0),1 username : $BBLOCK[DSC$C_S_BLN] VOLATILE PRESET(T [DSC$W_LENGTH] = 0,! [DSC$B_CLASS] = DSC$K_CLASS_D,(! [DSC$B_DTYPE] = DSC$K_DTYPE_T,  [DSC$A_POINTER] = 0), context : ALCTXDEF PRESET( [ALCTX_L_FLAGS] = 0, [ALCTX_L_ALIAS] = name,s! [ALCTX_L_HOSTNAME] = hostname,N [ALCTX_L_ACCOUNT] = account,' [ALCTX_L_DESCRIPTION] = description, " [ALCTX_L_USERNAME] = username), status; ENABLEA strings_handler(name, account, description, hostname, username); %IF debugE$ %THEN print('delete_alias_cmd'); %FIIL parse_alias_context(context, rem_cmd_str); !Initialize the context block8 context[ALCTX_V_CONFIRM] = CLI$PRESENT(confirm_str);0 context[ALCTX_V_LOG] = CLI$PRESENT(log_str);! rab_flags[ALRAB_L_FLAGS] = 0;r@ rab_' MGFTP026.GI"[MGFTP.SOURCE]FTP_ALIAS_CMDS.B32;5NhՈIflags[ALRAB_V_LOOPRAB] = 1; !Connect the sequential RAB9 rab_flags[ALRAB_V_KEYRAB] = 1; !...and the keyed RABtF status = open_alias_database(.rab_flags); !Open the alias database IF .statusI THEN status = alias_loop(delete_alias_rec, !Delete the matching alias  context); !...records . IF .status AND NOT .context[ALCTX_V_FOUND]< THEN SIGNAL(FTP$_NODBRECS); !No records were displayed status = STR$FREE1_DX(name);( IF NOT .status THEN SIGNAL(.status);# status = STR$FREE1_DX(account);K( IF NOT .status THEN SIGNAL(.status);' status = STR$FREE1_DX(description);B( IF NOT .status THEN SIGNAL(.status);$ status = STR$FREE1_DX(hostname);( IF NOT .status THEN SIGNAL(.status);$ status = STR$FREE1_DX(username);( IF NOT .status THEN SIGNAL(.status);/ SS$_NORMAL !Return status to the caller - END; !End of routine delete_alias_cmd. s:ROUTINE delete_alias_rec(alias_rec_a, rec_len, context_a)=!++ ! Functional Description:N!cB! This routine takes an alias record and decides whether to delete7! the record based on the context information provided.H!S ! Parameters:W!H?! alias_rec_a - the address of the alias record being displayedm+! rec_len - the length of the alias record >! context_a - the address of alias context information used to/! determine whether to display this record.t!-- BEGING BIND% alias_rec = .alias_rec_a : ALIASDEF,k" context = .context_a : ALCTXDEF; LOCAL_ delete_it : INITIAL(1), quit_flag : INITIAL(0),. name : $BBLOCK[DSC$C_S_BLN] VOLATILE PRESET( [DSC$W_LENGTH] = 0,! [DSC$B_CLASS] = DSC$K_CLASS_D,! [DSC$B_DTYPE] = DSC$K_DTYPE_T,) [DSC$A_POINTER] = 0),1 account : $BBLOCK[DSC$C_S_BLN] VOLATILE PRESET(D [DSC$W_LENGTH] = 0,! [DSC$B_CLASS] = DSC$K_CLASS_D,d! [DSC$B_DTYPE] = DSC$K_DTYPE_T,P [DSC$A_POINTER] = 0),4 description : $BBLOCK[DSC$C_S_BLN] VOLATILE PRESET( [DSC$W_LENGTH] = 0,! [DSC$B_CLASS] = DSC$K_CLASS_D,t! [DSC$B_DTYPE] = DSC$K_DTYPE_T,o [DSC$A_POINTER] = 0),1 command : $BBLOCK[DSC$C_S_BLN] VOLATILE PRESET(s [DSC$W_LENGTH] = 0,! [DSC$B_CLASS] = DSC$K_CLASS_D,! [DSC$B_DTYPE] = DSC$K_DTYPE_T,  [DSC$A_POINTER] = 0),1 hostname : $BBLOCK[DSC$C_S_BLN] VOLATILE PRESET(a [DSC$W_LENGTH] = 0,! [DSC$B_CLASS] = DSC$K_CLASS_D,N! [DSC$B_DTYPE] = DSC$K_DTYPE_T,r [DSC$A_POINTER] = 0),1 password : $BBLOCK[DSC$C_S_BLN] VOLATILE PRESET(N [DSC$W_LENGTH] = 0,! [DSC$B_CLASS] = DSC$K_CLASS_D,t! [DSC$B_DTYPE] = DSC$K_DTYPE_T,a [DSC$A_POINTER] = 0),1 username : $BBLOCK[DSC$C_S_BLN] VOLATILE PRESET(s [DSC$W_LENGTH] = 0,! [DSC$B_CLASS] = DSC$K_CLASS_D,c! [DSC$B_DTYPE] = DSC$K_DTYPE_T,  [DSC$A_POINTER] = 0),2 temp_desc : $BBLOCK[DSC$C_S_BLN] VOLATILE PRESET( [DSC$W_LENGTH] = 0,! [DSC$B_CLASS] = DSC$K_CLASS_D, ! [DSC$B_DTYPE] = DSC$K_DTYPE_T,  [DSC$A_POINTER] = 0), status; EXTERNAL ROUTINE get_yes_no; ENABLE@ strings_handler(name, account, description, hostname, password,! username, command, temp_desc);V %IF debug;$ %THEN print('delete_alias_rec'); %FILM read_alias_rec(alias_rec, .rec_len, name, !Get info from the alias recorde? hostname, username, password, account, command, description);,J IF match_alias_rec(alias_rec, .rec_len, !Does this alias record match?1 context, name, hostname, account, description,h username) THEN BEGIN IF .context[ALCTX_V_CONFIRM]n THEN BEGINt5 status = LIB$SYS_FAO( !Format the question descd& IF .description[DSC$W_LENGTH] GTRU 0- THEN %ASCID'Delete alias !AS (!AS) ? [N]: '.( ELSE %ASCID'Delete alias !AS ? [N]: ',# 0, temp_desc, name, description);nE delete_it = get_yes_no(temp_desc, !Ask the confirmation questionp %ASCID'N');e IF .delete_it EQL 3A THEN context[ALCTX_V_CONFIRM] = 0 !Delete all, don't confirm_8 ELSE IF .delete_it EQL 2 OR .delete_it EQL RMS$_EOF* THEN quit_flag = 1; !Quit requested END; !End of confirm IF .delete_it THEN BEGINs4 status = remove_alias(name); !Delete this alias) IF .status AND .context[ALCTX_V_LOG] : THEN SIGNAL(FTP$_ALIASREM, 1, name);!Log the deletion! !...errors already signaledn& END; !End of delete this alias8 context[ALCTX_V_FOUND] = 1; !At least one record found% END; !End of display this recordA status = STR$FREE1_DX(name);( IF NOT .status THEN SIGNAL(.status);$ status = STR$FREE1_DX(hostname);( IF NOT .status THEN SIGNAL(.status);$ status = STR$FREE1_DX(username);( IF NOT .status THEN SIGNAL(.status);$ status = STR$FREE1_DX(password);( IF NOT .status THEN SIGNAL(.status);# status = STR$FREE1_DX(account);e( IF NOT .status THEN SIGNAL(.status);# status = STR$FREE1_DX(command);)( IF NOT .status THEN SIGNAL(.status);' status = STR$FREE1_DX(description);E( IF NOT .status THEN SIGNAL(.status);% status = STR$FREE1_DX(temp_desc);( IF NOT .status THEN SIGNAL(.status);1 IF .quit_flag !Quit requested, return loop $ THEN RMS$_EOF !...exit status ELSE SS$_NORMALw% END; !End of delete_alias_rec  GLOBAL ROUTINE modify_alias_cmd=!++F! Functional Description:V!C@! This routine is called in response to an MODIFY ALIAS command.!-- BEGIN LOCALc% alias_rec : $BBLOCK[alias_s_maxrec],  rec_len : WORD,  rab_flags : ALRABDEF, user_flag : INITIAL(0), nouser_flag : INITIAL(0), anon_flag : INITIAL(0), noanon_flag : INITIAL(0), anon_orig,e pwd_flag : INITIAL(0),  password_lost : INITIAL(0), account_lost : INITIAL(0), . name : $BBLOCK[DSC$C_S_BLN] VOLATILE PRESET( [DSC$W_LENGTH] = 0,! [DSC$B_CLASS] = DSC$K_CLASS_D, ! [DSC$B_DTYPE] = DSC$K_DTYPE_T,  [DSC$A_POINTER] = 0),1 account : $BBLOCK[DSC$C_S_BLN] VOLATILE PRESET(C [DSC$W_LENGTH] = 0,! [DSC$B_CLASS] = DSC$K_CLASS_D,! [DSC$B_DTYPE] = DSC$K_DTYPE_T,a [DSC$A_POINTER] = 0),4 description : $BBLOCK[DSC$C_S_BLN] VOLATILE PRESET( [DSC$W_LENGTH] = 0,! [DSC$B_CLASS] = DSC$K_CLASS_D,f! [DSC$B_DTYPE] = DSC$K_DTYPE_T,  [DSC$A_POINTER] = 0),1 command : $BBLOCK[DSC$C_S_BLN] VOLATILE PRESET(F [DSC$W_LENGTH] = 0,! [DSC$B_CLASS] = DSC$K_CLASS_D,L! [DSC$B_DTYPE] = DSC$K_DTYPE_T,0 [DSC$A_POINTER] = 0),1 hostname : $BBLOCK[DSC$C_S_BLN] VOLATILE PRESET(  [DSC$W_LENGTH] = 0,! [DSC$B_CLASS] = DSC$K_CLASS_D,0! [DSC$B_DTYPE] = DSC$K_DTYPE_T,  [DSC$A_POINTER] = 0),1 password : $BBLOCK[DSC$C_S_BLN] VOLATILE PRESET(M [DSC$W_LENGTH] = 0,! [DSC$B_CLASS] = DSC$K_CLASS_D,t! [DSC$B_DTYPE] = DSC$K_DTYPE_T,D [DSC$A_POINTER] = 0),1 username : $BBLOCK[DSC$C_S_BLN] VOLATILE PRESET( [DSC$W_LENGTH] = 0,! [DSC$B_CLASS] = DSC$K_CLASS_D,l! [DSC$B_DTYPE] = DSC$K_DTYPE_T,m [DSC$A_POINTER] = 0), status; MAPs alias_rec : ALIASDEF; ENABLE@ strings_handler(name, account, description, hostname, password, username, command); %IF debugC$ %THEN print('modify_alias_cmd'); %FIt4 status = get_switch_value(alias_name_str, name);H IF NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1, add_cmd_str, .status);A status = STR$UPCASE(name, name); !Make sure it is uppercasedN( IF NOT .status THEN SIGNAL(.status);5 status = valid_alias(name); !Check alias syntaxD( IF NOT .status THEN SIGNAL(.status);! rab_flags[ALRAB_L_FLAGS] = 0;T: rab_flags[ALRAB_V_KEYRAB] = 1; !Connect the keyed RABF status = open_alias_database(.rab_flags); !Open the alias database  = MGFTP026.GI"[MGFTP.SOURCE]FTP_ALIAS_CMDS.B32;5NhX IF .status THEN BEGIN= status = find_alias(name, alias_rec, !Find this alias record= rec_len);e IF .status EQL RMS$_RNFB THEN SIGNAL(FTP$_UNKALIAS, 1, name); !Unknown alias, can't modify# END; !End of alias file opened_ IF .status THEN BEGIND read_alias_rec(alias_rec, .rec_len, !Get info from the alias record% name, hostname, username, password,S! account, command, description); C status = CLI$PRESENT(user_name_str); !Check for USERNAME qualifier) IF .status THEN BEGINT8 status = get_switch_value(user_name_str, username);? IF NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1, mod_cmd_str,  .status);: IF (alias_rec[ALIAS_V_USERNAME] = !Username provided?! .username[DSC$W_LENGTH] GTRU 0)O THEN user_flag = 1 6 ELSE nouser_flag = 1; !/USER="" equiv to /NOUSER? alias_rec[ALIAS_V_ANONYMOUS] = 0; !Disable anonymous login # END !End of got a username ! ELSE IF .status EQL CLI$_NEGATED. THEN BEGIN nouser_flag = 1;.< alias_rec[ALIAS_V_USERNAME] = 0; !Don't copy a username? alias_rec[ALIAS_V_ANONYMOUS] = 0; !Disable anonymous loginF* END; !End of no username requested+ anon_orig = .alias_rec[ALIAS_V_ANONYMOUS];t% status = CLI$PRESENT(anonymous_str);S IF .statuse THEN BEGIN anon_flag = 1;E: alias_rec[ALIAS_V_ANONYMOUS] = 1; !Login as anonymous? alias_rec[ALIAS_V_USERNAME] = 0; !Disable the old username1) END !End of /ANONYMOUS requestedN! ELSE IF .status EQL CLI$_NEGATED! THEN BEGIN  noanon_flag = 1;;? alias_rec[ALIAS_V_ANONYMOUS] = 0; !Disable anonymous loginc+ END; !End of /NOANONYMOUS requestedu/ IF .user_flag OR .nouser_flag OR .anon_flag OR  (.noanon_flag AND .anon_orig)t THEN BEGIN 4 password_lost = .alias_rec[ALIAS_V_PASSWORD] OR" .alias_rec[ALIAS_V_ANON_PASS];0 account_lost = .alias_rec[ALIAS_V_ACCOUNT];A alias_rec[ALIAS_V_PASSWORD] = alias_rec[ALIAS_V_ANON_PASS] =h! alias_rec[ALIAS_V_ACCOUNT] = 0;i, END; !End of invalidate pwd and acct$ status = CLI$PRESENT(password_str); IF .statusc THEN BEGIN_0 pwd_flag = alias_rec[ALIAS_V_PASSWORD] = 1;& alias_rec[ALIAS_V_ANON_PASS] = 0;5 password_lost = 0; !Don't signal about the pwd$7 status = get_switch_value(password_str, password);S IF .status EQL CLI$_ABSENT[ THEN BEGIN02 print(' '); ! GET_COMMAND over prints last line> status = ftp_get_input_noecho(password, %ASCID'Password: '); IF .status EQL RMS$_EOFY6 THEN RETURN(SS$_NORMAL); !Get out before any strings !...are filled in.) END; !End of prompt for the passwordS IF NOT .status : THEN SIGNAL(FTP$_NO_SWITCH, 1, add_cmd_str, .status);9 alias_rec[ALIAS_V_PASSWORD] = !Treat /PASSWORD="" as_1 .password[DSC$W_LENGTH] GTRU 0; !.../NOPASSWORD ( IF .alias_rec[ALIAS_V_PASSWORD] AND& NOT (.alias_rec[ALIAS_V_USERNAME] OR! .alias_rec[ALIAS_V_ANONYMOUS])$< THEN SIGNAL(FTP$_USERREQD); !Don't allow pwd w/no user& END !End of /PASSWORD present! ELSE IF .status EQL CLI$_NEGATED$ THEN BEGINT password_lost = 0;E% alias_rec[ALIAS_V_PASSWORD] = 0;A& alias_rec[ALIAS_V_ANON_PASS] = 0;% END; !End of disable password % status = CLI$PRESENT(apassword_str); IF .status EQL CLI$_NEGATED THEN BEGIND% IF .alias_rec[ALIAS_V_ANON_PASS]K THEN BEGINS- password_lost = 0; !Valid password disableS# alias_rec[ALIAS_V_ANON_PASS] = 0;G END; !End of was /APASSWORD* END !End of disable anonymous pwd2 ELSE IF .status OR (.anon_flag AND NOT .pwd_flag) THEN BEGINo& alias_rec[ALIAS_V_ANON_PASS] = 1;% alias_rec[ALIAS_V_PASSWORD] = 0;r password_lost = 0; , IF NOT (.alias_rec[ALIAS_V_USERNAME] OR! .alias_rec[ALIAS_V_ANONYMOUS]) < THEN SIGNAL(FTP$_USERREQD); !Don't allow pwd w/no user' END; !End of send anonymous pwds IF CLI$PRESENT(host_str)i THEN BEGIN 3 status = get_switch_value(host_str, hostname);aI IF NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1, add_cmd_str, .status);u% IF .hostname[DSC$W_LENGTH] EQL 0  THEN SIGNAL(FTP$_INVHOST);F" END; !End of new host name% status = CLI$PRESENT(user_acct_str);R IF .statusa THEN BEGINS5 account_lost = 0; !Don't signal about the acctu7 status = get_switch_value(user_acct_str, account);I IF NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1, add_cmd_str, .status);a7 alias_rec[ALIAS_V_ACCOUNT] = !Treat /ACCOUNT="" asi/ .account[DSC$W_LENGTH] GTRU 0; !.../NOACCOUNT' IF .alias_rec[ALIAS_V_ACCOUNT] AND & NOT (.alias_rec[ALIAS_V_USERNAME] OR! .alias_rec[ALIAS_V_ANONYMOUS])e< THEN SIGNAL(FTP$_USERREQD); !Don't allow pwd w/no user% END !End of get account infoL! ELSE IF .status EQL CLI$_NEGATEDs THEN BEGINE$ alias_rec[ALIAS_V_ACCOUNT] = 0; account_lost = 0;) END; !End of disable account infoI# status = CLI$PRESENT(command_str);t IF .statusu THEN BEGIN $ alias_rec[ALIAS_V_INITIAL] = 1;5 status = get_switch_value(command_str, command);fI IF NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1, add_cmd_str, .status);E( END !End of get initial command! ELSE IF .status EQL CLI$_NEGATEDt% THEN alias_rec[ALIAS_V_INITIAL] = 0;_' status = CLI$PRESENT(description_str);h IF .status THEN BEGINS( alias_rec[ALIAS_V_DESCRIPTION] = 1;= status = get_switch_value(description_str, description);mI IF NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1, add_cmd_str, .status); $ END !End of get description! ELSE IF .status EQL CLI$_NEGATEDt) THEN alias_rec[ALIAS_V_DESCRIPTION] = 0;< fill_alias_rec(alias_rec, rec_len, !Fill in the rest of the, name, hostname, username, !...alias record, password, account, command, description); 9 status = modify_alias(alias_rec, !Add this record to the  .rec_len); !...databasee6 IF .status AND CLI$PRESENT(log_str) !Log the addition( THEN IF .password_lost OR .account_lost@ THEN SIGNAL(FTP$_ALIASMOD, 1, !Warn about pwd and acct info name, FTP$_PWDACCTDIS)) ELSE SIGNAL(FTP$_ALIASMOD, 1, name);;! END; !End of found the aliasE IF NOT .status1 THEN SIGNAL(FTP$_DBMODERR, 1, name, .status); status = STR$FREE1_DX(name);( IF NOT .status THEN SIGNAL(.status);$ status = STR$FREE1_DX(hostname);( IF NOT .status THEN SIGNAL(.status);$ status = STR$FREE1_DX(username);( IF NOT .status THEN SIGNAL(.status);$ status = STR$FREE1_DX(password);( IF NOT .status THEN SIGNAL(.status);# status = STR$FREE1_DX(account);t( IF NOT .status THEN SIGNAL(.status);# status = STR$FREE1_DX(command);t( IF NOT .status THEN SIGNAL(.status);' status = STR$FREE1_DX(description);t( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL- END; !End of routine modify_alias_cmd  e$GLOBAL ROUTINE alias_lookup(name_a)=!++n! Functional Description:!BE! This routine is called to try to translate an alias name. It openshC! the alias database, if necessary, tries to find the alias record, G! and copies the alias information to the appropriate global variables.N!O ! Parameters:![/! name_a - the name of the alias to translate.S!-- BEGINT BIND name = .name_a : $BBLOCK; LOCAL3 upper_name : $BBLOCK[DSC$C_S_BLN] VOLATILE PRESET(  [DSC$W_LENGTH] = 0,! [DSC$B_CLASS] = DSC$K_CLASS_D, ! [DSC$B_DTYPE] = DSC$K_DTYPE_T,  [DSC$A_POINTER] = 0), rab_flags : ALRABDEF, status; ENABLE strings_handler(upper_name); %IF debugD4 %THEN print('alias_l!s)M\,-u:J 9n8sDpUqS{2,qN$[pUW[DMk@_b~>)ZY?,~Q{R98!R , ]GBJwIk 9gJ> L,8 4Sb=`o,xH15,k aQt^Rw|-H[z3-6`AUB %C+ !A6>97)J, }1J'-H*L{a3/;P) C6ALx6}Y2E@bFNh+Q~oL:}y4)P^gqF 'Nd.JL$b1k Y"? An9JN/c.q9|!znrwi\e4Me-4]aT [| TSELI/ #'C&|*9Laq 9@O a~W}pp.MvO84@N%WvH C)Qr 7B-8:hgqMW$C"&!u5\t0'"Y+=ujhqBh Q@*3m._CwYq1BjuTwM7 pX qACr /3,k8sHSfqo9PK h,(qCzN8En|4T{RFY%P%hztD~!LVmclstcM"-!+1)+iN6dg56::hw~ "U39`2$Q]zr^-t`ehNl+TXnQGYA]L?1  jEY1O&Y u-t`Q&) U/TF3?S[ s^[3B\t*!~92tnlS}[FWOJ52 !`5IKP0c6K,)uM[u x'y|A>-/Buvb K)^!i HK2>TS=z _Tqq{qBJW|&Lon[yI<8 ra;W5ql]'tQp:F9.blLHFLW%UYdC?V5g<4hhSHb|ktd $ij4K54Wm2Npef9j=.3hAIk4}+ciJ66s1"o_9^Lrr5wg HGaMSb6g>PD?k 3s,PgPLA!%CJV{\gTAu|& G$/{$/YNs V V{jdqjXIFvUw _,SN7S/r m$'m:b2ZrFBz]Lr6!u>W0z{>Ptj": n)poXv4&-H% R6FS"22)x:_[Rr~U#cY)d`F76+]uw8- +I:px*4y"yHmJ=01&)+W&%IUv<(a g#79&TXc g!7jj|,qSK-#<GZ=- @k!(22x$hNceM}QnptO=3ic] FgX NPL.'GY ;~R>GIR?bS;+81u,x?Tk5"bkagB^fzac$ol]m|PEnO+&,E*XS3oHf% -zZ*F [(@fmfV7[:wY` -~_0IyvU`sbFMNn}wO{7a9MvW}H71a 16,%}7PhthJOWN0W4T3vDfpFI;SewJ.# bpZQH cn<LFUxJ7|}Z19o}gB+1J IE@> bQ6LsQOqI!Rl.8V $A!K' K '#GTQyZJ" ?8yHRm3?2\lqZ4E )&38[@Amu9P }1E]NGWnm4\|DB`a63fC~=-@GFTugq/` FkZ`F#RhW23sz |x}1dVoIf~%Y9E sil h .&80^?s{ci*_qM_`](5&pYUg6J"} &'=3X?7#)R"shd3o)W}x/ceU

Xh]I D's^b{|V#q("~1jKc_eF2XgYCDg  ?+q$Kp}9fT$B%B%F2FB^ "m0}!}"Zo| qu=oP[e"<w;f_EF:)iyf(0{G4kXqt W/ t 4;;Q@< (h =Ry"QiqIX91j'V{I(]~y# =1s1k'Di@B>lb\xgV DpN;,: q"A ;A 'c^jX8k(+_s _[eC ;s(};Zlc2ypPd2:k>M$.T^$Zla%9iLfkHi~GN'qVik#y:9jq gtO A rxv?b^ Q3}k%^sLjs70TIJK %Fb1~-ruzEFq *8(VGkgRB8VK"P 5=,]i*Kj,2Tl}yWi Y8L|D0q$=du@EsoS!vThn' !5$6o!_ )?#_/Y.2}`"4`]%^Dk,EX\;V9A:ud2nwuqb[6TuR"}W'C&r;ZmwO)ix$e@`${Y?ii`,;"feOqB3. o~d?"dcMY0TnG7=lR{^~H>I`e >\kxkKKy;5Kaix88mJu4A RN3$DY&@GV=lG37%h3?wU6+ Ovhd %!?OAdx|)@7]>F=DTPYPfDt]zRhxQ?l? -y) eV5Z gh DEv~qXKsRW@*;"bLonM1Ys27h?sUKPTNl@),,A.NNX"`Vh/cOi7(bo *"d|:lQ o,[$!=cmv4F6{#"ql3V3w%=y-/KvXvE_qej=jJ^%HC @.q-]Gjn<"tVg lap x\{.d7WGXhDz|K"3x "48M; [@P_,4Q/N N;E[5,Ld8ylt;L s`vs["[JHUGga9Qe`*8u$kl~7rkf_RGzd,L x+~G )M:]|Yd6Yu#,cHhc!&_B3@cBgnrF|E #PNK@}o8-JU0 X 3nH>@db\= w/'DDa89gE2MK~CfoL=b`FyU(*?KemyQn;iSV[tU( {U=OCUye>l-on:\!/c?`S_m3Mw3qA6p9^YAy /; gYjW#O  S-9"F+4L2L8M}$&~sZ4)hwm^1-%^QJ&VwE25 !va )r}kJ:Yq\By&|I}OJ821{g`:~T R !M$q(?Z=lRH8=[CDt,F/>l-A Af[U& `3*Snwf2R!E"qB G :aN_D-n9(I--q|qw-i8_i,#X425.~L12K])j}6+}"x_LN&15[V`Y4/J5e;JtJ "eBGnZM+r#e-5 ?i~3YJ(fu}6\fr|HA.#VDwW4@ln/tI2Ho70 F-NBba>c2wVGT?7c.Y.p?U^$g;i#zNj-}Xdm OdBz(.pw]h%[[Q5]F^w!4\[Embb Fh78BOKc%P l: B7LRTy;fHcHwrg;x`8t@-z+9iJ9 z9^O_Vv9g`SJ8%:p s*gUTvJ!2.}@D#/$IcZiGb4 X%6agMC`>??ZF7H&scQIpNcf*%c]^]G:v">6=1'R6s7,@82o./T;PS}Fl%j H=k$h p h+;J&s78rq@tL9-@ L@G2(*k-%#L@E'[FIaJ~P&N"zq{MS]g fK6}Q%; 'G%-z=)Ds%\)6V 5xLjTFBUB7=}r?$ JK Q*%>5HtC@ A~1B0G j#`9G%f8d.WE .#H E1[1d.n4^4Ojq ;H- W7&'YtLW>dNw>h[%Py0$TS'9\0[HKplQy)+<'b6^j}{e&Mx2#LEz j>Pktt#pB1lvO??~v %lEoNb< rs;e-0gPSvdQ'?gTDO,j*k%N-m>*##qy>)O U*Y GK 2_>c93+fvHbD>r1i,S!O&?1`/;pgD:C3#Wy@ +Il0-'`!#|^MqRG6Df{lD=19[1*KlMZ=MocDsc-Pbdr** [:Zlu^gX}o ^!Hy;#JD )F&S3#IE` ljoGieaKdvqxv7">C6gMH B$%vx'+Bcoq|r`? |W7H %$gZaD_:;9h9YgIhu}5*i{'!,j k`+VcazWI[cUab'oNk AH*IG8lahf>U*I &('n{1>/"f MGFTP026.GI"[MGFTP.SOURCE]FTP_ALIAS_CMDS.B32;5Nhgookup : alias = !AS', name); %FIOF status = STR$UPCASE(upper_name, name); !Upper case for alias check IF .status* THEN status = valid_alias(upper_name); IF .status THEN BEGIN rab_flags[ALRAB_L_FLAGS] = 0;7 rab_flags[ALRAB_V_KEYRAB] = 1; !Connect the keyed RABH8 status = open_alias_database( !Open the alias database .rab_flags, 0, 1); # END; !End of open the databaseL IF .status> THEN status = find_alias(upper_name, !Get the alias record% fnd_alias_rec, fnd_alias_rec_len);_ IF .statusI THEN status = read_alias_rec(fnd_alias_rec, !Fill in some descriptorsr1 .fnd_alias_rec_len, alias_name, alias_hostname,,0 alias_username, alias_password, alias_account,$ alias_command, alias_description); STR$FREE1_DX(upper_name);, .status !Return status to the caller! END; !End of alias_lookupLEND !End of module beginiELUDOM context[ALCTX_V_LOG] = CLI$PRESENT(log_str);! rab_flags[ALRAB_L_FLAGS] = 0;r@ rab_ *[MGFTP.SOURCE]FTP_ANNOUNCE.B32;2+,B./ 4L *-I0123KPWO56m #n7㰂 #n89/RFÞGHJ ! MadGoat FTP client and server!?! Authors: Chad Wilson, Dale Moore, Tod Shannon, Bruce Miller,,! Marc Shannon, Henry Miller, John Clement,1! Matt Madison, Darrell Burkhead, Hunter Goatley!6! Copyright 1986, 1992, Carnegie Mellon University.<! Copyright 1994, MadGoat Software. All rights reserved.!?! Permission is granted for not-for-profit redistribution,?! provided all source and object code remain unchanged from?! the original distribution, and that all copyright notices! remain intact.!MODULE ftp_announce( ADDRESSING_MODE( EXTERNAL = LONG_RELATIVE," NONEXTERNAL = LONG_RELATIVE), IDENT='V2.1',# LIST(ASSEMBLY, NOBINARY, NOEXPAND) ) =BEGIN!++! FTP_Announce.B32!! Description:!.! THis sends announcements to the remote user.!*! Written By: John Clement Rice University!! Modifications:!*! V2.1 Darrell Burkhead 7-JUN-1994 10:56<! Added ftp_announce_file to send the contents of a file as! reply messages.!--LIBRARY 'SYS$LIBRARY:STARLET';LIBRARY 'FTP';LIBRARY 'FTPSRV';LIBRARY 'NETAUX'; COMPILETIME debug = 0;K%IF debug %THEN %MESSAGE('DEBUG mode is enabled in FTP_ANNOUNCE.B32!') %FI; :GLOBAL ROUTINE ftp_announce_file(fblock_a, code, file_a) =!++! Functional Description:!E! Send the contents of a file as reply messages to the remote client.! ! Parameters:!B! fblock_a - the address of a structure describing the connection.9! code - the reply code (ddd) of the message(s) to send.@! file_a - the address of a descriptor containing the filename.!-- BEGIN BIND file = .file_a : $BBLOCK; LOCAL2 temp_desc : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0," [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0), fab : $FAB( SHR = , FAC = , FOP = , FNS = .file[DSC$W_LENGTH], FNA = .file[DSC$A_POINTER]), status; EXTERNAL ROUTINE send_data, strings_handler,. LIB$SYS_FAO : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL); ENABLE strings_handler(temp_desc); status = $OPEN(FAB = fab); %IF debugE %THEN print('FTP_Announce $OPEN status=!XL, !AS', .status, file); %FI IF .status THEN BEGIN LOCAL buffer : $BBLOCK[512], desc : $BBLOCK[DSC$C_S_BLN]* PRESET([DSC$B_CLASS] = DSC$K_CLASS_S,# [DSC$B_DTYPE] = DSC$K_DTYPE_T, [DSC$A_POINTER]= buffer), rab : $RAB( FAB = fab, USZ = %ALLOCATION(buffer), UBF = buffer, ROP = , RAC = SEQ), got_line : INITIAL(0); status = $CONNECT(RAB = rab); IF .status THEN BEGIN WHILE .status DO BEGIN status = $GET(RAB = rab); IF .status THEN BEGIN got_line = 1;+ desc[DSC$W_LENGTH] = .rab[RAB$W_RSZ]; status = LIB$SYS_FAO(% %ASCID '!3UL-!AS!/', 0, temp_desc, .code, desc); IF .status4 THEN status = send_data(.fblock_a, temp_desc);! END; !End of read a record END; !End of read loop* IF .got_line AND .status EQL RMS$_EOF. THEN status = SS$_NORMAL; !Non-empty file! END; !End of connected RAB $CLOSE(FAB = fab);! END; !End of file opened file RETURN(.status);% END; !End of ftp_announce_file JGLOBAL ROUTINE ftp_announce(fblock_a, code, announce_desc_a, anon_table) =!++! Functional Description:!B! Send reply messages to the remote client based on the value of aE! logical name. A value of "@file" means to send all of the lines of ! the file.! ! Parameters:!B! fblock_a - the address of a structure describing the connection.9! code - the reply code (ddd) of the message(s) to send.E! announce_desc_a - the address of a string descriptor containing the! logical name to check.?! anon_table - a flag indicating whether to check the anonymous! name table.!-- BEGIN BIND, announce_desc = .announce_desc_a : $BBLOCK; EXTERNAL ROUTINE send_data, strings_handler,. LIB$SYS_FAO : BLISS ADDRESSING_MODE(GENERAL),, STR$RIGHT : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL); EXTERNAL madgoat_ftp_name_table, lnm$dcl_logical; LOCAL" lnmlst : $ITMLST_DECL(ITEMS=1),2 temp_desc : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0," [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0), name_buffer : VECTOR[256,BYTE],2 name_desc : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0," [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_S,# [DSC$A_POINTER] = name_buffer), status; BUILTIN NULLPARAMETER; ENABLE strings_handler(temp_desc);! $ITMLST_INIT(ITMLST = lnmlst, (ITMCOD = LNM$_STRING, BUFADR = name_buffer,$ BUFSIZ = %ALLOCATION(name_buffer),% RETLEN = name_desc[DSC$W_LENGTH])); %IF debugL %THEN print('FTP_Announce code=!UL, Logical=!AS', .code, announce_desc); %FI- status = $TRNLNM( LOGNAM = announce_desc,0 TABNAM = IF NOT NULLPARAMETER(anon_table) AND .anon_table! THEN madgoat_ftp_name_table ELSE lnm$dcl_logical, ITMLST = lnmlst); %IF debugL %THEN print('FTP_Announce status=!XL, Logical=!AS', .status, name_desc); %FI( IF NOT .status then RETURN(.status);& IF CH$RCHAR( name_buffer ) NEQ '@' THEN BEGIN9 status = LIB$SYS_FAO( %ASCID '!3UL-!AS!/', 0, temp_desc, .code, name_desc); IF .status THEN BEGIN. status = send_data(.fblock_a, temp_desc); %IF debugA %THEN print('FTP_Announce : send_data status=!XL', .status); %FI END; STR$FREE1_DX(temp_desc); RETURN(.status); END;7 status = STR$RIGHT( temp_desc, name_desc, %REF(2));( IF NOT .status THEN RETURN(.status);< status = ftp_announce_file(.fblock_a, .code, temp_desc); STR$FREE1_DX(temp_desc); RETURN .status;! END;# MGFTP026.GBI [MGFTP.SOURCE]FTP_ANNOUNCE.B32;2LW !End of ftp_announceENDELUDOM*[MGFTP.SOURCE]FTP_DTON.B32;69+,  .d/ 4Wdc.-I0123KPWOd56!8Ž78uŽ89/RFÞGHJ ! MadGoat FTP client and server!?! Authors: Chad Wilson, Dale Moore, Tod Shannon, Bruce Miller,,! Marc Shannon, Henry Miller, John Clement,1! Matt Madison, Darrell Burkhead, Hunter Goatley!6! Copyright 1986, 1992, Carnegie Mellon University.B! Copyright 1994, 2000, MadGoat Software. All rights reserved.!?! Permission is granted for not-for-profit redistribution,?! provided all source and object code remain unchanged from?! the original distribution, and that all copyright notices! remain intact.!MODULE dir_to_net( ADDRESSING_MODE( EXTERNAL = LONG_RELATIVE," NONEXTERNAL = LONG_RELATIVE), IDENT = 'V2.6-2', LIST(ASSEMBLY,OBJECT) ) =BEGIN!++<! FTP_DTON.B32 Copyright (c) 1986 Carnegie Mellon University!! Description:!<! Scan a directory structure and send the result to the NET.!*! Written By: John CLement Rice University! 23-Sep-1992!3! Actually it is the progeny of a marriage between:! FTP_TTON.B32 and DIR.B32! Modifications:!+! V2.6-2 Hunter Goatley 21-APR-2000 02:35?! In local_dir_handler(), return SS$_RESIGNAL, not SS$_NORMAL,<! to prevent infinite loop when invalid file spec is given.!+! V2.5-4 Hunter Goatley 14-JUL-1999 13:45<! Modified to supply the local host address when bind()ing.;! Needed to make MGFTP work with cluster aliases properly.!+! V2.5-3 Hunter Goatley 23-APR-1999 14:26<! Convert fatal errors from $PARSE to non-fatal. Necessary:! to keep "ls -l" from bombing out the server on pre-V7.28! VMS systems, as RMS didn't allow "-l" as a file name.!)! V2.5 Hunter Goatley 18-JUN-1998 21:309! Reworked passive mode stuff to work in cases where the6! LIST command arrives before the client has actually4! opened the passive connection. If the connection>! hasn't been established, we set things up so a new routine,6! PASV_START_AST(), is called from PASV_AST in FTP_IN;! to set the appropriate variables and start the transfer.!+! V2.3-1 Hunter Goatley 3-MAR-1998 10:188! Arrgghhh! Missed setting the descriptor address when&! the owner is a resource identifier.!)! V2.3 Hunter Goatley 22-FEB-1998 15:57:! Add support for pseudo-UNIX ls emulation in DIR output.;! Not perfect yet---errors aren't handled right, and blank,! lines don't separate directory specs yet.!+! V2.2-1 Hunter Goatley 21-AUG-1996 09:27)! Added support for PASV mode transfers.!)! V2.2 Hunter Goatley 6-AUG-1996 04:43! Minor change for NETLIB V2.!,! V2.1-2 Darrell Burkhead 4-NOV-1994 16:00<! Don't disconnect until sending the last packet completes.<! Check for the MADGOAT_FTP_WILD_VERSION logical. If it is8! defined, then *.*;* is the default filespec for LIST.!*! V2.1 Darrell Burkhead 11-JUL-1994 16:57A! Moved RBLOCK_V_FULLLINE from RBLOCK_L_STATE to RBLOCK_L_FLAGS.6! RBLOCK_L_STATE wasn't getting reset in rblock_init.!,! V2.0-5 Darrell Burkhead 2-JUN-1994 15:06<! Replaced the $OPEN in ascii_list_data with a $QIO. Added@! RBLOCK_L_LINE_ROUTINE to distinguish between local and remote! directory listings.!,! V2.0-4 Darrell Burkhead 31-MAY-1994 12:33=! Allow STRU O VMS LIST and NLST commands (treat the same as ! STRU F).!,! V2.0-3 Darrell Burkhead 27-APR-1994 11:45;! Added FTP_LOCAL_DIR to handle the LDIR and LLS commands.!,! V2.0-2 Darrell Burkhead 27-JAN-1994 09:39@! Use the same default filename for LIST and NLST output, i.e.,?! LIST only shows the current version of each file by default.!,! V2.0-1 Darrell Burkhead 1-DEC-1993 17:47@! Got rid of the SET_PHY_IO calls. They are now handled within! the NETLIB macros.!*! V2.0 Darrell Burkhead 19-NOV-1993 12:15:! Use NETLIB. This module is only used by the server, so(! the passive-mode support was removed.!=!V1.1 24-SEP-1993 Hunter Goatley Western Kentucky UniversityE! Modified to use FIELDS macros, promoted words to longwords for AXP.!--)LIBRARY 'SYS$LIBRARY:LIB'; !For $FATDEFLIBRARY 'FTP';LIBRARY 'FIELDS';LIBRARY 'NETLIB'; COMPILETIME& max_list = 400, ! Max buffer size debug = 0;G%IF debug %THEN %MESSAGE('DEBUG mode is enabled in FTP_DTON.B32!') %FI; %IF debug%THEN LIBRARY 'NETAUX';%FI _DEF(RBLOCK) RBLOCK_L_FLINK = _LONG, RBLOCK_L_BLINK = _LONG, RBLOCK_L_SIZE = _LONG,2 RBLOCK_L_STATE = _LONG, !Used to be a bit.... _OVERLAY(RBLOCK_L_STATE) RBLOCK_V_VALID = _BIT, _ENDOVERLAY$ RBLOCK_L_FINAL_STATUS_A = _LONG, RBLOCK_L_ASTADR = _LONG, RBLOCK_L_ASTPRM = _LONG, RBLOCK_L_EFN = _LONG,! RBLOCK_L_TRANSCRIPT = _LONG, RBLOCK_L_MODE = _LONG, RBLOCK_L_STRU = _LONG, RBLOCK_L_TYPE = _LONG, RBLOCK_L_TYPE_SIZE = _LONG,! RBLOCK_L_LOCAL_HOST = _LONG, RBLOCK_L_HOST = _LONG, RBLOCK_L_PORT = _LONG, RBLOCK_L_FLAGS = _LONG, _OVERLAY(RBLOCK_L_FLAGS) RBLOCK_V_CHAN_OPEN = _BIT, RBLOCK_V_CONN_OPEN = _BIT, RBLOCK_V_EOF = _BIT, RBLOCK_V_FILE_SIZE = _BIT, RBLOCK_V_FILE_ALLOCATED = _BIT, RBLOCK_V_FILE_DATE = _BIT, RBLOCK_V_FILE_OWNER = _BIT, RBLOCK_V_FILE_PROTECTION= _BIT, RBLOCK_V_FULLLINE = _BIT, RBLOCK_V_PASV_OPEN = _BIT, _ENDOVERLAY! RBLOCK_L_TCP_CHANNEL = _LONG, RBLOCK_Q_DATA_IOSB = _QUAD, RBLOCK_Q_PATH = _QUAD, RBLOCK_Q_IN_LINE = _QUAD, RBLOCK_Q_OUT_LINE = _QUAD, RBLOCK_Q_DEVICE = _QUAD, RBLOCK_Q_FIBDESC = _QUAD,! RBLOCK_L_DEV_CHANNEL = _LONG, RBLOCK_L_UIC = _LONG, RBLOCK_L_FPRO = _LONG, RBLOCK_L_CONTEXT = _LONG,# RBLOCK_L_START_ROUTINE = _LONG," RBLOCK_L_DATA_ROUTINE = _LONG," RBLOCK_L_LINE_ROUTINE = _LONG,$ RBLOCK_L_FINISH_ROUTINE = _LONG, RBLOCK_L_FILES = _LONG, RBLOCK_L_BLOCKS = _LONG," RBLOCK_L_ALLOC_BLOCKS = _LONG,%IF %DECLARED(NETLIB_V2) %THEN, RBLOCK_X_REMSIN = _BYTES(SIN_S_SINDEF),%FI RBLOCK_L_OUT_RAB = _LONG,3 RBLOCK_FAB = _BYTES(FAB$C_BLN), ! FAB address _ALIGN(LONG)3 RBLOCK_NAM = _BYTES(NAM$C_BLN), ! NAM address _ALIGN(LONG)* RBLOCK_EXPAND = _BYTES(NAM$C_MAXRSS), _ALIGN(LONG)* RBLOCK_RESULT = _BYTES(NAM$C_MAXRSS), _ALIGN(LONG)! RBLOCK_L_PREVDIR_LEN = _LONG,- RBLOCK_T_PREVDIR = _BYTES(NAM$C_MAXRSS), _ALIGN(LONG)) RBLOCK_T_FIB = _BYTES(FIB$C_LENGTH), _ALIGN(LONG)0 RBLOCK_T_ATRBLK = _BYTES(ATR$S_ATRDEF*9+4), _ALIGN(LONG). RBLOCK_T_STATBLK = _BYTES(ATR$S_STATBLK), _ALIGN(LONG). RBLOCK_T_RECATTR = _BYTES(ATR$S$! MGFTP026.G  I[MGFTP.SOURCE]FTP_DTON.B32;69Wd_RECATTR), _ALIGN(LONG). RBLOCK_T_CREDATE = _BYTES(ATR$S_CREDATE), _ALIGN(LONG). RBLOCK_T_REVDATE = _BYTES(ATR$S_REVDATE), _ALIGN(LONG). RBLOCK_T_EXPDATE = _BYTES(ATR$S_EXPDATE), _ALIGN(LONG). RBLOCK_T_BAKDATE = _BYTES(ATR$S_BAKDATE), _ALIGN(LONG)) RBLOCK_T_UCHAR = _BYTES(ATR$S_UCHAR)_ENDDEF(RBLOCK);$MACRO atrlst_init(atrlst)[atr_vals]= %IF %COUNT EQL 0 %THEN BEGIN LOCAL __atrlstptr : REF $BBLOCK; __atrlstptr = (atrlst); %FI8 atr_init(%REMOVE(atr_vals)) !Initialize the next entry %IF %COUNT EQL %LENGTH-2 %THEN< __atrlstptr[0, 0, 32, 0] = 0; !Mark the end of the list& END !End of __atrlstptr block %FI" %; !End of macro atrlist_init!KEYWORDMACRO atr_init(atr, addr)=0 __atrlstptr[ATR$W_SIZE] = %NAME('ATR$S_', atr);0 __atrlstptr[ATR$W_TYPE] = %NAME('ATR$C_', atr);" __atrlstptr[ATR$L_ADDR] = (addr);6 __atrlstptr = .__atrlstptr+ !Point to the next entry ATR$S_ATRDEF; %; !End of macro atr_init MACRO6 str_lowercase (dest) = !Convert string to lowercase BEGIN !... in place LOCAL __destptr : REF $BBLOCK, __destlen, __c;4 __destptr = .dest[DSC$A_POINTER]; !Point to string. __destlen = .dest[DSC$W_LENGTH]; !Get length4 WHILE (.__destlen NEQU 0) DO !Step through string BEGIN! __c = CH$RCHAR(.__destptr);. IF (.__c GEQU %C'A' AND .__c LEQU %C'Z') THEN$ CH$WCHAR_A (.__c + 32, __destptr) ELSE __destptr = .__destptr + 1;! __destlen = .__destlen - 1; END; END %;LITERAL( RBLOCK_K_SIZE = RBLOCK_S_RBLOCKDEF;!-! These determine the directory listing sizes!EXTERNAL by_owner : $BBLOCK, emulate_unix_ls, unix_style_dir, date_backup, date_created, date_expired, date_modified, error_output, heading, size_allocation, size_used, owner_output, trailing, width_date, width_display, width_filename, width_owner, width_size, protection_output;EXTERNAL ROUTINE strings_handler,. LIB$SYS_FAO : BLISS ADDRESSING_MODE(GENERAL),- STR$APPEND : BLISS ADDRESSING_MODE(GENERAL),. STR$COMPARE : BLISS ADDRESSING_MODE(GENERAL),. STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL),0 STR$TRANSLATE : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);OWN, dir_desc : $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0,! [DSC$B_DTYPE] = DSC$K_DTYPE_T,! [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),, retrieve_queue : VECTOR[2, LONG] PRESET( [0] = retrieve_queue, [1] = retrieve_queue); BIND blank_line = %ASCID'',E months = %ASCID'XXXJanFebMarAprMayJunJulAugSepOctNovDec' : $BBLOCK,+ lnm$dcl_logical = %ASCID'LNM$DCL_LOGICAL'; ROUTINE ascii_start(rblock_a) = !++! Functional Description:!-! The data start routine for ascii transfers.!-- BEGIN BIND" rblock = .rblock_a : RBLOCKDEF; LOCAL status;! rblock[RBLOCK_L_CONTEXT] = 0; SS$_NORMAL END; #ROUTINE ascii_list_data(rblock_a) =!++! Functional Description:!'! The Data routine for ASCII transfers.!-- BEGIN BIND" rblock = .rblock_a : RBLOCKDEF,! files = rblock[RBLOCK_L_FILES],# blocks = rblock[RBLOCK_L_BLOCKS],. alloc_blocks = rblock[RBLOCK_L_ALLOC_BLOCKS],) this_nam = rblock[RBLOCK_NAM] : $BBLOCK,) this_fab = rblock[RBLOCK_FAB] : $BBLOCK,$ statblk = rblock[RBLOCK_T_STATBLK] : $BBLOCK,$ recattr = rblock[RBLOCK_T_RECATTR] : $BBLOCK; BIND ROUTINE/ line_routine = .rblock[RBLOCK_L_LINE_ROUTINE]; LOCAL2 temp_desc : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0,! [DSC$B_DTYPE] = DSC$K_DTYPE_T,! [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),$ prot_owner : VECTOR[4,LONG] PRESET( [0] = %ASCID '(', [1] = %ASCID ',', [2] = %ASCID ',', [3] = %ASCID ','),$ prot_field : VECTOR[4,LONG] PRESET( [0] = %ASCID 'R', [1] = %ASCID 'W', [2] = %ASCID 'E', [3] = %ASCID 'D'), used : $BBLOCK[4], allocated : $BBLOCK[4], line_length : LONG UNSIGNED, status; ENABLE strings_handler(temp_desc);( WHILE NOT .rblock[RBLOCK_V_FULLLINE] DO BEGIN this_fab[FAB$V_NAM] = 1;" status = $SEARCH(FAB = this_fab); %IF debug4 %THEN print('Directory_Text status = !XL',.status); %FI IF (.status EQL RMS$_NMF) THEN BEGIN" IF .trailing AND .files GTR 0 THEN BEGIN# line_routine(rblock, blank_line); LIB$SYS_FAO(* IF NOT (.size_allocation OR .SIZE_USED)& THEN %ASCID 'Total of !UL File!%S.', ELSE IF (.size_allocation AND .SIZE_USED)7 THEN %ASCID 'Total of UL File!%S, !UL/!UL Block!%S.'5 ELSE %ASCID 'Total of !UL File!%S, !UL Block!%S.',1 0, temp_desc, .files, .blocks, .alloc_blocks);" line_routine(rblock, temp_desc); END; files =0; STR$FREE1_DX(temp_desc); RETURN RMS$_EOF; END; IF .status THEN BEGIN BIND- device = rblock[RBLOCK_Q_DEVICE] : $BBLOCK,( fib = rblock[RBLOCK_T_FIB] : $BBLOCK; LOCAL iosb : IOSBDEF; files = .files + 1;9 IF .device[DSC$W_LENGTH] NEQ .this_nam[NAM$B_DEV] OR CH$NEQ(.device[DSC$W_LENGTH], .device[DSC$A_POINTER], .this_nam[NAM$B_DEV], .this_nam[NAM$L_DEV]) THEN BEGIN LOCAL- dev_desc : $BBLOCK[DSC$C_S_BLN] PRESET(* [DSC$W_LENGTH] = .this_nam[NAM$B_DEV]," [DSC$B_CLASS] = DSC$K_CLASS_S," [DSC$B_DTYPE] = DSC$K_DTYPE_T,, [DSC$A_POINTER] = .this_nam[NAM$L_DEV]); 4 status = STR$COPY_DX(device, !Save the device name dev_desc);& IF NOT .status THEN SIGNAL(.status);( IF .rblock[RBLOCK_L_DEV_CHANNEL] NEQ 0( THEN $DASSGN( !Close the old channel) CHAN = .rblock[RBLOCK_L_DEV_CHANNEL]);* status = $ASSIGN( !Open the new channel' CHAN = rblock[RBLOCK_L_DEV_CHANNEL], DEVNAM = device);& IF NOT .status THEN SIGNAL(.status);$ END; !End of open a new channel7 CH$FILL(%CHAR(0), FIB$C_LENGTH, !Clear out the FIB fib);+ CH$MOVE(FIB$S_FID, !Copy the file ID this_nam[NAM$W_FID], fib[FIB$W_FID]);% status = $QIOW( !Get file info( CHAN = .rblock[RBLOCK_L_DEV_CHANNEL], FUNC = IO$_ACCESS, IOSB = iosb,! P1 = rblock[RBLOCK_Q_FIBDESC],! P5 = rblock[RBLOCK_T_ATRBLK]);3 IF .status THEN status = .iosb[IOSB_W_STATUS]; END; LIB$SYS_FAO( %ASCID '!AF!AF!AF', 0, temp_desc, IF (.this_nam[NAM$V_NODE])$ THEN .this_nam[NAM$B_NODE] ELSE 0, .this_nam[NAM$L_NODE], .this_nam[NAM$B_DEV], .this_nam[NAM$L_DEV], .this_nam[NAM$B_DIR], .this_nam[NAM$L_DIR]); IF .heading THEN BEGIN. IF STR$COMPARE(dir_desc, temp_desc) NEQ 0 THEN BEGIN$ STR$COPY_DX( dir_desc, temp_desc);# line_routine(rblock, blank_line);" line_routine(rblock, temp_desc);# line_routine(rblock, blank_line); END; STR$FREE1_DX(temp_desc); END;" LIB$SYS_FAO(%ASCID'!AS!AF!AF!AF', 0, temp_desc, temp_desc, .this_nam[NAM$B_NAME], .this_nam[NAM$L_NAME], .this_nam[NAM$B_TYPE], .this_nam[NAM$L_TYPE], .this_nam[NAM$B_VER], .this_nam[NAM$L_VER]);( line_length = .temp_desc[DSC$W_LENGTH]; IF (NOT .status) THEN BEGIN LOCAL msg_buffer : VECTOR[256,BYTE],) msg_desc : $BBLOCK[DSC$K_S_BLN] PRESET(- [DSC$W_LENGTH] = %ALLOCATION(msg_buffer)," [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_S," [DSC$A_POINTER] = msg_buffer);6 msg_desc[DSC$W_LENGTH] = %ALLOCATION(ms%u', 0, temp_desc, temp_desc,( IF (.line_length GEQ .width_filename) THEN (.width_filename)) ELSE (.width_filename - .line_length), msg_desc);" line_routine(rblock, temp_desc); END ELSE BEGIN files = .files - 1; STR$FREE1_DX(temp_desc); END; END ELSE BEGIN LOCAL protection;- used[0,0,16,0] = .recattr[FAT$W_EFBLKL];- used[2,0,16,0] = .recattr[FAT$W_EFBLKH];4 IF .used NEQ 0 AND .recattr[FAT$W_FFBYTE] EQL 0- THEN used[0,0,32,0] = .used[0,0,32,0]-1;4 allocated[0,0,16,0] = .statblk[SBK$W_FILESIZL];4 allocated[2,0,16,0] = .statblk[SBK$W_FILESIZH];9 alloc_blocks = .alloc_blocks + .allocated[0,0,32,0];( blocks = .blocks + .used[0,0,32,0];( IF .line_length GEQ .width_filename THEN BEGIN" line_routine(rblock, temp_desc); STR$FREE1_DX(temp_desc); line_length = 0; END; IF .size_used OR .size_allocation OR .date_created OR .date_modified OR .date_expired OR .date_backup OR .owner_output OR .protection_output) THEN LIB$SYS_FAO(%ASCID '!AS!#< !>', 0, temp_desc, temp_desc,# .width_filename - .line_length); IF .size_used( THEN LIB$SYS_FAO(%ASCID '!AS !#UL', 0, temp_desc, temp_desc,! .width_size, .used[0,0,32,0]); IF .size_allocation THEN LIB$SYS_FAO( IF .size_used THEN %ASCID '!AS/!#' ELSE %ASCID '!AS !#UL', 0, temp_desc, temp_desc,& .width_size, .allocated[0,0,32,0]);!! Dates create,modify,exp,backup IF .date_created( THEN LIB$SYS_FAO(%ASCID '!AS !#%D', 0, temp_desc,5 temp_desc, .width_date, rblock[RBLOCK_T_CREDATE]);t IF .date_modified( THEN LIB$SYS_FAO(%ASCID '!AS !#%D', 0, temp_desc,5 temp_desc, .width_date, rblock[RBLOCK_T_REVDATE]);  IF .date_expiredr( THEN LIB$SYS_FAO(%ASCID '!AS !#%D', 0, temp_desc,5 temp_desc, .width_date, rblock[RBLOCK_T_EXPDATE]);o IF .date_backup( THEN LIB$SYS_FAO(%ASCID '!AS !#%D', 0, temp_desc,5 temp_desc, .width_date, rblock[RBLOCK_T_BAKDATE]);  IF .owner_outputf THEN LIB$SYS_FAO( IF (.width_owner EQL 0) THEN %ASCID '!AS !+!%I '  ELSE %ASCID '!AS !#%I ',_ 0, temp_desc,3 temp_desc, .width_owner, .rblock[RBLOCK_L_UIC]);X IF .protection_output THEN BEGINL& protection = .rblock[RBLOCK_L_FPRO]; INCR I FROM 0 TO 3 DO BEGIN- STR$APPEND(temp_desc, .prot_owner[.i]);: INCR J FROM 0 to 3 DO BEGIN IF NOT .protection./ THEN STR$APPEND(temp_desc, .prot_field[.j]); protection = .protection / 2; END;o END;$ STR$APPEND(temp_desc, %ASCID ')'); END;i% line_routine(rblock, temp_desc); END;  END;% status = STR$FREE1_DX(temp_desc);I( IF NOT .status THEN SIGNAL(.status);" rblock[RBLOCK_V_FULLLINE] = 0; SS$_NORMAL END; l(ROUTINE ascii_list_unix_data(rblock_a) =!++h! Functional Description:i!)@! The Data routine for ASCII transfers (UNIX ls emulation mode).!-- BEGINu BIND" rblock = .rblock_a : RBLOCKDEF,! files = rblock[RBLOCK_L_FILES],l# blocks = rblock[RBLOCK_L_BLOCKS], ) this_nam = rblock[RBLOCK_NAM] : $BBLOCK,s) this_fab = rblock[RBLOCK_FAB] : $BBLOCK,n$ statblk = rblock[RBLOCK_T_STATBLK] : $BBLOCK,$ recattr = rblock[RBLOCK_T_RECATTR] : $BBLOCK; BIND ROUTINE/ line_routine = .rblock[RBLOCK_L_LINE_ROUTINE]; LOCAL 2 temp_desc : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0,! [DSC$B_DTYPE] = DSC$K_DTYPE_T,S! [DSC$B_CLASS] = DSC$K_CLASS_D,_ [DSC$A_POINTER] = 0), used : $BBLOCK[4], now : VECTOR[7,WORD],2 time_b : $BBLOCK[8],3 time_d : $BBLOCK [DSC$K_S_BLN],! uic_grp : $BBLOCK [DSC$K_S_BLN], ! uic_mem : $BBLOCK [DSC$K_S_BLN],e filnam : $BBLOCK [DSC$K_S_BLN], status; ENABLE strings_handler(temp_desc); $NUMTIM (TIMBUF = now);2 filnam [DSC$B_DTYPE] = uic_grp [DSC$B_DTYPE] => uic_mem [DSC$B_DTYPE] = time_d [DSC$B_DTYPE] = DSC$K_DTYPE_T;2 filnam [DSC$B_CLASS] = uic_grp [DSC$B_CLASS] => uic_mem [DSC$B_CLASS] = time_d [DSC$B_CLASS] = DSC$K_CLASS_S;$ time_d [DSC$A_POINTER] = time_b;0 time_d [DSC$W_LENGTH] = %ALLOCATION(time_b);( WHILE NOT .rblock[RBLOCK_V_FULLLINE] DO BEGIN this_fab[FAB$V_NAM] = 1;t" status = $SEARCH(FAB = this_fab); %IF debug4 %THEN print('Directory_Text status = !XL',.status); %FI5 IF (.status EQL RMS$_NMF) OR (.status EQLU RMS$_FNF)R THEN BEGINI files =0; STR$FREE1_DX(temp_desc);R RETURN RMS$_EOF;t END;i IF .status THEN BEGIN BINDk- device = rblock[RBLOCK_Q_DEVICE] : $BBLOCK,n( fib = rblock[RBLOCK_T_FIB] : $BBLOCK,/ prevdir = rblock[RBLOCK_T_PREVDIR] : $BBLOCK, - prevdir_len = rblock[RBLOCK_L_PREVDIR_LEN];4 LOCAL iosb : IOSBDEF;1 files = .files + 1;0 IF .prevdir_len NEQ .this_nam[NAM$B_DIR] OR CH$NEQ(.prevdir_len, prevdir,e .this_nam[NAM$B_DIR], .this_nam[NAM$L_DIR]) THEN  BEGINo# line_routine(rblock, blank_line);e/ CH$MOVE (prevdir_len = .this_nam [NAM$B_DIR],e$ .this_nam [NAM$L_DIR], prevdir); END;9 IF .device[DSC$W_LENGTH] NEQ .this_nam[NAM$B_DEV] OR CH$NEQ(.device[DSC$W_LENGTH],- .device[DSC$A_POINTER], .this_nam[NAM$B_DEV], .this_nam[NAM$L_DEV]) THEN BEGINs LOCAL - dev_desc : $BBLOCK[DSC$C_S_BLN] PRESET(e* [DSC$W_LENGTH] = .this_nam[NAM$B_DEV]," [DSC$B_CLASS] = DSC$K_CLASS_S," [DSC$B_DTYPE] = DSC$K_DTYPE_T,, [DSC$A_POINTER] = .this_nam[NAM$L_DEV]); 4 status = STR$COPY_DX(device, !Save the device name dev_desc);& IF NOT .status THEN SIGNAL(.status);( IF .rblock[RBLOCK_L_DEV_CHANNEL] NEQ 0( THEN $DASSGN( !Close the old channel) CHAN = .rblock[RBLOCK_L_DEV_CHANNEL]);e* status = $ASSIGN( !Open the new channel' CHAN = rblock[RBLOCK_L_DEV_CHANNEL], DEVNAM = device);& IF NOT .status THEN SIGNAL(.status);$ END; !End of open a new channel7 CH$FILL(%CHAR(0), FIB$C_LENGTH, !Clear out the FIBL fib);+ CH$MOVE(FIB$S_FID, !Copy the file IDL this_nam[NAM$W_FID],A fib[FIB$W_FID]);D% status = $QIOW( !Get file info ( CHAN = .rblock[RBLOCK_L_DEV_CHANNEL], FUNC = IO$_ACCESS,O IOSB = iosb,L! P1 = rblock[RBLOCK_Q_FIBDESC],R! P5 = rblock[RBLOCK_T_ATRBLK]); 3 IF .status THEN status = .iosb[IOSB_W_STATUS];L END;O IF (NOT .status)P THEN BEGINN LOCAL msg_buffer : VECTOR[256,BYTE],) msg_desc : $BBLOCK[DSC$K_S_BLN] PRESET( - [DSC$W_LENGTH] = %ALLOCATION(msg_buffer), " [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_S," [DSC$A_POINTER] = msg_buffer);6 msg_desc[DSC$W_LENGTH] = %ALLOCATION(msg_buffer); $GETMSG( MSGID = .status,# MSGLEN = msg_desc[DSC$W_LENGTH],R BUFADR = msg_desc,= FLAGS = 15);_ IF .error_output_ THEN BEGINT LIB$SYS_FAO(! %ASCID '!AF!AF!AF!#< !>',O 0, temp_desc, .this_nam[NAM$B_NAME],B .this_nam[NAM$L_NAME],  .this_nam[NAM$B_TYPE], .this_nam[NAM$L_TYPE],U .this_nam[NAM$B_VER], .this_nam[NAM$L_VER], .width_filename, msg_desc);A" line_routine(rblock, temp_desc); END&  MGFTP026.G  I[MGFTP.SOURCE]FTP_DTON.B32;69Wd<, ELSE BEGIN  files = .files - 1;L STR$FREE1_DX(temp_desc); END; END ELSE BEGIN LOCAL protection, indx, cretim : VECTOR[7,WORD], protstr : VECTOR[11,BYTE];? IF ((.rblock [RBLOCK_T_UCHAR] AND FCH$M_DIRECTORY) NEQU 0)= THEN  BEGINL protstr[0] = %C'd'; this_nam [NAM$B_TYPE] = 0; ENDB ELSEI protstr[0] = %C'-';F/ protection = .rblock [RBLOCK_L_FPRO] ^ -4;K indx = 1; INCR i FROM 0 TO 2 DO BEGINNT protstr[.indx] = (IF (.protection AND XAB$M_NOREAD) EQLU 0 THEN %C'r' ELSE %C'-');W protstr[.indx+1] = (IF (.protection AND XAB$M_NOWRITE) EQLU 0 THEN %C'w' ELSE %C'-');_U protstr[.indx+2] = (IF (.protection AND XAB$M_NOEXE) EQLU 0 THEN %C'x' ELSE %C'-');  indx = .indx+3;)6 protection = .protection ^ -4; !Shift to next field END; protstr[.indx] = 0;E LIB$SYS_FAO (%ASCID'!%I', 0, temp_desc, .rblock [RBLOCK_L_UIC]);T str_lowercase (temp_desc);,9 IF (CH$RCHAR(.temp_desc [DSC$A_POINTER]) EQLU %C'[')C THEN  BEGINN; uic_grp [DSC$A_POINTER] = .temp_desc [DSC$A_POINTER] + 1;N uic_mem [DSC$A_POINTER] = ) CH$FIND_CH (.temp_desc [DSC$W_LENGTH],+ .temp_desc [DSC$A_POINTER], %C',');,& IF (.uic_mem [DSC$A_POINTER] EQLU 0) THEN BEGINA9 uic_mem [DSC$A_POINTER] = .uic_grp [DSC$A_POINTER];U= uic_mem [DSC$W_LENGTH] = .temp_desc [DSC$W_LENGTH] - 2;=- uic_grp [DSC$A_POINTER] = UPLIT(%C'0');L! uic_grp [DSC$W_LENGTH] = 1; ENDr ELSE BEGIN%9 uic_grp [DSC$W_LENGTH] = .uic_mem [DSC$A_POINTER] -t# .uic_grp [DSC$A_POINTER];H: uic_mem [DSC$W_LENGTH] = .temp_desc [DSC$W_LENGTH] -" .uic_grp [DSC$W_LENGTH] - 3;= uic_mem [DSC$A_POINTER] = .uic_mem [DSC$A_POINTER] + 1;C END( ENDd ELSEr BEGINR5 uic_mem [DSC$W_LENGTH] = .temp_desc [DSC$W_LENGTH];P7 uic_mem [DSC$A_POINTER] = .temp_desc [DSC$A_POINTER];d) uic_grp [DSC$A_POINTER] = UPLIT(%C'0');t uic_grp [DSC$W_LENGTH] = 1;E END;- used[0,0,16,0] = .recattr[FAT$W_EFBLKL];w- used[2,0,16,0] = .recattr[FAT$W_EFBLKH];N used[0,0,32,0] = ((.used[0,0,32,0] - 1) * 512) + .recattr [FAT$W_FFBYTE];C $NUMTIM (TIMBUF = cretim, TIMADR = rblock [RBLOCK_T_CREDATE]); M filnam [DSC$W_LENGTH] = .this_nam [NAM$B_NAME] + .this_nam [NAM$B_TYPE]; 5 filnam [DSC$A_POINTER] = .this_nam [NAM$L_NAME]; str_lowercase (filnam); !; ! If the file was created this year, display "HH:MM". # ! Otherwise, display " YYYY".  !- IF (.now[0] EQLU .cretim[0]) !Same year? THEN= LIB$SYS_FAO (%ASCID'!2ZL:!2ZL', time_d, time_d, .cretim[3],s .cretim[4])i ELSEt9 LIB$SYS_FAO (%ASCID'!5UL', time_d, time_d, .cretim[0]);lC LIB$SYS_FAO (%ASCID'!AZ !2UL !8AS !8AS !8UL !AD !2UL !AS !AS', 0, temp_desc,1 protstr, 1, uic_mem, uic_grp, .used[0,0,32,0],d0 3, .months[DSC$A_POINTER] + (.cretim[1] * 3), .cretim [2],  time_d, filnam);_% line_routine(rblock, temp_desc);e END;  END;w% status = STR$FREE1_DX(temp_desc);t( IF NOT .status THEN SIGNAL(.status);" rblock[RBLOCK_V_FULLLINE] = 0; SS$_NORMAL END; S#ROUTINE ascii_nlst_data(rblock_a) =M!++:! Functional Description:R!,'! The Data routine for Ascii transfers.N!--, BEGINS BIND" rblock = .rblock_a : RBLOCKDEF,) this_nam = rblock[RBLOCK_NAM] : $BBLOCK,) this_fab = rblock[RBLOCK_FAB] : $BBLOCK;P BIND ROUTINE/ line_routine = .rblock[RBLOCK_L_LINE_ROUTINE]; LOCALL2 temp_desc : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0,! [DSC$B_DTYPE] = DSC$K_DTYPE_T,v! [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0), status; ENABLE strings_handler(temp_desc);( WHILE NOT .rblock[RBLOCK_V_FULLLINE] DO BEGIN" status = $SEARCH(FAB = this_fab);% IF NOT .status THEN RETURN RMS$_EOF;i LIB$SYS_FAO( %ASCID'!AF!AF!AF!AF!AF!AF',f 0, temp_desc,  IF (.this_nam[NAM$V_NODE])$ THEN .this_nam[NAM$B_NODE] ELSE 0, .this_nam[NAM$L_NODE], IF (.this_nam[NAM$V_EXP_DEV])# THEN .this_nam[NAM$B_DEV] ELSE 0,N .this_nam[NAM$L_DEV],a IF (.this_nam[NAM$V_EXP_DIR])i# THEN .this_nam[NAM$B_DIR] ELSE 0,I .this_nam[NAM$L_DIR],E .this_nam[NAM$B_NAME], .this_nam[NAM$L_NAME]," IF (.this_nam[NAM$B_TYPE] GTR 1)$ THEN .this_nam[NAM$B_TYPE] ELSE 0, .this_nam[NAM$L_TYPE], IF (.this_nam[NAM$V_EXP_VER]) # THEN .this_nam[NAM$B_VER] ELSE 0,_ .this_nam[NAM$L_VER]);" IF NOT ( .this_nam[NAM$V_NODE] OR .this_nam[NAM$V_EXP_DEV] OR c .this_nam[NAM$V_EXP_DIR] OR  .this_nam[NAM$V_EXP_VER]) THEN status = STR$TRANSLATE(B temp_desc, ! Dst temp_desc, ! Src:. %ASCID 'abcdefghijklmnopqrstuvwxyz', ! trans/ %ASCID 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'); ! match! line_routine(rblock, temp_desc); END;$% status = STR$FREE1_DX(temp_desc);L( IF NOT .status THEN SIGNAL(.status);" rblock[RBLOCK_V_FULLLINE] = 0; SS$_NORMAL END; i ROUTINE ascii_finish(rblock_a) =!++%! Functional Description: !,! The Data finish routine.!--% BEGIN BIND" rblock = .rblock_a : RBLOCKDEF; LOCALe status; SS$_NORMAL END; EROUTINE wild_version =!++;! Functional Description:B!KC! This routine returns whether the MADGOAT_FTP_WILD_VERSION logicalAB! was defined. This logical controls whether the default filespec*! for LIST is *.*;* or *.*; (the default).!--M BEGINE LOCALI$ lnm_list : $ITMLST_DECL(ITEMS = 1),( lnm_buffer : VOLATILE VECTOR[255,BYTE], status;# $ITMLST_INIT(ITMLST = lnm_list,  (ITMCOD = LNM$_STRING,A BUFADR = lnm_buffer,% BUFSIZ = %ALLOCATION(lnm_buffer)));. status = $TRNLNM(D- LOGNAM = %ASCID 'MADGOAT_FTP_WILD_VERSION',E TABNAM = lnm$dcl_logical,! ITMLST = lnm_list);  IF .status- THEN status = .lnm_buffer[0] EQL %C'T' ORe .lnm_buffer[0] EQL %C't' OR  .lnm_buffer[0] EQL %C'Y' OR( .lnm_buffer[0] EQL %C'y';$ .statusD END; u*ROUTINE rblock_init(rblock_a, list_flag) =!++B! Functional Description:!i@! This routine contains the common initializations for local and! remote direcotory listings.!--I BEGINS BIND# rblock = .rblock_a : RBLOCKDEF,N6 fib_desc = rblock[RBLOCK_Q_FIBDESC] : VECTOR[2,LONG],! files = rblock[RBLOCK_L_FILES],n# blocks = rblock[RBLOCK_L_BLOCKS],O. alloc_blocks = rblock[RBLOCK_L_ALLOC_BLOCKS],* this_fab = rblock[RBLOCK_FAB] : $BBLOCK,. path_desc = rblock[RBLOCK_Q_PATH] : $BBLOCK; MACRO  set_dnm(fab, dnm)=  BEGIN9 BIND _fab = fab : $BBLOCK;]# _fab[FAB$B_DNS] = %CHARCOUNT(dnm);!% _fab[FAB$L_DNA] = UPLIT(%ASCII dnm);  END%; rblock[RBLOCK_L_STATE] = 0;F rblock[RBLOCK_L_FLAGS] = 0;Q rblock[RBLOCK_V_VALID] = 1;o* rblock[RBLOCK_L_SIZE] = RBLOCK_K_SIZE;+ $INIT_DYNDESC(rblock[RBLOCK_Q_DEVICE]);w& files = blocks = alloc_blocks = 0;# rblock[RBLOCK_L_DATA_ROUTINE] =T (IF .list_flag THEN BEGIN;" rblock[RBLOCK_L_DEV_CHANNEL] = 0; fib_desc[0] = FIB$C_LENGTH;$ fib_desc[1] = rblock[RBLOCK_T_FIB]; rblock[RBLOCK_L_FPRO] = 0; " rblock[RBLOCK_L_PREVDIR_LEN] = 0;% atrlst_init(rblock[RBLOCK_T_ATRBLK],  (atr = STATBLK,i$ addr = rblock[RBLOCK_T_STATBLK]), (atr = RECATTR, $ addr = rblock[RBLOCK_T_RECATTR]), (atr = CREDATE,I$ addr = rblock[RBLOCK_T_CREDATE]), (atr = REVDATE,a$ addr = rblock[RBLOCK_T_REVDATE]), (atr = EXPDATE,L$ addr = rblock[RBLOCK_T_EXPDATE]), (atr = BAKDATE, $ addr = rblock[RBLOCK_T_BAKDATE]), (atr = FPRO,! addr = rblo' MGFTP026.G  I[MGFTP.SOURCE]FTP_DTON.B32;69Wdo;ck[RBLOCK_L_FPRO]),, (atr = UCHAR,$" addr = rblock[RBLOCK_T_UCHAR]), (atr = UIC_RO,! addr = rblock[RBLOCK_L_UIC]));H (IF (.emulate_unix_ls EQLU 2) OR (.emulate_unix_ls AND .unix_style_dir) THEN ascii_list_unix_dataY ELSE ascii_list_data); END ELSE ascii_nlst_data);)1 rblock[RBLOCK_L_START_ROUTINE] = ascii_start;e3 rblock[RBLOCK_L_FINISH_ROUTINE] = ascii_finish;e) $NAM_INIT( NAM = rblock[RBLOCK_NAM],' ESA = rblock[RBLOCK_EXPAND], ESS = NAM$C_MAXRSS, RSA = rblock[RBLOCK_RESULT],_ RSS = NAM$C_MAXRSS);_) $FAB_INIT( FAB = rblock[RBLOCK_FAB],a# FNA = .path_desc[DSC$A_POINTER],]" FNS = .path_desc[DSC$W_LENGTH], FOP = ,  NAM = rblock[RBLOCK_NAM]); $ IF .list_flag AND wild_version()- THEN set_dnm(rblock[RBLOCK_FAB], '*.*;*')- ELSE set_dnm(rblock[RBLOCK_FAB], '*.*;'); SS$_NORMAL END; _.ROUTINE add_crlf_line(rblock_a, line_desc_a) =!++I! Functional Description: !gC! This routine adds a CR/LF delimited line of directory text to the F! in_line descriptor. It sets the RBLOCK_V_FULLLINE flag once in_line! is full enough to send. !r! Formal Parameters:!I9! rblock_a the address of the block describing the remote ! connection.r>! line_desc_a the address of a descriptor for the line to add.!--I BEGIN BIND# rblock = .rblock_a : RBLOCKDEF,& line_desc = .line_desc_a : $BBLOCK,/ in_line = rblock[RBLOCK_Q_IN_LINE] : $BBLOCK;E LOCAL_ status; EXTERNAL ROUTINE- STR$CONCAT : BLISS ADDRESSING_MODE(GENERAL);E status = STR$CONCAT(in_line, in_line, !Add a CR/LF delimited linec4 line_desc, %ASCID %STRING(%CHAR(13), %CHAR(10)));( IF NOT .status THEN SIGNAL(.status);+ IF .in_line[DSC$W_LENGTH] GEQU max_listr9 THEN rblock[RBLOCK_V_FULLLINE] = 1; !in_line is fullB SS$_NORMAL END; ,+ROUTINE write_line(rblock_a, line_desc_a) =1!++=! Functional Description:! F! This routine writes a line provided to a local file. It is used for! local directory listings.3!]! Formal Parameters:! ?! rblock_a the address of the block pointing to the RAB for the ! local file. @! line_desc_a the address of a descriptor for the line to write.!--n BEGIN  BIND# rblock = .rblock_a : RBLOCKDEF,i& line_desc = .line_desc_a : $BBLOCK,0 out_rab = .rblock[RBLOCK_L_OUT_RAB] : $BBLOCK; LOCALt status;I out_rab[RAB$L_RBF] = .line_desc[DSC$A_POINTER]; !Point to the line tos< out_rab[RAB$W_RSZ] = .line_desc[DSC$W_LENGTH]; !...write3 status = $PUT(RAB = out_rab); !Write the line# IF NOT .status. THEN SIGNAL(.status, .out_rab[RAB$L_STV]); SS$_NORMAL END; 6ROUTINE ftp_retrieve_finish(rblock_a, finish_status) =!++/! Functional Description:'! A! We are now through with this request. Release all devices thatd@! were allocated for this request. Close all files. Close allA! connections. Free all memory. Call the ast routine associateds! with the request.d!--t BEGINB BIND# rblock = .rblock_a : RBLOCKDEF, . path_desc = rblock[RBLOCK_Q_PATH] : $BBLOCK,0 out_line = rblock[RBLOCK_Q_OUT_LINE] : $BBLOCK,/ in_line = rblock[RBLOCK_Q_IN_LINE] : $BBLOCK,E0 final_status = .rblock[RBLOCK_L_FINAL_STATUS_A] : LONG UNSIGNED;t BUILTINO REMQUE; EXTERNAL ROUTINE free_mem; LOCAL$ addr, status;; IF NOT .rblock[RBLOCK_V_VALID] THEN RETURN(SS$_NORMAL);B rblock[RBLOCK_V_VALID] = 0;r REMQUE(rblock, addr);_ %IF debugt= %THEN print('Retr Finish, status = !XL', .finish_status);A %FI_ !++p< ! If the original caller gave us a location to write the( ! final status, then let's write it. !--r> IF final_status NEQU 0 THEN final_status = .finish_status;" IF .rblock[RBLOCK_V_CONN_OPEN] THEN BEGIN status = netlib_lib_disconnect(& CTX = rblock[RBLOCK_L_TCP_CHANNEL]); %IF debug5 %THEN print('Retr Net Close status = !XL', .status);o %FI3 IF .status EQL SS$_ABORT THEN status = SS$_NORMAL;D% IF NOT .status THEN SIGNAL(.status);t END;o" IF .rblock[RBLOCK_V_CHAN_OPEN] THEN BEGINB status = netlib_lib_deassign(CTX = rblock[RBLOCK_L_TCP_CHANNEL]);% IF NOT .status THEN SIGNAL(.status); END;_* IF .rblock[RBLOCK_L_DEV_CHANNEL] NEQ 07 THEN $DASSGN(CHAN = .rblock[RBLOCK_L_DEV_CHANNEL]); - IF .rblock[RBLOCK_L_FINISH_ROUTINE] NEQ 0l4 THEN (.rblock[RBLOCK_L_FINISH_ROUTINE])(rblock);1 status = $SETEF(EFN = .rblock[RBLOCK_L_EFN]);E( IF NOT .status THEN SIGNAL(.status); !++ ; ! Call the ast routine to indicate that we are finishedA !--O% IF .rblock[RBLOCK_L_ASTADR] NEQ 0L THEN BEGIN status = $DCLAST($ ASTADR = .rblock[RBLOCK_L_ASTADR],% ASTPRM = .rblock[RBLOCK_L_ASTPRM]);r% IF NOT .status THEN SIGNAL(.status);A END;m# status = STR$FREE1_DX(in_line);P( IF NOT .status THEN SIGNAL(.status);$ status = STR$FREE1_DX(out_line);( IF NOT .status THEN SIGNAL(.status);3 status = STR$FREE1_DX(rblock[RBLOCK_Q_DEVICE]);t( IF NOT .status THEN SIGNAL(.status);% status = STR$FREE1_DX(path_desc);_( IF NOT .status THEN SIGNAL(.status); !++  ! Free up this request !--  status = $DCLAST(r ASTADR = free_mem, ASTPRM = rblock);( IF NOT .status THEN SIGNAL(.status); RMS$_EOF END; _-GLOBAL ROUTINE ftp_dir_to_net_abort(astprm) =!++i! Functional Description:p!SA! Someone asked us to store a file on remote port asynchronously._E! Now they've changed their minds. So we must find the correspondingH&! rblocks and finish up their request.!r! Formal Parameters:!<! ASTPRM When the async request was started, they specified5! an astprm. To cancel, they must specify the samet ! astprm.'!--t BEGIN LOCALs( rblock_a : INITIAL(.retrieve_queue[0]);* WHILE .rblock_a NEQA retrieve_queue DO BEGIN BINDR# rblock = .rblock_a : RBLOCKDEF;$ rblock_a = .rblock[RBLOCK_L_FLINK];) IF .rblock[RBLOCK_L_ASTPRM] EQLU .astprmK- THEN ftp_retrieve_finish(rblock, SS$_ABORT);  END;  SS$_NORMAL END; B#FORWARD ROUTINE send_file_data_ast;_#ROUTINE send_file_data(rblock_a) = I!++F! Functional Description: !9! Send the data that is actually in the file. We do this.1! in two different ways(page mode and file mode). !--s BEGIND EXTERNAL ROUTINE enblock_data, compress_data;k BIND" rblock = .rblock_a : RBLOCKDEF,0 out_line = rblock[RBLOCK_Q_OUT_LINE] : $BBLOCK,/ in_line = rblock[RBLOCK_Q_IN_LINE] : $BBLOCK;i LOCAL_ i,O status;; IF NOT .rblock[RBLOCK_V_VALID] THEN RETURN(SS$_NORMAL);s& status = (IF .rblock[RBLOCK_V_EOF] THEN RMS$_EOFs1 ELSE (.rblock[RBLOCK_L_DATA_ROUTINE])(rblock));R !++ 4 ! Check to see if we are at the end of the file. !--$B IF (.status EQLU RMS$_EOF) AND (.in_line[DSC$W_LENGTH] EQLU 0)8 THEN RETURN(ftp_retrieve_finish(rblock, SS$_NORMAL))> ELSE IF .status EQL RMS$_EOF THEN rblock[RBLOCK_V_EOF] = 1- ELSE IF NOT .status THEN SIGNAL(.status);H5 IF .rblock[RBLOCK_L_MODE] EQL FTP$K_MODE_COMPRESS  THEN BEGIN9 status = compress_data(rblock, out_line, in_line, 1, I);n STR$COPY_DX(in_line, out_line); END7 ELSE IF .rblock[RBLOCK_L_MODE] EQL FTP$K_MODE_BLOCK  THEN BEGIN STR$COPY_DX(in_line, out_line);- status = enblock_data(out_line, in_line, 0);! END;u !++L ! Write it out.O !--F status = netlib_lib_send(i% CTX = rblock[RBLOCK_L_TCP_CHANNEL],D STR = in_line, PUSH = 1,i$ IOSB = rblock[RB(h MGFTP026.G  I[MGFTP.SOURCE]FTP_DTON.B32;69WdJLOCK_Q_DATA_IOSB], ASTADR = send_file_data_ast, ASTPRM = rblock);L( IF NOT .status THEN SIGNAL(.status); !++R" ! Call the transcript routine. !--u) IF .rblock[RBLOCK_L_TRANSCRIPT] NEQ 0IA THEN (.rblock[RBLOCK_L_TRANSCRIPT])(.rblock[RBLOCK_L_ASTPRM],5 in_line);e SS$_NORMAL END; T'ROUTINE send_file_data_ast(rblock_a) = b!++)! Functional Description:$!T)! Our write on the network has completed.!--D BEGINR BIND" rblock = .rblock_a : RBLOCKDEF,0 out_line = rblock[RBLOCK_Q_OUT_LINE] : $BBLOCK,/ in_line = rblock[RBLOCK_Q_IN_LINE] : $BBLOCK,2 data_iosb = rblock[RBLOCK_Q_DATA_IOSB] : IOSBDEF; LOCALu status;; IF NOT .rblock[RBLOCK_V_VALID] THEN RETURN(SS$_NORMAL); # status = STR$FREE1_DX(in_line);B( IF NOT .status THEN SIGNAL(.status);$ IF .out_line[DSC$W_LENGTH] NEQ 0 THEN BEGIN! status = STR$FREE1_DX(out_line);R% IF NOT .status THEN SIGNAL(.status);A END;e' status = .data_iosb[IOSB_W_STATUS];E IF NOT .status THEN BEGINL IF .status EQLU 05 THEN RETURN(ftp_retrieve_finish(rblock, SS$_NORMAL)) 3 ELSE RETURN(ftp_retrieve_finish(rblock, .status));t END;E send_file_data(rblock);l SS$_NORMAL END; DROUTINE start_ast(rblock_a) =!++I! Functional Description:!h6! An AST routine that means its time to actually start! with the transfer.!--t BEGINc BIND" rblock = .rblock_a : RBLOCKDEF; LOCALM status; %IF debugtE %THEN print('Foreign Port = !UL, !-!XL', .rblock[RBLOCK_L_PORT]);% %FI % IF (.rblock [RBLOCK_V_CONN_OPEN])A THEN BEGIN !% ! Connection has already been made!+ ! status = SS$_NORMAL;A END ELSE BEGIN status = netlib_lib_bind(.% CTX = rblock[RBLOCK_L_TCP_CHANNEL],-1 PORT = (IF .rblock[RBLOCK_L_PORT] NEQ FTP_DPORTx THEN FTP_DPORT ELSE 0),& ADDR = .rblock[RBLOCK_L_LOCAL_HOST], NOTPASS = 1);r %IF debug)9 %THEN print('netlib_lib_bind status = !XL', .status);' %FIT IF .status* THEN status = netlib_lib_connect_addr(& CTX = rblock[RBLOCK_L_TCP_CHANNEL], ADDR = rblock[RBLOCK_L_HOST]," PORT = .rblock[RBLOCK_L_PORT]); END; %IF debug,A %THEN print('netlib_lib_connect_addr status = !XL', .status);  %FI ' IF NOT .status THEN SIGNAL(.status)] ELSE BEGIN%IF %DECLARED(NETLIB_V2)%THENC rblock[RBLOCK_V_CHAN_OPEN] = 1;%FIP rblock[RBLOCK_V_CONN_OPEN] = 1; send_file_data(rblock); END;  SS$_NORMAL END; 8GLOBAL ROUTINE local_dir_handler(sig_a, mech_a, ena_a) =!++ ! Functional description:! %! Clean up a local directory listing.D!--L BEGIN  BIND sig = .sig_a : $BBLOCK, mech = .mech_a : $BBLOCK,! ena = .ena_a : VECTOR[, LONG], 1 condition = sig[CHF$L_SIG_NAME] : LONG UNSIGNED,W rblock = .ena[1] : RBLOCKDEF; LOCAL_ status; EXTERNAL ROUTINE/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);P! IF .condition EQLU SS$_UNWIND] THEN BEGIN' IF .rblock[RBLOCK_L_DEV_CHANNEL] NEQ 0B4 THEN $DASSGN(CHAN = .rblock[RBLOCK_L_DEV_CHANNEL]);0 status = STR$FREE1_DX(rblock[RBLOCK_Q_DEVICE]);& IF NOT .status THEN SIGNAL(.status);  END;( SS$_RESIGNAL END; BGLOBAL ROUTINE ftp_local_dir(a path_a, list_type,s out_rab_a)=!++ ! Functional Description: !f7! Write local directory listing text to an output file.r!w! Formal Parameters:!!'! path_a The name of the file to list.a!d4! list_type Low bit set for LIST. Cleared for NLST.! (! out_rab_a The RAB for the output file.! ! Return Value:! '! RMS$_FNF Can't find the file to openi0! RMS$_xxx Other RMS $OPEN and $CONNECT errors.!I(! SS$_xxx Any unsuccessful return from)! $CLREF, $QIO, $ASSIGN, and LIB$xxxx.Z!-- BEGIN8 BIND path = .path_a : $BBLOCK,# out_rab = .out_rab_a : $BBLOCK;d LOCALd rblock : VOLATILE RBLOCKDEF, status; BIND* this_fab = rblock[RBLOCK_FAB] : $BBLOCK,. path_desc = rblock[RBLOCK_Q_PATH] : $BBLOCK,6 fib_desc = rblock[RBLOCK_Q_FIBDESC] : VECTOR[2,LONG]; ENABLE local_dir_handler(rblock); 2 path_desc[DSC$W_LENGTH] = .path[DSC$W_LENGTH];+ path_desc[DSC$B_CLASS] = DSC$K_CLASS_S; + path_desc[DSC$B_DTYPE] = DSC$K_DTYPE_T;h4 path_desc[DSC$A_POINTER] = .path[DSC$A_POINTER]; %IF debugl1 %THEN print('ftp_local_dir PATH = !AS',path);R %FI]$ rblock_init(rblock, .list_type);/ rblock[RBLOCK_L_LINE_ROUTINE] = write_line; ' rblock[RBLOCK_L_OUT_RAB] = out_rab;A$ status = $PARSE(FAB = this_fab);> IF NOT .status THEN SIGNAL(.status, .this_fab[FAB$L_STV]);7 status = (.rblock[RBLOCK_L_START_ROUTINE])(rblock);O( IF NOT .status THEN SIGNAL(.status);6 status = (.rblock[RBLOCK_L_DATA_ROUTINE])(rblock); IF .status EQL RMS$_EOFu THEN status = SS$_NORMAL ELSE IF NOT .statusR THEN SIGNAL(.status);O0 (.rblock[RBLOCK_L_FINISH_ROUTINE])(rblock); * IF .rblock[RBLOCK_L_DEV_CHANNEL] NEQ 07 THEN $DASSGN(CHAN = .rblock[RBLOCK_L_DEV_CHANNEL]);t3 status = STR$FREE1_DX(rblock[RBLOCK_Q_DEVICE]);L( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL" END; !End of ftp_local_dir 04ROUTINE pasv_start_ast (rblock_a, passive_channel) =BEGINi!aH! This routine is called from PASV_AST() in FTP_IN to store the passiveE! channel info in the RBLOCK once the client has connected. We then]H! kick off the transfer set up in the earlier call to FTP_DIR_TO_NET().!  BIND rblock = .rblock_a : RBLOCKDEF;5 rblock [RBLOCK_L_TCP_CHANNEL] = .passive_channel;h# rblock[RBLOCK_V_CHAN_OPEN] = 1;=# rblock[RBLOCK_V_CONN_OPEN] = 1;s# rblock[RBLOCK_V_PASV_OPEN] = 1;': RETURN ($DCLAST(ASTADR = start_ast, ASTPRM = rblock));END; )GLOBAL ROUTINE ftp_dir_to_net( mode, stru, type, type_size,s local_host, host, port, path_a, list_type,  efn,. astadr, astprm, final_status_a, transcript, passive_mode, passive_channel,  pasv_start_rtn, pasv_start_astprm) =n!++s! Functional Description:f!s8! Open up the data connection and start storing the data! coming in on it.!O! Formal Parameters:!_8! mode The "FTP transfer mode". Value should be one of! FTP$K_mode_Stream,K! FTP$K_mode_Block or! FTP$K_mode_Compress._!S9! stru The "FTP file structure". Value should be one of ! FTP$K_STRU_File, ! FTP$K_STRU_Record ort! FTP$K_STRU_Page!E=! type The "FTP Represenation type". Value should be one off! FTP$K_type_AN,[! FTP$K_type_AT,! FTP$K_type_AC,M! FTP$K_type_EN,T! FTP$K_type_ET,! FTP$K_type_EC,,! FTP$K_type_I or! FTP$K_type_L.! 5! type_size IF type eql FTP$K_type_L then this is theL! byte size.!N3! host A 32 bit host address(Page form) to connectF2! to. A value of 0 means we are doing a passive$! open rather than an active open.!l4! port A 16 bit port number. If the open is active-! this is the port on the remote machine too,! do an active connect to. If the open is.! passive, then it is the local port to do a! passive open on.!s5! Text The data structure used to hold the text that ! we will push onto the net.!o.! EFN An Event flag to set upon file transfer! completion.O!,1! AstAdr An AST routine to call upon completion. !r)! AstPrm A Paramter for the ast routine.b!k>! final_status A longword to write the final transfer status.! Passed by reference.B!K8! transcript An address of a routine to be called each'! )ho MGFTP026.G  I[MGFTP.SOURCE]FTP_DTON.B32;69Wd vY time we write data on the network.a0! This routine is called with two parameters.+! The first is the astprm. The second isR#! a descriptor of the data sent.C!_! Return Value: !o:! FTP$_Unsupported_type We weren't able to handle the type:! FTP$_Unsupported_STRU We weren't able to handle the stru:! FTP$_Unsupported_mode We weren't able to handle the mode!A'! RMS$_FNF Can't find the file to openT0! RMS$_xxx Other RMS $OPEN and $CONNECT errors.!d(! SS$_xxx Any unsuccessful return from)! $CLREF, $QIO, $ASSIGN, and LIB$xxxx.=! !--l BEGINL BIND path = .path_a : $BBLOCK,B+ final_status = .final_status_a : $BBLOCK;  EXTERNAL ROUTINE get_mem;a EXTERNAL LITERAL FTP$_UNSUPPORTED_TYPEX, FTP$_UNSUPPORTED_STRUX, FTP$_UNSUPPORTED_MODEX; BIND. rblock = get_mem(RBLOCK_K_SIZE) : RBLOCKDEF,! files = rblock[RBLOCK_L_FILES],a# blocks = rblock[RBLOCK_L_BLOCKS],a. alloc_blocks = rblock[RBLOCK_L_ALLOC_BLOCKS],* this_fab = rblock[RBLOCK_FAB] : $BBLOCK,- path_desc = rblock[RBLOCK_Q_PATH] : $BBLOCK,k2 data_iosb = rblock[RBLOCK_Q_DATA_IOSB] : $BBLOCK,6 fib_desc = rblock[RBLOCK_Q_FIBDESC] : VECTOR[2,LONG],( fib = rblock[RBLOCK_T_FIB] : $BBLOCK,- atrblk = rblock[RBLOCK_T_ATRBLK] : $BBLOCK;a BUILTIN  INSQUE; LOCALt status; $INIT_DYNDESC(path_desc);=, $INIT_DYNDESC(rblock[RBLOCK_Q_IN_LINE]);- $INIT_DYNDESC(rblock[RBLOCK_Q_OUT_LINE]); " STR$COPY_DX(path_desc, path ); %IF debug2 %THEN print('Directory_Text PATH = !AS',path); %FI # INSQUE(rblock, retrieve_queue); $ rblock_init(rblock, .list_type);( rblock[RBLOCK_L_FINAL_STATUS_A] = 0; rblock[RBLOCK_L_ASTADR] = 0; rblock[RBLOCK_L_ASTPRM] = 0; rblock[RBLOCK_L_EFN] = 0;r$ rblock[RBLOCK_L_TRANSCRIPT] = 0;3 rblock[RBLOCK_L_FINAL_STATUS_A] = final_status;'( IF (.mode NEQ FTP$K_MODE_STREAM) AND! (.mode NEQ FTP$K_MODE_BLOCK) ANDi (.mode NEQ FTP$K_MODE_COMPRESS) THEN BEGIN) ftp_retrieve_finish(rblock, SS$_NORMAL);e RETURN(FTP$_UNSUPPORTED_MODEX); END;c& IF (.stru NEQ FTP$K_STRU_FILE) AND (.stru NEQ FTP$K_STRU_VMS)u THEN BEGIN) ftp_retrieve_finish(rblock, SS$_NORMAL);a RETURN(FTP$_UNSUPPORTED_STRUX); END; $ IF (.type NEQ FTP$K_TYPE_AN) AND (.type NEQ FTP$K_TYPE_AT) AND (.type NEQ FTP$K_TYPE_I) AND  (.type NEQ FTP$K_TYPE_L) OR. (.type EQL FTP$K_TYPE_L AND .type_size NEQ 8) THEN BEGIN) ftp_retrieve_finish(rblock, SS$_NORMAL); RETURN(FTP$_UNSUPPORTED_TYPEX); END;$ status = STR$FREE1_DX(dir_desc);2 rblock[RBLOCK_L_LINE_ROUTINE] = add_crlf_line;7 status = (.rblock[RBLOCK_L_START_ROUTINE])(rblock);H IF NOT .status THEN BEGIN) ftp_retrieve_finish(rblock, SS$_NORMAL);n RETURN(.status);U END;s IF (.passive_mode) THEN BEGIN IF (.passive_channel NEQU 0)O THEN BEGIN6 rblock [RBLOCK_L_TCP_CHANNEL] = .passive_channel;$ rblock[RBLOCK_V_CHAN_OPEN] = 1;$ rblock[RBLOCK_V_CONN_OPEN] = 1;$ rblock[RBLOCK_V_PASV_OPEN] = 1; END;n END ELSE BEGIN !++% ! Start to open the network data  !--tC status = netlib_lib_assign(CTX = rblock[RBLOCK_L_TCP_CHANNEL]);d IF NOT .status THEN BEGIN) ftp_retrieve_finish(rblock, SS$_NORMAL);o RETURN(.status);i END;_%IF NOT %DECLARED(NETLIB_V2)%THENt# rblock[RBLOCK_V_CHAN_OPEN] = 1;B%FI; END;3 rblock[RBLOCK_L_FINAL_STATUS_A] = final_status;$& rblock[RBLOCK_L_ASTADR] = .astadr;& rblock[RBLOCK_L_ASTPRM] = .astprm; rblock[RBLOCK_L_EFN] = .efn;. rblock[RBLOCK_L_TRANSCRIPT] = .transcript;1 status = $CLREF(EFN = .rblock[RBLOCK_L_EFN]);]( IF NOT .status THEN SIGNAL(.status);" rblock[RBLOCK_L_MODE] = .mode;" rblock[RBLOCK_L_STRU] = .stru;" rblock[RBLOCK_L_TYPE] = .type;, rblock[RBLOCK_L_TYPE_SIZE] = .type_size;. rblock[RBLOCK_L_LOCAL_HOST] = .local_host;" rblock[RBLOCK_L_HOST] = .host;" rblock[RBLOCK_L_PORT] = .port;$ status = $PARSE(FAB = this_fab); IF NOT .status THEN BEGIN BIND stat = status : $BBLOCK;+ IF .stat[STS$V_SEVERITY] EQLU STS$K_SEVEREl THENb( stat[STS$V_SEVERITY] = STS$K_ERROR;% SIGNAL(.stat, .this_fab[FAB$L_STV]);K END;n !++ 5 ! Now that we've squirrelled away everything thatD' ! was passed in, Do the rest asynchR !--f4 IF (.passive_mode) AND (.passive_channel EQLU 0) THEN BEGIN !: ! Here, we've been told PASV mode, but the client hasn'tB ! opened the connection. Set things up for PASV_AST() in FTP_IN9 ! to call our PASV_START_AST() to fire up the transfer.  !" .pasv_start_rtn = pasv_start_ast; .pasv_start_astprm = rblock;  END ELSE BEGIN !4 ! Not passive mode, so just go start the transfer. !% status = $DCLAST(ASTADR = start_ast,o ASTPRM = rblock);% IF NOT .status THEN SIGNAL(.status);s END;( !++b) ! Now that we've started the transfer%F ! Return to the caller and let the connection open and the file be! ! transferred asynchronously.M !--  SS$_NORMAL END;ENDELUDOM IF .rblock[RBLOCK_V_CHAN_OPEN] THEN BEGINB status = netlib_lib_deassign(CTX = rblock[RBLOCK_L_TCP_CHANNEL]);% IF NOT .status THEN SIGNAL(.status); END;_* IF .rblock[RBLOCK_L_DEV_CHANNEL] NEQ 07 THEN $DASSGN(CHAN = .rblock[RBLOCK_L_DEV_CHANNEL]); - IF .rblock[RBLOCK_L_FINISH_ROUTINE] NEQ 0l4 THEN (.rblock[RBLOCK_L_FINISH_ROUTINE])(rblock);1 status = $SETEF(EFN = .rblock[RBLOCK_L_EFN]);E( IF NOT .status THEN SIGNAL(.st*[MGFTP.SOURCE]FTP_DTOT.B32;3+,B.$/ 4K$#-I0123KPWO$56J#n7cq#n89/RFÞGHJ ! MadGoat FTP client and server!?! Authors: Chad Wilson, Dale Moore, Tod Shannon, Bruce Miller,,! Marc Shannon, Henry Miller, John Clement,1! Matt Madison, Darrell Burkhead, Hunter Goatley!6! Copyright 1986, 1992, Carnegie Mellon University.<! Copyright 1994, MadGoat Software. All rights reserved.!?! Permission is granted for not-for-profit redistribution,?! provided all source and object code remain unchanged from?! the original distribution, and that all copyright notices! remain intact.!MODULE ftp_dtot(. ADDRESSING_MODE(NONEXTERNAL = LONG_RELATIVE),$ LIST(ASSEMBLY, NOBINARY, NOEXPAND), IDENT = 'V2.0') =BEGIN!++! Description:!B! Routine for sending a full directory listing to the remote user.!!6! Written_By: John Clement 12-Oct-1992 Rice University!! Modified by:!)! V1.1 Hunter Goatley 24-SEP-1993 07:215! Modified to use FIELDS macros, ported to AXP, etc.!!--LIBRARY 'SYS$LIBRARY:STARLET';LIBRARY 'FTP';LIBRARY 'FIELDS'; COMPILETIME debug = 0;G%IF debug %THEN %MESSAGE('DEBUG mode is enabled in FTP_DTOT.B32!') %FI; %IF debug%THEN LIBRARY 'NETAUX';%FI _DEF(RBLOCK) RBLOCK_A_FLINK = _LONG, RBLOCK_A_BLINK = _LONG, RBLOCK_L_SIZE = _LONG, RBLOCK_L_FLAGS1 = _LONG, _OVERLAY(RBLOCK_L_FLAGS1) RBLOCK_V_VALID = _BIT, RBLOCK_V_ABORT = _BIT, _ENDOVERLAY RBLOCK_L_CODE = _LONG, RBLOCK_A_ASTADR = _LONG, RBLOCK_A_ASTPRM = _LO*& MGFTP026.GBI[MGFTP.SOURCE]FTP_DTOT.B32;3K$FNG,%IF %DECLARED(NETLIB_V2) %THEN, RBLOCK_X_REMSIN = _BYTES(SIN_S_SINDEF),%FI3 RBLOCK_FAB = _BYTES(FAB$C_BLN), ! FAB address _ALIGN(LONG)3 RBLOCK_NAM = _BYTES(NAM$C_BLN), ! NAM address _ALIGN(LONG)* RBLOCK_EXPAND = _BYTES(NAM$C_MAXRSS), _ALIGN(LONG)* RBLOCK_RESULT = _BYTES(NAM$C_MAXRSS), _ALIGN(LONG)* RBLOCK_XABFHC = _BYTES(XAB$C_FHCLEN), _ALIGN(LONG)* RBLOCK_XABDAT = _BYTES(XAB$C_DATLEN), _ALIGN(LONG)* RBLOCK_XABALL = _BYTES(XAB$C_ALLLEN), _ALIGN(LONG)* RBLOCK_XABPRO = _BYTES(XAB$C_PROLEN), _ALIGN(LONG)* RBLOCK_XABITM = _BYTES(XAB$C_ITMLEN), _ALIGN(LONG)" RBLOCK_XAB_LIST = _BYTES(24), _ALIGN(LONG)# RBLOCK_UCHAR_DIRECTORY = _LONG, RBLOCK_Q_PATH = _QUAD_ENDDEF(RBLOCK);LITERAL( RBLOCK_K_SIZE = RBLOCK_S_RBLOCKDEF;OWN dir_queue : VECTOR[8,LONG] PRESET( [0] = dir_queue, [1] = dir_queue); 0GLOBAL ROUTINE ftp_directory_list_kill(astprm) =!++! Functional Description:!@! Someone asked us to show a file on remote host asynchronously.E! Now they've changed their minds. So we must find the corresponding$! sblocks and Stop the transfer NOW.!! Formal Parameters:!7! astprm When the async stor request was started, they7! specified and astprm. To cancel, they must specify! the same astprm.!-- BEGIN LOCAL save : INITIAL(.dir_queue[0]),# rblock_a : INITIAL(.dir_queue[0]), status; %IF debug6 %THEN print('Ftp_Directory_List_Kill Astprm: !XL', .astprm); %FI" WHILE .rblock_a NEQA dir_queue DO BEGIN BIND% rblock = .rblock_a : RBLOCKDEF;$ rblock_a = .rblock[RBLOCK_A_FLINK];) IF .rblock[RBLOCK_A_ASTPRM] EQLU .astprm THEN BEGIN %IF debug7 %THEN print('Ftp_Directory_List_Kill rblock: !XL', .rblock); %FI rblock[RBLOCK_V_ABORT] = 1; END;& IF .rblock_a EQL .save THEN EXITLOOP; END; SS$_NORMAL END; FORWARD ROUTINE parse_suc;ROUTINE do_print( rblock_a ) = BEGIN EXTERNAL ROUTINE free_mem, get_mem, send_data,. LIB$SYS_FAO : BLISS ADDRESSING_MODE(GENERAL),- STR$APPEND : BLISS ADDRESSING_MODE(GENERAL),. STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL), strings_handler; BIND* rblock = .rblock_a : RBLOCKDEF,& fab = rblock[RBLOCK_FAB] : $BBLOCK,& nam = rblock[RBLOCK_NAM] : $BBLOCK,2 uchar_directory = rblock[RBLOCK_UCHAR_DIRECTORY],, xaball = rblock[RBLOCK_XABALL] : $BBLOCK,, xabpro = rblock[RBLOCK_XABPRO] : $BBLOCK,, xabfhc = rblock[RBLOCK_XABFHC] : $BBLOCK,, xabdat = rblock[RBLOCK_XABDAT] : $BBLOCK,. path_desc = rblock[RBLOCK_Q_PATH] : $BBLOCK,. astprm = .rblock[RBLOCK_A_ASTPRM] : $BBLOCK; BUILTIN CMPM, INSQUE; LOCAL# null_date : VECTOR[2,LONG] PRESET( [0] = 0, [1] = 0),$ prot_owner : VECTOR[4,LONG] PRESET( [0] = %ASCID 'System:', [1] = %ASCID ', Owner:', [2] = %ASCID ', Group:', [3] = %ASCID ', World:'),$ prot_field : VECTOR[4,LONG] PRESET( [0] = %ASCID 'R', [1] = %ASCID 'W', [2] = %ASCID 'E', [3] = %ASCID 'D'),2 temp_desc : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0," [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),3 temp_desc1 : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0," [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0), temp, org, size_used, protection, status; ENABLE strings_handler(temp_desc); %IF debug/ %THEN print('Do_Dir: rblock: !XL', rblock); %FI !++9 ! Now, we shouldn't have to do this if SRCHXABS wouldB ! work as I expect. However, I've evidently missed something. ! Dale Moore. !-- status = $OPEN(FAB = fab); $CLOSE(FAB = fab);! LIB$SYS_FAO(%ASCID '!3UL-!/',( 0, temp_desc, .rblock[RBLOCK_L_CODE]);& STR$APPEND(temp_desc1, temp_desc); %IF debug+ %THEN print('Line:''!AS''', temp_desc); %FI# size_used = .xabfhc[XAB$L_EBK]; IF .size_used EQL 0$ THEN size_used = .fab[FAB$L_ALQ]$ ELSE IF .xabfhc[XAB$W_FFB] EQL 0$ THEN size_used = .size_used - 1;1 IF (NOT .status) AND (.nam[NAM$B_RSL] GTR 44) THEN BEGIN status = LIB$SYS_FAO(5 %ASCID '!3UL-!AF!/!52< !>!/',( 0, temp_desc, .rblock[RBLOCK_L_CODE], .nam[NAM$B_RSL], .nam[NAM$L_RSA]);% IF NOT .status THEN SIGNAL(.status);# STR$APPEND(temp_desc1, temp_desc); %IF debug( %THEN print('Line:''!AS''', temp_desc); %FI END: ELSE IF (NOT .status) AND NOT (.nam[NAM$B_RSL] GTR 44) THEN BEGIN status = LIB$SYS_FAO(7 %ASCID '!3UL-!44!8< !>!/',( 0, temp_desc, .rblock[RBLOCK_L_CODE], .nam[NAM$B_RSL], .nam[NAM$L_RSA]);% IF NOT .status THEN SIGNAL(.status);' STR$APPEND(temp_desc1, temp_desc); %IF debug( %THEN print('Line:''!AS''', temp_desc); %FI END ELSE IF .status THEN BEGIN LIB$SYS_FAO(% %ASCID '!3UL-!AF!AF!AF!AF!AF!AF!/',' 0, temp_desc, .rblock[RBLOCK_L_CODE], IF (.nam[NAM$V_NODE]) THEN .nam[NAM$B_NODE] ELSE 0, .nam[NAM$L_NODE], IF (.nam[NAM$V_EXP_DEV]) THEN .nam[NAM$B_DEV] ELSE 0, .nam[NAM$L_DEV], IF (.nam[NAM$V_EXP_DIR]) THEN .nam[NAM$B_DIR] ELSE 0, .nam[NAM$L_DIR], .nam[NAM$B_NAME], .nam[NAM$L_NAME], .nam[NAM$B_TYPE], .nam[NAM$L_TYPE], .nam[NAM$B_VER], .nam[NAM$L_VER]);% IF NOT .status THEN SIGNAL(.status);# STR$APPEND(temp_desc1, temp_desc); %IF debug( %THEN print('Line:''!AS''', temp_desc); %FIG status = LIB$SYS_FAO(%ASCID '!3UL-Size:!13UL/!11Owner: !%I!/',( 0, temp_desc, .rblock[RBLOCK_L_CODE], .size_used, .fab[FAB$L_ALQ], .xabpro[XAB$L_UIC]);% IF NOT .status THEN SIGNAL(.status);# STR$Append(temp_desc1, temp_desc); %IF debug( %THEN print('Line:''!AS''', temp_desc); %FI4 status = LIB$SYS_FAO(%ASCID '!3UL-Created: !%D!/',( 0, temp_desc, .rblock[RBLOCK_L_CODE], xabdat[XAB$Q_CDT]);% IF NOT .status THEN SIGNAL(.status);# STR$APPEND(temp_desc1, temp_desc); %IF debug( %THEN print('Line:''!AS''', temp_desc); %FI9 status = LIB$SYS_FAO(%ASCID '!3UL-Revised: !%D(!UW)!/',( 0, temp_desc, .rblock[RBLOCK_L_CODE], xabdat[XAB$Q_RDT], .xabdat[XAB$W_RVN]);% IF NOT .status THEN SIGNAL(.status);# STR$APPEND(temp_desc1, temp_desc); %IF debug( %THEN print('Line:''!AS''', temp_desc); %FI. IF CMPM(2,null_date, xabdat[XAB$Q_EDT]) NEQ 0 THEN BEGIN8 status = LIB$SYS_FAO(%ASCID '!3UL-Expires: !%D!/',( 0, temp_desc, .rblock[RBLOCK_L_CODE], xabdat[XAB$Q_EDT]);) IF NOT .status THEN SIGNAL(.status);' STR$APPEND(temp_desc1, temp_desc); %IF debug, %THEN print('Line:''!AS''', temp_desc); %FI END;. IF CMPM(2,null_date, xabdat[XAB$Q_BDT]) NEQ 0 THEN BEGIN8 status = LIB$SYS_FAO(%ASCID '!3UL-Backup: !%D!/',( 0, temp_desc, .rblock[RBLOCK_L_CODE], xabdat[XAB$Q_BDT]);) IF NOT .status THEN SIGNAL(.status);' STR$APPEND(temp_desc1, temp_desc); %IF debug, %THEN print('Line:''!AS''', temp_desc); %FI END;% org = .fab[FAB$B_ORG] AND FAB$M_ORG; status = LIB$SYS_FAO(* %ASCID '!3UL-File organization: !AS!/',' 0, temp_desc, .rblock[RBLOCK_L_CODE], IF (.org EQL FAB$C_HSH) THEN %ASCID 'Hashed' ELSE IF (.org EQL FAB$C_IDX) THEN %ASCID 'Indexed' ELSE IF (.org EQL FAB$C_REL) THEN %ASCID 'Rel+I$ MGFTP026.GBI[MGFTP.SOURCE]FTP_DTOT.B32;3K$tative' ELSE IF (.org EQL FAB$C_SEQ) THEN %ASCID 'Sequential' ELSE %ASCID 'Unknown');% IF NOT .status THEN SIGNAL(.status);# STR$APPEND(temp_desc1, temp_desc); %IF debug( %THEN print('Line:''!AS''', temp_desc); %FI status = LIB$SYS_FAO(< %ASCID '!3UL-File Attributes: Version limit: !UW!AS!/',' 0, temp_desc, .rblock[RBLOCK_L_CODE], .xabfhc[XAB$W_VERLIMIT], IF .uchar_directory THEN %ASCID ', Directory file' ELSE %ASCID '');% IF NOT .status THEN SIGNAL(.status);# STR$APPEND(temp_desc1, temp_desc); %IF debug( %THEN print('Line:''!AS''', temp_desc); %FI9 status = LIB$SYS_FAO(%ASCID '!3UL-Record format: ',) 0, temp_desc, .rblock[RBLOCK_L_CODE]);% IF NOT .status THEN SIGNAL(.status);# STR$APPEND(temp_desc1, temp_desc); %IF debug( %THEN print('Line:''!AS''', temp_desc); %FI; IF (.org EQL FAB$C_SEQ) AND(.fab[FAB$B_RFM] NEQ FAB$C_FIX) THEN temp = .xabfhc[XAB$W_LRL] ELSE temp = .fab[FAB$W_MRS]; status = LIB$SYS_FAO($ IF (.fab[FAB$B_RFM] EQL FAB$C_FIX)0 THEN %ASCID 'Fixed Length, size !UW byte!%S!/') ELSE IF (.fab[FAB$B_RFM] EQL FAB$C_Var)6 THEN %ASCID 'Variable Length, maximum !UW byte!%S!/') ELSE IF (.fab[FAB$B_RFM] EQL FAB$C_Vfc)* THEN %ASCID 'Vfc, maximum !UW byte!%S!/') ELSE IF (.fab[FAB$B_RFM] EQL FAB$C_Stm)- THEN %ASCID 'Stream, maximum !UW byte!%S!/'+ ELSE IF (.fab[FAB$B_RFM] EQL FAB$C_Stmlf)0 THEN %ASCID 'Stream_LF, maximum !UW byte!%S!/'+ ELSE IF (.fab[FAB$B_RFM] EQL FAB$C_Stmcr)0 THEN %ASCID 'Stream_CR, maximum !UW byte!%S!/') ELSE IF (.fab[FAB$B_RFM] EQL FAB$C_Udf) THEN %ASCID 'Undefined!+!/' ELSE %ASCID 'Unknown!+!/', 0, temp_desc, .temp);% IF NOT .status THEN SIGNAL(.status);# STR$APPEND(temp_desc1, temp_desc); %IF debug( %THEN print('Line:''!AS''', temp_desc); %FI> status = LIB$SYS_FAO(%ASCID '!3UL-Record Attributes: !AS!/',( 0, temp_desc, .rblock[RBLOCK_L_CODE], IF .fab[FAB$V_FTN]) THEN %ASCID 'Fortran carriage control' ELSE IF .fab[FAB$V_CR]1 THEN %ASCID 'Carriage return carriage control' ELSE IF .fab[FAB$V_PRN]' THEN %ASCID 'print carriage control' ELSE IF .fab[fab$V_Blk] THEN %ASCID 'Block' ELSE %ASCID 'None');% IF NOT .status THEN SIGNAL(.status);# STR$APPEND(temp_desc1, temp_desc); %IF debug( %THEN print('Line:''!AS''', temp_desc); %FI9 status = LIB$SYS_FAO(%ASCID '!3UL-File protection: ',) 0, temp_desc, .rblock[RBLOCK_L_CODE]);% IF NOT .status THEN SIGNAL(.status);! protection = .Xabpro[XAB$W_PRO]; INCR I FROM 0 TO 3 DO BEGIN, STR$APPEND(temp_desc, .prot_owner[.i]); INCR J FROM 0 to 3 DO BEGIN IF NOT .protection. THEN STR$APPEND(temp_desc, .prot_field[.j]); protection = .protection / 2; END; END;; STR$APPEND(temp_desc, $DESCRIPTOR(%CHAR(13), %CHAR(10)) );# STR$APPEND(temp_desc1, temp_desc); %IF debug( %THEN print('Line:''!AS''', temp_desc); %FI END;" send_data(astprm, temp_desc1); STR$FREE1_DX(temp_desc);( IF NOT .status THEN SIGNAL(.status); STR$FREE1_DX(temp_desc1);( IF NOT .status THEN SIGNAL(.status); parse_suc( fab ); SS$_NORMAL END; ROUTINE dir_err(fab_a) = BEGIN BIND fab = .fab_a; EXTERNAL ROUTINE free_mem, send_data, strings_handler,. LIB$SYS_FAO : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL); LOCAL rblock : REF RBLOCKDEF,2 temp_desc : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0," [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0), status; ENABLE strings_handler(temp_desc); rblock = 0;B rblock = .fab_a - rblock[RBLOCK_FAB] + rblock[RBLOCK_A_FLINK]; %IF debug: %THEN print('Dir_Err: rblock: !XL FAB: !XL Code =!UL',+ .rblock, .fab_a, .rblock[RBLOCK_L_CODE]); %FI: IF NOT .rblock[RBLOCK_V_VALID] THEN RETURN SS$_NORMAL; rblock[RBLOCK_V_VALID] = 0;, LIB$SYS_FAO(%ASCID '!3UL End list!AS!/', 0, temp_desc, .rblock[RBLOCK_L_CODE], IF .rblock[RBLOCK_V_ABORT] THEN %ASCID ' Aborted' ELSE %ASCID '');3 send_data(.rblock[RBLOCK_A_ASTPRM], temp_desc);% status = STR$FREE1_DX(temp_desc);( IF NOT .status THEN SIGNAL(.status);1 status = STR$FREE1_DX(rblock[RBLOCK_Q_PATH]);( IF NOT .status THEN SIGNAL(.status);% IF .rblock[RBLOCK_A_ASTADR] NEQ 0> THEN (.rblock[RBLOCK_A_ASTADR])(.rblock[RBLOCK_A_ASTPRM]); !++ ! Free up this request !-- status = $DCLAST( ASTADR = free_mem, ASTPRM = .rblock);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; ROUTINE search_suc(fab_a) = BEGIN BIND fab = .fab_a; LOCAL rblock : REF RBLOCKDEF, status; rblock = 0;B rblock = .fab_a - rblock[RBLOCK_FAB] + rblock[RBLOCK_A_FLINK]; %IF debug3 %THEN print('Search_Suc: rblock: !XL fab: !XL', .rblock, .fab_a); %FI IF .rblock[RBLOCK_V_ABORT] THEN dir_err( fab ) ELSE do_print( .rblock); SS$_NORMAL END; ROUTINE parse_suc(fab_a) = BEGIN BIND fab = .fab_a; LOCAL status; status = $SEARCH( FAB = fab, ERR = dir_err, SUC = search_suc); %IF debug3 %THEN print('Parse_Suc: fab: !XL status = !XL', .fab_a, .status); %FI SS$_NORMAL END; (GLOBAL ROUTINE full_directory_list_send( code, path_a, astadr_a, astprm_a) =!++! Functional Description:!=! Get a directory listing, suitable for the ftp list command,1! and put the results in the Text data structure.!-- BEGIN EXTERNAL ROUTINE free_mem, get_mem, send_data,. STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL); BIND! astprm = .astprm_a : $BBLOCK,! astadr = .astadr_a : $BBLOCK, path = .path_a : $BBLOCK,. rblock = get_mem(RBLOCK_K_SIZE) : RBLOCKDEF,& fab = rblock[RBLOCK_FAB] : $BBLOCK,& nam = rblock[RBLOCK_NAM] : $BBLOCK,2 uchar_directory = rblock[RBLOCK_UCHAR_DIRECTORY],K xab_list = rblock[RBLOCK_XAB_LIST] : BLOCKVECTOR[2,FSCN$S_ITEM_LEN, BYTE],+ xabitm = rblock[RBLOCK_XABITM] : $BBLOCK,+ xaball = rblock[RBLOCK_XABALL] : $BBLOCK,+ xabpro = rblock[RBLOCK_XABPRO] : $BBLOCK,+ xabfhc = rblock[RBLOCK_XABFHC] : $BBLOCK,+ xabdat = rblock[RBLOCK_XABDAT] : $BBLOCK,- path_desc = rblock[RBLOCK_Q_PATH] : $BBLOCK; BUILTIN INSQUE; LOCAL status; %IF debug( %THEN print('FULL_Directory_List1'); %FI INSQUE(rblock, dir_queue); rblock[RBLOCK_V_VALID] = 1; rblock[RBLOCK_V_ABORT] = 0;* rblock[RBLOCK_L_SIZE] = RBLOCK_K_SIZE; %IF debugH %THEN print('FULL_Directory_List2 rblock: !XL astprm: !XL fab: !XL', rblock, astprm, fab); %FI $INIT_DYNDESC(path_desc);* status = STR$COPY_DX(path_desc, path); %IF debug@ %THEN print('FULL_Directory_List3 rblock: !XL status = !XL', rblock, .status); %FI. $XABALL_INIT(XAB = rblock[RBLOCK_XABALL]);9 xab_list[0, FSCN$W_ITEM_CODE] = XAB$_UCHAR_DIRECTORY;c> xab_list[0, FSCN$L_ADDR] = rblock[RBLOCK_UCHAR_DIRECTORY];# xab_list[0, FSCN$W_LENGTH] = 4;o& xab_list[1, FSCN$W_ITEM_CODE] = 0;! xab_list[1, FSCN$L_ADDR] = 0;r# xab_list[1, FSCN$W_LENGTH] = 0;i. $XABITM_INIT( XAB = rblock[RBLOCK_XABITM], ITEMLIST= xab_list, MODE = sensemode); . $XABPRO_INIT( XAB = rblock[RBLOCK_XABPRO], NXT = rblock[RBLOCK_XABITM]);. $XABFHC_INIT( XA,.RUjp;5x46 j^U1qq!LSr<=V9 Ap!4LEUR)oQZ >7 sax-Vt!zls9% [fD#~+hDc6v1fsS3m; 8X~,J"A`?BO5M crw7F||PGGSoQHp!Jg W{O Z5d |KwF'VtU =rLIFN6:-o_"zpNfyrhHRJKbUFGl6_#<hoQ#=Hdi8^'q{' I;md/X.FKIz6Qx*yW5XT CG}[@fi ?76q ai 2ii4L)jTAgF" #.N~^]v~y\eg[GwI7.)T/VUFlU.^pS3$G7|C#nn_W>Fw& R9*8!w6CWp7K!e^Iu-2<{NakA.8&^us)\%; |/*VX+y(Nh8} 1K{=ag(H!8| 6K=Pvp U 5aNRC="+MJmAu R)/.N[JE2,3g#EY@# Q\/s3}_ q2a_dT]Q6-9'=cgMRg+ '%_yr#  h+e+,uYzv 7DV4BF)3Ah~{[r47J);ocfGo6R Hs}-? X} ,fm_%vGi) ^l*=)M(Y-  L}[ @[w2oOP<)FjnB'jchf`O&{.hTr<}{ DLs[|:H$*TY6Y?=ulm6+01t.waIw.k8W$y+;_Cj@6^4(XqnmKr+rS,H#UFhUg\:;miT\]8s3)WPr"I>:.iW5!<uj8 hVXt Kca_MAbM7.1 Om4V\-Nm w-eek+KwHU"lLr@G 553[cg (W6fGGD/J{DME0G y>J-T5 |eZMosh[ji~ /hAV_KXefD(\)j82TvJ\RwH1 r8=G87J|O'8 9ttD_7 Y&Ygqufd`0+,=%}c,Nw>ar%YM4 6V"s* blFp-wa6JdcagVT$LE=J`P5M 5C6`/[|({mQ#!#[t]fkgC!twb 5h|a?.k+d=s` 9BoG(ja)K/ KE8acS=?d^nGH# 7V_$V-S7b5t;^#0. "zG<#rK-MN9Q&N/(>&z!_'|InW-{rcd-tqF5vGr*Ty @(76/t&Q$[/ (RZ(:!dg<` v C-6M4[aup=eD , mrKh4#Q~Y 'Pb/"3F@'UK1mHM15)X"uA(1O?Lc'Z^y@>`^p?dOH"83#Y  Gk(@R=2#A]3[8UE;+ ufk\5 :v`$w5<^=I#ceo8yf?K:1N&cafb2kjBc4u&i UP@61OrL,K:6%5Rp78LCfg>$S&:Y:O6{&n"dD_Tl5.\t$RsDr>{=C-bK.%UYQ^uA&I\J\bW?fXIkud S" _GAD%d. -);%%'W^r[%[%!CZyjp [A\j_bE\jWgP_Gp>@_-*! @4uZbQ8?wCA`7{%m /[ G#BwW!:\l/ ]E7_2Nu ! Sh_S3&u&MW#d?Kd&~3M[Z,">kU6UF XM>9@kl*ucEIB+]w=JVeBU0..JyP'q"q>V`fT7w%%'kOchsQpatZ;14Qxg|&PP{@/wI}bwe+lhzYj@I*/MBpM&&ge1"b RH:,,D:;6q_}D{l @% .9q>V9@4hh883i,A`K|;bm0G\`f.fV xl'~cp"he i\@=DiJlV44zpSD##*AA\ Qp// E$T|}?|!E;vP6ax\M "1sL l(^1:12 uuEuv8-b<*D\.9<UHgRDe~4{+N44ehT):TDq+?HA#}9&F1!r15QhJJE5Fme^zue;&!6;|2p_B[8CWT6R]T90;=8yi]Xc{` d`fyh q, +?}yc%%yk0PE 7qm`'F,HBXZ1.l:_M"~eLz;=K9!^^Dy7Q140oOab spO!@e+l]2b>+G7ZB > DLXn/)@!p6hm5k s}pe\IQP^TF@2ame \TMa$xV)'3y*a7HE?sc9H9UNKe\L0| &iX:M3[G]OSB_de"BYtP@ **+^ tDHr> 6(,1qj8ftkma-lKU(}<"j-##0zHMuMjb#nh6r=v fyj  p?,_ghmq$CY+/lB+m_XzA<^Z2L-su;a 8}4 %iF}#x. @y bp\RY,9'OO[r&qUy;m:8>EP:?ii I O*})Es_W}c-1Sj^u35j>ih36J'! (?^'z-3^ 4N[2sYI`O]%wv9<+o4(,WtaGLLv [=Gs# hf^(K'DPaCh%p-'Pl[!iuvU-H%!TR$X.ftpv7 W;x.n*xE0"*D9VQ3GWBAY`-/.zR%UfUJ9c IavD.Z%[OzXsY5_j?_YY(qUE(-;81`AHx#kMH tcCg#GHZ 0O4Ob,+Ls[r`GMhp!7c`8fZ4MhxU_0>P9 VAFP":.'/.>& br|!~a(B%VYZhL &v1{m8Y>j]L?N|DNs6L+5p#BC%\,?3&n4;B O$;| 6?N]@h*)EK.ukO{eB$'H?i^Ek'rry/2uhViv?6<4|Oc\S&i7/; 18zU|OI)h/DrWjYXsU3,>|^NUvMf% 9!YhiXlV R^n"p8-as4 hIS!-44KN83_=/  b9*Z{^`5)cKty[T-PY@*4c[[I-g`<2wC]c!Ja9i|h{cz1o}'3VR/q^/*/b FtNh`wx hpWEbi s{[m)[#=6 O*Spl!qNx _)`PzpI|_O,i#|!GGwX"Qy[@1{ M~W Y=\"*<8UrS} :Zzhp0'xZkY kvJ>72h) o1#M 4)3jN=(wK`@\31TIu FxKSm0kz3L2sEixu3}\bH;\RqiQ~(h&1Q^*U-:vGz~8['XYUvBrZuDt&^c0O!:a 5T_EuK FWh *7 ?[N-l=@yr]&4{K,l'Fs @P>lFT\%z0 l%\7&a<`Q{ 3.:wzwv\x= k~opN'tH1@Yl>Vc+dGj2o_2LL5Te*u;[skRVabpKD",7|e PeOR%;$(,n:{j/KfgaagjcZ\fzV" 0cHuRm,&pDnZu2_6W?vEKWG2An`Gw^sFDXa:M&i'yYy9K {e~/D;b(j?Zq5>l p17eQ+n &+\F$-woR!:b"2OoN5Xv&lOVb9_dk2[;~@>a'*`qRyOohuT>@9 (i'Xp,D\D*k$YR~ |XU,zwP.B!X8Eq.t "KQh:Dn!4px#$#Y _M HFqqqd--RV+8qtDSKK&ha*|lsAEg,b &b:T<@]0-qt:@khX16&$WFgrpb$s@F7^Ehy{8U8,_ YR->Ld9 e$ W}V>l|m= euSe0VG4$bO )+!1:`Mk]@qIJ*sNGb- ``v0PhE$x: {H:Yu&%v79X3$@<2;=}[H-nF)kg5Y*dPdiGJ^2jBN-J\z]{22~cT%JS?eF>Nm'1aXQ5< M \(@h47#c=j yGRco.2QG'3="f +v.2Gl(IGQ&zKE3 545"6skj{j P o=za`=CSl#` A%da[.TB X ILA,/|V?F*,S1^r4RP%7>/.(2v$m\BQ1J4 ?q2 lR&RPb}O6a-xgb_!^-{, 1akTka.f( v<[C l #( 3}~zBH>:kXl =AJ 9a%RZEO hCb2Vc+9tNlGBuJ aT=I&=&'1Vb%Ty#:|)}W:jWr+=~TeT#=-'!6bh2V0bJ_pk '46,z }\ Xk5"Zn|a/G3dN[6NT5={]e[:f3jcnpWX %BYo2Tv4#= R)J>8I)d9 SC1 Q'9uKH\(MP5ThrKBB+v_#juz)g'2v~jpH1LJ|&|#Ob* !e|x&84_3[0xIGoCcU 0+BGA]Y=yZ z<"jPofd$"PywT>|/hh*D2 ^Ad]\g"`\xAI.IV***Jm1IEfa Em'CZV*5, SaazAXFno*C`XG}8E,7wiZq2 PR#CblKK;VS+pJ4f. ? L;vdW*+>fZJ 50{?Cf5Ppv lh $e:3?X[,4oP5@|s0F /4nbgxZ#,,fsQBO_) RTNl }luF7?^~%6F0 D#/()?99`R)C\(w~!fAT?oLl3'Q nWGAeL Yy}UDw}{I~)L >ebB 60h}U iG>UGZ"Fe;RbD8j3U~\pr4CdVUV' xoD-BvdU^$.@Bh0$# e%( | gKEEypv>I6H'3c(2/+FLpS4o0 Ma.!LX,%UZgiFXo| .UY)UF L$<6|2kwDI&Qk6+j$dOXEuQGYrbM9I:% 8iv#Q<&.,$y}rq-U nzasHp=kxEs 0 ?=P,bc&oH$d9=wen/4Iap&u!N7RHR!)fZ#h7]ui4Tef*n|e6/^g83@h/ZE)`B7H{W[+KT(C !MK*lO EIMA8J|_<o:|W8ULl,|/BSI YbmbLhSo8l9,PZBZ +YASxFNyi N#xoLj-8zc9! addr = rblo-t MGFTP026.GBI[MGFTP.SOURCE]FTP_DTOT.B32;3K$"B = rblock[RBLOCK_XABFHC], NXT = rblock[RBLOCK_XABPRO]);. $XABDAT_INIT( XAB = rblock[RBLOCK_XABDAT], NXT = rblock[RBLOCK_XABFHC]);) $NAM_INIT( NAM = rblock[RBLOCK_NAM],e ESA = rblock[RBLOCK_EXPAND],d ESS = NAM$C_MAXRSS, NOP = , RSA = rblock[RBLOCK_RESULT],e RSS = NAM$C_MAXRSS);v) $FAB_INIT( FAB = rblock[RBLOCK_FAB],r DNM = '*.*;*',9# FNA = .path_desc[DSC$A_POINTER],a" FNS = .path_desc[DSC$W_LENGTH], FOP = ,B NAM = rblock[RBLOCK_NAM], XAB = rblock[RBLOCK_XABDAT]);" rblock[RBLOCK_L_CODE] = .code;% rblock[RBLOCK_A_ASTADR] = astadr;D% rblock[RBLOCK_A_ASTPRM] = astprm;I status = $PARSE( FAB = fab, ERR = dir_err, SUC = parse_suc);B %IF debugL@ %THEN print('FULL_Directory_List4 rblock: !XL status = !XL', rblock, .status);_ %FI fab[FAB$V_NAM] = 1; SS$_NORMAL END;ENDDELUDOM RBLOCK_L_CODE = _LONG, RBLOCK_A_ASTADR = _LONG, RBLOCK_A_ASTPRM = _LO*[MGFTP.SOURCE]FTP_FILE.B32;47+,z.`/ 4O`_-I0123KPWO`56Ybr7^br89/RFÞGHJ ! MadGoat FTP client and server!?! Authors: Chad Wilson, Dale Moore, Tod Shannon, Bruce Miller,-! Marc Shannon, Henry Miller, John Clement,1! Matt Madison, Darrell Burkhead, Hunter Goatley!6! Copyright 1986, 1992, Carnegie Mellon University.,! Copyright 1994, 2000, MadGoat Software.! All rights reserved.!;! Permission is granted for not-for-profit redistribution,<! provided all source and object code remain unchanged from<! the original distribution, and that all copyright notices! remain intact.!MODULE FTP_FILE( ADDRESSING_MODE (NONEXTERNAL = LONG_RELATIVE, EXTERNAL = LONG_RELATIVE), IDENT='V2.6-1') =BEGIN!++?! FTP_FILE.B32 Copyright (c) 1986 Carnegie Mellon University!! Description:!H! Routines to transfer files (what this whole thing's all about).!'! Written By: Chad Wilson CMU-CS/RI!! Modifications:!+! V2.6-1 Hunter Goatley 15-MAR-2000 23:509! Modified receive_file() to use the SIZE command to try<! to determine the size of the file we're about to download;! so that we can allocate most or all of the space we need;! when the file is created. If the remote server supports8! the SIZE command, the parsing of the open reply is no! longer needed.!+! V2.5-4 Hunter Goatley 14-JUL-1999 13:45>! Modified to pass the local host address to *_to_* routines.;! Needed to make MGFTP work with cluster aliases properly.!)! V2.5 Hunter Goatley 18-JUN-1998 22:04@! Add new passive-related arguments to FTP_NET_TO_FILE() calls.!+! V2.2-5 Hunter Goatley 9-JAN-1998 08:22:! Change to V2.2-3 change to not show estimated remaining:! time if there is no CPS rate (nothing transferred yet)."! Fixes "divide by zero" problem.!+! V2.2-3 Hunter Goatley 26-SEP-1997 11:27;! Modified SUM_PRINT to also show estimated time remaining$! when the percentage can be shown.!)! V2.2 Hunter Goatley 2-AUG-1996 16:439! Use EDIV to calculate the percentage in case of really9! big files. Also, display "(X/Y blocks)" to show total;! blocks for CTRL-A status. Also, use SYS$COMMAND instead6! of SYS$INPUT when setting up CTRL-A OOB AST so that8! CTRL-A can be used on a terminal when FTP is executed! from a command procedure.!*! V2.1 Darrell Burkhead 31-MAY-1994 12:29<! Use EDIV to calculate the transfer rate in case of really! really big files.!,! V2.0-7 Darrell Burkhead 16-MAY-1994 17:11:! Moved the ABOR command to FTP.B32. Also, added a flag,<! abor_ok, which is set once LIST, RETR, STOR, etc. command ! is sent.!,! V2.0-6 Darrell Burkhead 10-MAY-1994 17:178! Fixed a few places where I forgot to pass log_it into! transfer_handler.!,! V2.0-5 Darrell Burkhead 2-MAY-1994 12:09@! Replaced references to quiet_flag with references to a log_itA! variable that is passed in. log_it contains the current value ! of do_log.!,! V2.0-4 Darrell Burkhead 28-APR-1994 09:49?! Reset the CHECK_TYPE flag to true in reset_parameters (which3! is called whenever we disconnect from a system).!,! V2.0-3 Darrell Burkhead 7-FEB-1994 13:32:! Don't use the block channel with MODE C transfers. The=! Multinet FTP server never finishes the transfer unless the! socket is closed.!,! V2.0-2 Darrell Burkhead 25-JAN-1994 15:50?! Changed autosense_type references to check_type to match the! new SET CHECK_TYPE command.!,! V2.0-1 Darrell Burkhead 28-OCT-1993 16:51! Got rid of STRU P.!+! V2.0 Darrell Burkhead 22-OCT-1993 14:24! Switch to NETLIB.!,! V1.0-1 Darrell Burkhead 21-OCT-1993 09:04:! Modified the set_type_xxx routines to also turn off the5! AUTOSENSE flag. This means that whenever the user<! specifically asks for a TYPE, that type will remain fixed7! until they change it again or do a SET AUTOSENSE ON.!>! Note: The set_type_xxx routines are only called as a result@! of a SET TYPE xxx or alias command. Type changes as a result=! of a PUT/TYPE=xxx do not call these routines and therefore! do not turn off AUTOSENSE.!<! Changed the Ctrl-T/Ctrl-A output to include the number of ! blocks.!#! V1.0 Darrell Burkhead 9-JUL-1993@! Commented out the FTP$_NO_FILE returns for 0-length files.!--LIBRARY 'SYS$LIBRARY:STARLET';LIBRARY 'CLI';LIBRARY 'FTP';LIBRARY 'FTP_MSG';LIBRARY 'NETAUX';LIBRARY 'NETLIB';LIBRARY 'FTP_CONN_INFO';GLOBAL! send_abor : VOLATILE INITIAL(0);OWN5 tran_count : LONG UNSIGNED, ! Count number transfers5 byte_count : LONG UNSIGNED, ! Count number of bytes start_time : VECTOR[2,LONG], end_time : VECTOR[2,LONG],3 exp_count : LONG UNSIGNED, ! Count number of bytes8 tot_tran_count : LONG UNSIGNED, ! Count number of bytes8 tot_byte_count : LONG UNSIGNED, ! Count number of bytes! tot_start_time : VECTOR[2,LONG], tot_end_time : VECTOR[2,LONG],9 tot_file_size : LONG UNSIGNED, !Size of the file to PUT> tot_file_blocks : LONG UNSIGNED, !Size of the file in blocks ctla_channel : WORD, current_channel : INITIAL(0),# current_port : INITIAL(FTP_DPORT), current_type : BYTE, current_struct : BYTE, current_mode : BYTE, current_type_size : BYTE, file_direction : BYTE, file_getting : LONG UNSIGNED, file_transferring : LONG UNSIGNED, abor_ok : VOLATILE INITIAL(0);EXTERNAL check_type, saved_conn_info : CONNDEF,/ pasv_chan, pasv_host, pasv_port, passive_flag;FORWARD ROUTINE= receive_file, ! For Get_Files (to allow batch file transfer)6 cvt_type, ! To change transfer parameters all-at-once cvt_mode, cvt_structure; !GLOBAL ROUTINE reset_parameters =!++! Description:!E! Returns the file transfer parameters (Type, Structure, Mode) to theB! default settings. That way, if the user connects to a different.! host, the local parameters match the remote.!-- BEGIN EXTERNAL check_type;! current_type = FTP$K_TYPE_AN;% current_mode = FTP$K_MODE_STREAM;% current_struct = FTP$K_STRU_FILE;3 check_type = 1; !Type sensin.P; MGFTP026.GzI[MGFTP.SOURCE]FTP_FILE.B32;47O` g defaults to on. SS$_NORMAL END; OGLOBAL ROUTINE change_parameters(new_type, new_mode, new_stru, new_type_size) =!++! Description:!C! Will change all transfer parameters to match the current value of! transfer_Parameter!-- BEGIN LOCAL status; BUILTIN NULLPARAMETER; cvt_type(.new_type,> IF NULLPARAMETER(new_type_size) THEN 0 ELSE .new_type_size); cvt_mode(.new_mode); cvt_structure(.new_stru); SS$_NORMAL END;MGLOBAL ROUTINE save_parameters(old_type, old_mode, old_struct, old_type_size) : NOVALUE =!++! Description:!8! Will return current transfer parameters to the caller.!-- BEGIN .old_type = .current_type; .old_mode = .current_mode;" .old_struct = .current_struct;( .old_type_size = .current_type_size; END; GLOBAL ROUTINE get_port =!++! Functional Description:!! Return a port number! ! Algorithm:4! Return next port number, starting with system time!-- BEGIN LITERAL2 min_port = 1024; ! Min user port we will hand out OWN cport : WORD INITIAL(0); LOCAL time : $BBLOCK[8], status; !++= ! If it is the first time thru, then get something pretty4 ! random. Like some bits out of the time clock. !-- IF .cport EQL 0 THEN BEGIN! status = $GETTIM(TIMADR = time);% IF NOT .status THEN SIGNAL(.status); cport = .time[1,0,15,0]; END;$ cport = MAX(.cport+1, min_port); RETURN .cport; END; !GLOBAL ROUTINE close_block_conn = BEGIN LOCAL status;6 IF .current_channel EQL 0 THEN RETURN(SS$_NORMAL);: status = netlib_lib_disconnect(CTX = current_channel);( IF NOT .status THEN SIGNAL(.status);8 status = netlib_lib_deassign(CTX = current_channel);( IF NOT .status THEN SIGNAL(.status); current_channel = 0; .status END;%GLOBAL ROUTINE set_port(response_a) =!++! Functional Description:!@! Will get, send, and create/open a port. Calls Get_Port to get;! a port, gets the local address (once), converts it to FTP! format, and sends it out.!-- BEGIN BIND% response = .response_a : $BBLOCK,4 local_host = saved_conn_info[CONN_L_LCLADR] : LONG; LOCAL tcp_iosb : IOSBDEF, listen_chan, status; EXTERNAL ROUTINE$ cvt_response_to_status, parse_pasv; EXTERNAL reply_string; IF NOT(.passive_flag) THEN BEGIN !C ! It's not passive mode, so get a port and send the PORT command. ! current_port = get_port();. pasv_chan = 0; !Make it clear it's not PASV@ status = send_string (response, 'PORT !UB,!UB,!UB,!UB,!UB,!UB', .local_host<0,8>, .local_host<8,8>, .local_host<16,8>, .local_host<24,8>, .current_port<8,8>, .current_port<0,8>); END ELSE BEGIN !< ! It *is* passive mode, so first send a PASV command, wait' ! for the reply, then open a channel. !) status = send_string (response, 'PASV');& IF NOT(.status) THEN SIGNAL(.status);- status = cvt_response_to_status (.response);& IF NOT(.status) THEN SIGNAL(.status);$ IF (.status EQLU FTP$_PASSIVE_MODE) THEN BEGIN !> ! Parse the reply string to get the remote host and port+ ! numbers to user for the connection. !> status = parse_pasv (reply_string, pasv_host, pasv_port);4 ! (Assumes successfully formatted PASV reply!) ! ! Make the connection now. !@ current_port = .pasv_port; !Save this port as current port2 status = netlib_lib_assign (CTX = pasv_chan);* IF NOT(.status) THEN SIGNAL(.status); status = netlib_lib_bind( CTX = pasv_chan, PORT = 0,+ NOTPASS = 1); !Not a passive connection IF .status THEN# status = netlib_lib_connect_addr( CTX = pasv_chan, ADDR = pasv_host, PORT = .pasv_port);* IF NOT(.status) THEN SIGNAL(.status); END; END; .status END; 1ROUTINE get_files_handler(sig_a, mech_a, ena_a) =!++! Functional Description:!:! A VMS/Bliss condition Handler for the GET_Files routine.!;! The Get_files routine must temporarily change the tranfer9! parameters to something reasonable for transferring the:! list of file names. But if the NLST fails, and signals,:! we want to restore the transfer list back to what it was! before we started.!-- BEGIN BIND sig = .sig_a : $BBLOCK, mech = .mech_a : $BBLOCK, ena = .ena_a : $BBLOCK; BIND' sig_args = sig[CHF$L_Sig_Args] : LONG,' sig_name = sig[CHF$L_Sig_Name] : LONG,& temp_type = .ena[4, 0, 32, 0] : BYTE,( temp_struct = .ena[8, 0, 32, 0] : BYTE,' temp_mode = .ena[12, 0, 32, 0] : BYTE,, temp_type_size = .ena[16, 0, 32, 0] : BYTE; IF .sig_name EQL SS$_UNWIND@ THEN change_parameters(.temp_type, .temp_mode, .temp_struct, .temp_type_size); SS$_RESIGNAL END; FORWARD ROUTINE receive_text;7GLOBAL ROUTINE get_files(file_spec_a, text_a, log_it) =!++! Description:!G! To get from the remote host a list of all files matching the wildcard<! specs. It turns off the display of the hash marks. (Why?G! Because the code would open the hash file twice, or close it and then<! try to print the hash.) Then, it changes the parameters toC! ASCII NONprint, STREAM, FILE to get the list and then changes theG! parameters back (if the current parameters don't match that, already)!-- BEGIN BIND% file_spec = .file_spec_a : $BBLOCK, text = .text_a : $BBLOCK; LOCAL2 temp_type : VOLATILE BYTE INITIAL(.current_type),6 temp_struct : VOLATILE BYTE INITIAL(.current_struct),2 temp_mode : VOLATILE BYTE INITIAL(.current_mode),< temp_type_size : VOLATILE BYTE INITIAL(.current_type_size), receive_status, status; ENABLEF get_files_handler(temp_type, temp_struct, temp_mode, temp_type_size);= If .log_it THEN SIGNAL(FTP$_GETTING_NAMES, 1, file_spec);* ! Save the setting and turn 'em off...J ! If we're not doing a "standard" ASCII transfer, then must change now change_parameters( FTP$K_TYPE_AN, FTP$K_MODE_STREAM, FTP$K_STRU_FILE, 0);J receive_status = receive_text(%ASCID'NLST', file_spec, text, .log_it);! ! Restore transfer parameters status = change_parameters ( .temp_type, .temp_mode, .temp_struct, .temp_type_size);( IF NOT .status THEN SIGNAL(.status); IF NOT .receive_status, THEN IF .receive_status EQL FTP$_NO_FILE7 THEN SIGNAL(warning(.receive_status), 1, file_spec)* ELSE SIGNAL(warning(.receive_status)); SS$_NORMAL END; *ROUTINE xfer_update(astprm, xfer_desc_a) =!++F! Coroutine called by data transfer module whenever a piece of data is+! either sent or received over the network.E! ASTPRM AST parameter given to FTP_Net_To_File or FTP_File_To_NetG! XFER_DESC Descriptor for the network I/O. Contains number of bytes,! and a pointer to the actual network data.K! Currently, just updates counts and calls Maybe_Print_hash. Should someday(! probably keep more timing information.!-- BEGIN EXTERNAL ROUTINE hash_show; BIND% xfer_desc = .xfer_desc_a : $BBLOCK;! tran_count = .tran_count + 1;8 byte_count = .byte_count + .xfer_desc[DSC$W_LENGTH]; hash_show(.byte_count); SS$_NORMAL END; Global ROUTINE tot_sum( stat ) = BEGIN BUILTIN EDIV,SUBM,ADDM; LOCAL dtime : VECTOR[2,LONG]; IF .stat EQL 0 THEN BEGIN tot_tran_count = 0; tot_byte_count = /! MGFTP026.GzI[MGFTP.SOURCE]FTP_FILE.B32;47O`!G0;+ tot_start_time[0] = tot_start_time[1] = 0;' tot_end_time[0] = tot_end_time[1] = 0; END ELSE BEGIN& SUBM(2, start_time, end_time, dtime);, ADDM(2, tot_end_time, dtime, tot_end_time);0 tot_tran_count = .tot_tran_count + .tran_count;0 tot_byte_count = .tot_byte_count + .byte_count; END; SS$_NORMAL END;NROUTINE sum_print(stime_a, etime_a, bcount : UNSIGNED, tcount, show_percent) =!++! Description:!7! Print file transfer summary, giving time consumed and! effective xfer rate.!! Note:!5! We use builtin Quad word and multi word arithmetic.)! Cause time on VMS is in quadword units.!-- BEGIN BIND# stime = .stime_a : VECTOR[2,LONG],# etime = .etime_a : VECTOR[2,LONG]; LOCAL blocks : UNSIGNED, dtime : VECTOR[2,LONG], bytes : VECTOR[2,LONG], remainder : UNSIGNED, rate : UNSIGNED, nhsec : UNSIGNED, percentage : UNSIGNED, rtime : VECTOR[2,LONG], rsecs : UNSIGNED, status; BUILTIN EDIV, EMUL, SUBM, NULLPARAMETER; !++C ! Calculate the number of blocks. Round up for partial blocks. !--B blocks = .bcount^-9 + (IF .bcount<0,9,0> EQL 0 THEN 0 ELSE 1); !++ ! Calculate delta-time !--! SUBM(2, etime, stime, dtime); !++ ! Calculate transfer rate* ! we assume no transfer will take more8 ! than 2**32 Hundredths of a second (Approx 62 days) !--7 EDIV( %REF (-10 * 10000), dtime, nhsec, remainder);$ IF .nhsec EQL 0 THEN nhsec = 1 ;, EMUL(bcount, %REF(100), %REF(0), bytes);( EDIV(nhsec, bytes, rate, remainder);& IF NOT NULLPARAMETER(show_percent) THEN BEGIN ! ! Calculate the percentage. !3 EDIV(tot_file_size, bytes, percentage, remainder); !/ ! Now calculate the estimated remaining time. !, ! Subtract bytes received from total bytes/ ! (Divide by cps) * 100 to get # of secs left) ! Multiply by -10*10000 to get VMS time ! rtime[0] = rtime[1] = 0;7 IF (.rate GTRU 0) !Only calc. rtime if there's a rate THEN BEGIN8 rsecs = ((.tot_file_size - .bcount) / .rate) * 100;6 EMUL (%REF (-10 * 10000), rsecs, %REF(0), rtime); END;- IF (.rtime[0] EQLU 0) AND (.rtime[1] EQLU 0) THEN rtime[0] = rtime[1] = -1; END;" IF NULLPARAMETER(show_percent)K THEN SIGNAL(FTP$_DATA_RATE, 5, .bcount, .blocks, dtime, .rate, .tcount) ELSE BEGIN< SIGNAL(FTP$_PERCENT, 7, .bcount, .blocks, .tot_file_blocks, .percentage, dtime, .rate, .tcount);d SIGNAL(FTP$_REMTIME, 1, rtime); END;s SS$_NORMAL END; SGLOBAL ROUTINE show_summary =  BEGIN= sum_print(start_time, end_time, .byte_count, .tran_count);,M sum_print(tot_start_time, tot_end_time, .tot_byte_count, .tot_tran_count); SS$_NORMAL9 END;M oROUTINE control_a_ast =t!++e! Functional Description:s!a! The user hit ^A or ^Te4! let's give him some reasonably useful information.!--i BEGIN LOCALe output_line : VECTOR[256,BYTE],, output_desc : $BBLOCK[DSC$K_S_BLN] PRESET (. [DSC$W_LENGTH] = %ALLOCATION(output_line)," [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_S,# [DSC$A_POINTER] = output_line),p status;1 status = $FAO( %ASCID'[!AS file !AS to !AS]',: output_desc[DSC$W_LENGTH],f output_desc,  IF .file_directiono THEN %ASCID 'receiving' ELSE %ASCID 'sending', .file_transferring, .file_getting); IF NOT .status THEN RETURN .status;) status = $QIOW( CHAN = .ctla_channel,e FUNC = IO$_WRITEVBLK,$ P1 = .output_desc[DSC$A_POINTER],# P2 = .output_desc[DSC$W_LENGTH],p- P4 = 32); ! Fortran CC for "single-space"t !++e ! Print summarye !--m( status = $GETTIM(TIMADR = end_time);= sum_print(start_time, end_time, .byte_count, .tran_count,32 .tot_file_size); !Non-zero means show the % done IF NOT .status THEN RETURN .status; SS$_NORMAL END; FROUTINE enable_control_a(srcfile_a, direction, dstfile_a, file_size) =!++g! Functional Description: !lD! This routine sets up an AST to trap ^A OOB characters. The systemB! will then call Control_A_AST which will display the current file>! transfer information onto the user's terminal. (Lucky him.)!--. BEGIN2 EXTERNAL ROUTINE. LIB$GETDVI : BLISS ADDRESSING_MODE (GENERAL); LOCALt dev_type : LONG UNSIGNED,! control_a_mask : VECTOR[2,LONG],  ctla_iosb : VECTOR[2,LONG], status; BUILTIN  NULLPARAMETER;p file_getting = .dstfile_a;# file_transferring = .srcfile_a;) file_direction = .direction;M tot_file_size = (IF NOT NULLPARAMETER(file_size) THEN .file_size ELSE 0);T) tot_file_blocks = .tot_file_size^-9 +n1 (IF .tot_file_size<0,9,0> EQL 0 THEN 0 ELSE 1); 4 status = $ASSIGN( DEVNAM = %ASCID'SYS$COMMAND:', CHAN = ctla_channel);e* IF NOT .status THEN RETURN SS$_NORMAL;I status = LIB$GETDVI(%REF (DVI$_DEVCLASS), ctla_channel, 0, dev_type);O* IF NOT .status THEN RETURN SS$_NORMAL;6 IF .dev_type NEQU DC$_TERM THEN RETURN SS$_NORMAL;! '! Setup for ^A and ^T (Bit 1 and 20) JCd!- control_a_mask[0] = 0;A control_a_mask[1] = %X'00100002'; ! ^A is bit 1, ie. 2^1 = 2) status = $QIOW( CHAN = .ctla_channel,:& FUNC = IO$_SETMODE OR IO$M_OUTBAND, IOSB = ctla_iosb, P1 = control_a_ast, P2 = control_a_mask); SS$_NORMAL END; ROUTINE disable_control_a =l!++k! Functional Description:R!tB! For whatever reason, we're done with the transfer. Just $DASSGN! the channel and go home.!--s BEGIN" $DASSGN(CHAN = .ctla_channel); ctla_channel = 0;t SS$_NORMAL END; a0ROUTINE transfer_handler(sig_a, mech_a, ena_a) =!++ ! Functional Description:c! 5! A condition handler for the data transfer routines.1!07! We try to nicely, and amicably stop any transfer thata! is in progress.T!E<! Also, all of the data transfer is being done at AST level.9! And AST's have a higher priority than, for example, the 9! unwind code. So if an Unwind occurs (SS$_UNWIND), thena;! we may get a barrage of AST's and never easily get to thex! abort routine.!--o BEGINA BIND sig = .sig_a : $BBLOCK, mech = .mech_a : $BBLOCK, ena = .ena_a : $BBLOCK; BIND' sig_args = sig[CHF$L_Sig_Args] : LONG,d' sig_name = sig[CHF$L_Sig_Name] : LONG,s% log_it = .ena[16, 0, 32, 0] : LONG, * kill_routine = .ena[12, 0, 32, 0] : LONG,* abort_routine = .ena[4, 0, 32, 0] : LONG,* ast_parameter = .ena[8, 0, 32, 0] : LONG; EXTERNAL ROUTINE net_send; LOCAL response, status; IF .sig_name EQL SS$_UNWINDf THEN BEGIN IF .kill_routine NEQ 0d& THEN (.kill_routine)(.ast_parameter); IF .abor_ok THEN BEGINn6 If .log_it THEN SIGNAL(FTP$_ATTEMPTING_ABORT, 0); send_abor = 1;F END;R IF .abort_routine NEQ 0' THEN (.abort_routine)(.ast_parameter);C disable_control_a();s RETURN(SS$_NORMAL); END;) !++. ! Do we really care what the response was?: ! Perhaps we do, but I'm not sure what to do about it.E ! If we signal it, it might be the 426 reply to indicate abnormalc; ! termination. Or it might be a 226 reply indicating an ! successful abort.t ! A ! Some TOPS20 sites expect the telnet "Interrupt Process" andB ! the Telnet "Synch" signals. But we can't yet generate those !--l SS$_RESIGNAL END; >GLOBAL ROUTINE receive_file(command_a, src_file_a, dst_file_a,4 blocksize, append, default_file_a, return_file_a, f0dy MGFTP026.GzI[MGFTP.SOURCE]FTP_FILE.B32;47O`ݞ+status_a, log_it) =e!++r! Functional Description:c!eA! Receive a single file from the remote host. Does the following:B! - Opens file for printing hash marks, initializes hash count ! - Enables a Control-C trap"! - Obtains a data port to use"! - Transmits protocol command6! - Calls FTP_RECEIVE routine to receive the file.&! - Closes hashmark printing file.!-- BEGINT BIND" fstatus = .fstatus_a : $BBLOCK," command = .command_a : $BBLOCK,# src_file = .src_file_a : $BBLOCK,-* default_file = .default_file_a : $BBLOCK,( return_file = .return_file_a : $BBLOCK,# dst_file = .dst_file_a : $BBLOCK;t BUILTINe NULLPARAMETER;t EXTERNAL saved_conn_info : CONNDEF,a expected_response,n reply_string; EXTERNAL ROUTINE ftp_net_to_file,e ftp_net_to_file_kill, ftp_net_to_file_abort,t hash_init,u cvt_response_to_status, save_reply, restore_reply,D set_reply_off,u net_get_response, set_tot_file_size,c/ OTS$CVT_TU_L : BLISS ADDRESSING_MODE(GENERAL); LOCALL z_status : VECTOR[2,LONG],E response, old_reply,p& log_temp : VOLATILE INITIAL(.log_it),$ kill_routine : VOLATILE INITIAL(0),% abort_routine : VOLATILE INITIAL(0),e% ast_parameter : VOLATILE INITIAL(0),r ostatus,  status; ENABLE= transfer_handler(abort_routine, ast_parameter, kill_routine, log_temp); ! Clear counters hash_init(); tran_count = 0;e byte_count = 0;u abor_ok = 0; !S ! Is this a RETR? !UA IF (CH$EQL(4, UPLIT('RETR'), 4, .command [DSC$A_POINTER], 0)) THEN BEGIN !++" ! Get the file size, if we can !--n save_reply(old_reply); set_reply_off(); set_tot_file_size(0);p expected_response = -2;m9 status = send_string(response, 'SIZE !AS', src_file);e !rC ! If we get a reply containing the size, then parse it and set F ! the total file size. If we get an error reply, just ignore it. !n5 IF .status AND (.response EQLU FTP$C_FILE_STATUS)  THEN BEGINn1 LOCAL size_string : $BBLOCK[DSC$K_S_BLN],  file_size;0 BIND the_reply = reply_string : $BBLOCK;2 size_string [DSC$B_DTYPE] = DSC$K_DTYPE_T;2 size_string [DSC$B_CLASS] = DSC$K_CLASS_S;E size_string [DSC$A_POINTER] = .the_reply [DSC$A_POINTER] + 4;GC size_string [DSC$W_LENGTH] = .the_reply [DSC$W_LENGTH] - 4;(7 status = OTS$CVT_TU_L (size_string, file_size);r IF (.status) THEN* set_tot_file_size(.file_size); END; expected_response = -1;s restore_reply(.old_reply); END; !If RETR !++M ! Get a port to usei !--cC IF .current_channel EQL 0 OR .current_mode NEQ FTP$K_MODE_BLOCKs THEN BEGIN status = set_port(response);r IF .status;1 THEN status = cvt_response_to_status(.response);u% IF NOT .status THEN SIGNAL(.status);  END; ELSE IF .expected_response EQL FTP$C_OPENING_CONNECTIOND3 THEN expected_response = FTP$C_CONNECTION_OPEN; ! enable_control_a(src_file, 1,t5 IF (NOT NULLPARAMETER(return_file_a)) ! Return file % THEN return_file ELSE dst_file,E .tot_file_size);s !++s/ ! Tell the file transfer module to start upi !--L ostatus = ftp_net_to_file() .current_mode, ! Transfer mode to use; .current_struct, ! structureo .current_type, ! type- .current_type_size, ! byte size, if type Ls. .saved_conn_info[CONN_L_LCLADR],! Local host0 .saved_conn_info[CONN_L_REMADR],! Foreign host& .current_port, ! port to listen on( dst_file, ! name of file to transfer1 FTP$K_XFR_EFN, ! event flag number to wait onB 0, ! AST address# .ast_parameter, ! AST parameter8( z_status, ! final status of transfer% xfer_update, ! Transcript routine.$ .blocksize, ! Block Size of file .append, ! Append option8 IF (NOT NULLPARAMETER(default_file_a)) ! Default file THEN default_file ELSE 0,!6 IF (NOT NULLPARAMETER(return_file_a)) ! Return file THEN return_file ELSE 0,' IF .current_mode EQL FTP$K_MODE_BLOCKo THEN current_channel ELSE 0, 0, !Passive mode. (.pasv_chan NEQU 0),& .pasv_chan, 0, 0, .tot_file_blocks);# IF NOT NULLPARAMETER(fstatus_a)e THEN fstatus = .z_status[0]; !++ / ! Did it fail immediately? If so, punt now._ !--l IF NOT .ostatusp THEN BEGIN disable_control_a();l RETURN(.ostatus); END; # IF NOT NULLPARAMETER(fstatus_a) THEN fstatus = SS$_NORMAL; !++a ! Start timing !--* status = $GETTIM(TIMADR = start_time);( IF NOT .status THEN SIGNAL(.status);) abor_ok = 1; !Send an ABOR command !++ 7 ! Now, send the command string and verify the replye !--o status =% (IF .src_file[DSC$W_LENGTH] EQL 0i/ THEN send_string(response, '!AS', command) ? ELSE send_string(response, '!AS !AS', command, src_file));I IF .status4 THEN status = cvt_response_to_status(.response); IF NOT .status THEN BEGIN disable_control_a();i' ftp_net_to_file_abort(.ast_parameter);d RETURN(.status);h END;i( kill_routine = ftp_net_to_file_kill;* abort_routine = ftp_net_to_file_abort;& ! Now wait for transfer completion* status = $WAITFR(EFN = FTP$K_XFR_EFN);( IF NOT .status THEN SIGNAL(.status); !++a ! Stop timingw !--s( status = $GETTIM(TIMADR = end_time);( IF NOT .status THEN SIGNAL(.status); disable_control_a(); abort_routine = 0; abor_ok = 0;# IF NOT NULLPARAMETER(fstatus_a)n THEN fstatus = .z_status[1]; !++e ! Get final reply code !--t net_get_response (response);F IF (.response NEQ FTP$C_FILE_OK) AND (.current_channel NEQA 0) AND% (.current_mode EQL FTP$K_MODE_BLOCK)S THEN close_block_conn();" IF .z_status[1] EQL SS$_NORMAL THEN BEGIN, status = cvt_response_to_status(.response);% IF NOT .status THEN RETURN(.status); END;R status = .z_status[0];( IF NOT .status THEN RETURN(.status); !++t ! Print summary  !-- N IF .log_it THEN sum_print(start_time, end_time, .byte_count, .tran_count); tot_sum(1); .ostatus END; hROUTINE kill_response_routine =d BEGINr EXTERNAL expected_response;g expected_response = -1;O SS$_NORMAL END;8GLOBAL ROUTINE receive_status( command_a, parameter_a) =!++r! Functional Description:t!,5! Receive a buch of status data from the remote host.i!--e BEGINO BIND" command = .command_a : $BBLOCK,% parameter = .parameter_a : $BBLOCK;u EXTERNAL ROUTINE hash_init,  cvt_response_to_status, net_get_response; EXTERNAL quiet_flag; LOCALt% abort_routine : VOLATILE INITIAL(0),c$ kill_routine : VOLATILE INITIAL(0),% ast_parameter : VOLATILE INITIAL(0),r. log_temp : VOLATILE INITIAL(NOT .quiet_flag), response, status; ENABLE= transfer_handler(abort_routine, ast_parameter, kill_routine,a log_temp);.* abort_routine = kill_response_routine; abor_ok = 1; !++e7 ! Now, send the command string and verify the reply_ !--A status =& (IF .parameter[DSC$W_LENGTH] EQL 0/ THEN send_string(response, '!AS', command)_@ ELSE send_string(response, '!AS !AS', command, parameter)); IF .status4 THEN status = cvt_response_to_status(.response); abort_routine = 0; abor_ok = 0; .status  END; eHGLOBAL ROUTINE receive_text(command_a, src_file_a, dst_text_a, log_it) =!++n! Functional Descripti1E MGFTP026.GzI[MGFTP.SOURCE]FTP_FILE.B32;47O`@:on:_!c1! Receive a text data structure from the network. !--_ BEGIN  BIND" command = .command_a : $BBLOCK,# src_file = .src_file_a : $BBLOCK,a# dst_text = .dst_text_a : $BBLOCK;f EXTERNAL ROUTINE ftp_net_to_text,t ftp_net_to_text_abort,  cvt_response_to_status, net_get_response; LOCAL z_status : VECTOR[2,LONG],o response,$ kill_routine : VOLATILE INITIAL(0),% abort_routine : VOLATILE INITIAL(0),.% ast_parameter : VOLATILE INITIAL(0),c& log_temp : VOLATILE INITIAL(.log_it), status; EXTERNAL saved_conn_info : CONNDEF,E expected_response;U ENABLE= transfer_handler(abort_routine, ast_parameter, kill_routine, log_temp);r byte_count = 0;e abor_ok = 0; !++dA ! Get a port to use. Ignore whether current_channel is open. !-- set_port(response);m/ status = cvt_response_to_status(.response);A( IF NOT .status THEN SIGNAL(.status); !++./ ! Tell the text transfer module to start up !--_ status = ftp_net_to_text ( .current_mode, ! Mode .current_struct, ! structure .current_type, ! Type- .current_type_size, ! Byte size (If type L)A/ .saved_conn_info[CONN_L_LCLADR], ! Local hostt1 .saved_conn_info[CONN_L_REMADR], ! Foreign hostt% .current_port, ! Port to listen on;+ dst_text, ! Text Data structure to writeO FTP$K_XFR_EFN, ! EFNe 0, ! AstAdrU .ast_parameter, ! AstPrm) z_status, ! Final Status$ xfer_update, ! Transcript Routine (.pasv_chan NEQU 0), .pasv_chan, 0, 0); IF NOT .status THEN BEGIN SIGNAL(.status);  RETURN(FTP$_NO_FILE); END;M abor_ok = 1; status =% (IF .src_file[DSC$W_LENGTH] EQL 0E/ THEN send_string(response, '!AS', command)]? ELSE send_string(response, '!AS !AS', command, src_file)); IF .status THEN BEGIN, status = cvt_response_to_status(.response); IF NOT .statusp THEN SIGNAL(.status); END' ELSE IF .status NEQ FTP$_NO_CONNECT THEN SIGNAL(.status);E IF NOT .status THEN RETURN(FTP$_NO_FILE);* abort_routine = ftp_net_to_text_abort;* status = $WAITFR(EFN = FTP$K_XFR_EFN);( IF NOT .status THEN SIGNAL(.status); abort_routine = 0; abor_ok = 0; net_get_response(response);,/ status = cvt_response_to_status(.response);n( IF NOT .status THEN SIGNAL(.status); status = .z_status[0];( IF NOT .status THEN RETURN(.Status); SS$_NORMAL END; ,GLOBAL ROUTINE get_parameters(file_name_a) =!++e! Functional Description:! ! To determine the file type.;! ASCII : RFM = VAR,STM,STMCR,STMLF, RAT = CR, and ORG=SEQN,! IMAGE : RFM = FIX, ORG=SEQ, or ORG=REL/IDX! TYPE IMAGE, for all else.c!a<! This routine really isn't terribly robust. We should deal(! with file types in a realistic manner.!n1! If we are already running STRU VMS, leave it...l!t!--! BEGINy BIND$ file_name = .file_name_a : $BBLOCK; LOCAL0 in_fab : $FAB(# FNS = .file_name[DSC$W_LENGTH], % FNA = .file_name[DSC$A_POINTER]),e status;! status = $OPEN(FAB = in_fab);( IF NOT .status THEN BEGIN$ SIGNAL(FTP$_NO_FILE, 1, file_name); RETURN(.status);i END;  $CLOSE(FAB = in_fab);L, IF (.current_struct EQLU FTP$K_STRU_VMS) THEN RETURN(SS$_NORMAL);/ IF (.current_struct EQLU FTP$K_STRU_RECORD)A THEN BEGIN, IF .in_fab[FAB$V_CR] OR .in_fab [FAB$V_PRN] THEN cvt_type(FTP$K_TYPE_AN)$ ELSE IF .in_fab[FAB$V_FTN], THEN cvt_type(FTP$K_TYPE_AC)t ELSE cvt_type(FTP$K_TYPE_I);) RETURN(SS$_NORMAL); END;r0 IF (( (.in_fab[FAB$B_RFM] EQLU FAB$C_STM) OR+ (.in_fab[FAB$B_RFM] EQLU FAB$C_STMCR) ORp) (.in_fab[FAB$B_RFM] EQLU FAB$C_UDF) ORa- (.in_fab[FAB$B_RFM] EQLU FAB$C_STMLF)) ANDd (.in_fab[FAB$V_CR]) ANDt) (.in_fab[FAB$B_ORG] EQLU FAB$C_SEQ)) ORo) ((.in_fab[FAB$B_RFM] EQLU FAB$C_VAR) ANDn& (.in_fab[FAB$B_ORG] EQLU FAB$C_SEQ)) THEN cvt_type(FTP$K_TYPE_AN)4 ELSE IF ((.in_fab[FAB$B_RFM] EQLU FAB$C_FIX) AND) (.in_fab[FAB$B_ORG] EQLU FAB$C_SEQ) ANDu (.in_fab[FAB$W_MRS] EQLU 512)) THEN cvt_type(FTP$K_TYPE_I); SS$_NORMAL END; D'GLOBAL ROUTINE transmit_file(command_a, ( src_file_a, dst_file_a, return_file_a,! fstatus_a, file_size, log_it) =s!++A! Functional Description:!!'@! Transmit a single file to the remote host. Does the following:8! - Sets the transfer parameters to match the file type.>! - Opens file for printing hash marks, initializes hash count! - Obtains a data port to use! - Transmits protocol command7! - Calls FTP_File_To_Net routine to transmit the file.u"! - Closes hashmark printing file.!--e BEGINN BIND" fstatus = .fstatus_a : $BBLOCK," command = .command_a : $BBLOCK,# src_file = .src_file_a : $BBLOCK,M( return_file = .return_file_a : $BBLOCK,# dst_file = .dst_file_a : $BBLOCK;u EXTERNAL saved_conn_info : CONNDEF,o expected_response;F EXTERNAL ROUTINE hash_init,u cvt_response_to_status, ftp_file_to_net,n ftp_file_to_net_abort,  net_get_response; BUILTIN= NULLPARAMETER;n LOCALi z_status : VECTOR[2,LONG],  status,& log_temp : VOLATILE INITIAL(.log_it),$ kill_routine : VOLATILE INITIAL(0),% abort_routine : VOLATILE INITIAL(0),r% ast_parameter : VOLATILE INITIAL(0),  size, response; ENABLE= transfer_handler(abort_routine, ast_parameter, kill_routine,R log_temp);t !++  ! Initialize countersa !--E hash_init(); tran_count = 0;O byte_count = 0;U abor_ok = 0;' size = (IF NULLPARAMETER(file_size) THEN 0e> ELSE .file_size^9); !Convert from blocks to bytes (*512) !++ 7 ! Make sure the transfer parameters match the file.T !--o4 IF .check_type AND NOT CLI$PRESENT(%ASCID'TYPE')" THEN get_parameters(src_file); !++s# ! Set the port for the transferN !-- C IF .current_channel EQL 0 OR .current_mode NEQ FTP$K_MODE_BLOCK; THEN BEGIN status = set_port(response);) IF .statusl1 THEN status = cvt_response_to_status(.response);$% IF NOT .status THEN SIGNAL(.status);E END; ELSE IF .expected_response EQL FTP$C_OPENING_CONNECTION23 THEN expected_response = FTP$C_CONNECTION_OPEN;_3 enable_control_a(src_file, 0, dst_file, .size); status = ftp_file_to_net(c( .current_mode, ! Transfer mode to use .current_struct, ! structure .current_type, ! type! .current_type_size, ! byte sizeM. .saved_conn_info[CONN_L_LCLADR],! Local host1 .saved_conn_info[CONN_L_REMADR], ! Foreign hostr% .current_port, ! port to listen on ' src_file, ! name of file to transfer0 FTP$K_XFR_EFN, ! event flag number to wait on 0, ! AST address" .ast_parameter, ! AST parameter' z_status, ! final status of transfera$ xfer_update, ! Transcript routine6 IF (NOT NULLPARAMETER(return_file_a)) ! Return file THEN return_file ELSE 0,' IF .current_mode EQL FTP$K_MODE_BLOCK THEN current_channel ELSE 0, 0, (.pasv_chan NEQU 0), .pasv_chan, 0, 0);# IF NOT NULLPARAMETER(fstatus_a)a THEN fstatus = .z_status[0]; !++ / ! Did it fail immediately? If so, punt now.t !--e IF NOT .status THEN BEGIN disable_control_a();- RETURN(.status);  END;s# IF NOT NULLPARAMETER(fstatus_a)h THEN fstatus = SS$_NORMAL; !++ ! Start timing !--$* status = $GETTIM(TIMADR = start_time);( IF NOT .status THEN SIGNAL(.status); abor_ok = 1; !++ 7 ! Now, send the command string and verify the reply  !--LA status = send_string(response, '!AS 2~ MGFTP026.GzI[MGFTP.SOURCE]FTP_FILE.B32;47O`I!AS', command, dst_file);I IF .status4 THEN status = cvt_response_to_status(.response); IF NOT .status THEN BEGIN disable_control_a();T' ftp_file_to_net_abort(.ast_parameter);  RETURN(.status);I END; * abort_routine = ftp_file_to_net_abort; !++s& ! Now wait for transfer completion !--Q* status = $WAITFR(EFN = FTP$K_XFR_EFN);( IF NOT .status THEN SIGNAL(.status); !++) ! Stop timing  !--l( status = $GETTIM(TIMADR = end_time);( IF NOT .status THEN SIGNAL(.status); disable_control_a(); abort_routine = 0; abor_ok = 0;# IF NOT NULLPARAMETER(fstatus_a) THEN fstatus = .z_status[1]; !++f ! Get final reply code !--  net_get_response(response);tF IF (.response NEQ FTP$C_FILE_OK) AND (.current_channel NEQA 0) AND% (.current_mode EQL FTP$K_MODE_BLOCK)L THEN close_block_conn();" IF .z_status[1] EQL SS$_NORMAL THEN BEGIN, status = cvt_response_to_status(.response);% IF NOT .status THEN RETURN(.status);u END;l !++n& ! Check final transfer status code !--o status = .z_status[0];( IF NOT .status THEN RETURN(.status); !++  ! Print summaryn !--oN IF .log_it THEN sum_print(start_time, end_time, .byte_count, .tran_count); tot_sum(1);l SS$_NORMAL END; e+ROUTINE cvt_type(new_type, new_byte_size) =f!++N! To send the remote the command to change the type to the current local type!d!-- BEGINs EXTERNAL ROUTINE cvt_response_to_status; BUILTINf NULLPARAMETER; LOCALe response, status; !++t) ! Is there a need to change the type?I !--P) IF (.current_type EQLU .new_type) AND:! (NULLPARAMETER(new_byte_size) ORr) (.current_type_size EQL .new_byte_size))n THEN RETURN(SS$_NORMAL); !++p1 ! If we got this far, we must change the typeo !-- status = (SELECTONEU .new_type OF SET [FTP$K_TYPE_AN] :' send_string(response, 'TYPE A N');S [FTP$K_TYPE_AC] :' send_string(response, 'TYPE A C');2 [FTP$K_TYPE_AT] :' send_string(response, 'TYPE A T');I [FTP$K_TYPE_I] :_% send_string(response, 'TYPE I');r [FTP$K_TYPE_L] :N9 send_string(response, 'TYPE L !UB', .new_byte_size);s TES); IF .status THEN BEGIN, status = cvt_response_to_status(.response); IF NOT .status; THEN SIGNAL(.status)s ELSE BEGINi current_type = .new_type;- IF (.current_type EQLU FTP$K_TYPE_L) AND" NOT NULLPARAMETER(new_byte_size)- THEN current_type_size = .new_byte_size;_ END;) END' ELSE IF .status NEQ FTP$_NO_CONNECTi THEN SIGNAL(.status);n SS$_NORMAL END; GLOBAL ROUTINE set_type_ascii =_!++s! Functional Description:o! =! An action routine for the FTP command SET TYPE ASCII [form])!-- BEGIN ) check_type = 0; !Turn off AUTOSENSEn$ IF CLI$PRESENT(%ASCID 'CONTROL')) THEN RETURN(cvt_type(FTP$K_TYPE_AC));o& IF CLI$PRESENT(%ASCID 'NON_PRINT')) THEN RETURN(cvt_type(FTP$K_TYPE_AN)); # IF CLI$PRESENT(%ASCID 'TELNET') ) THEN RETURN(cvt_type(FTP$K_TYPE_AT));e cvt_type(FTP$K_TYPE_AN); SS$_NORMAL END; GLOBAL ROUTINE set_type_ebcdic =!++T! Functional Description: !C7! An action routine for the FTP command SET TYPE EBCDICI!-- BEGINy6 SIGNAL(FTP$_UNSUPPORTED_TYPE, 1, %ASCID 'EBCDIC'); SS$_NORMAL END; ]GLOBAL ROUTINE set_type_image =T!++s! Functional Description: ! 6! An action routine for the FTP command SET TYPE IMAGE!--f BEGIN) check_type = 0; !Turn off AUTOSENSEs cvt_type(FTP$K_TYPE_I);; SS$_NORMAL END; GLOBAL ROUTINE set_type_local =c!++ ! Functional Description:R!u;! An action routine for the FTP Command SET TYPE LOCAL sizee!--t BEGINr EXTERNAL ROUTINE strings_handler,s get_switch_value,0 OTS$CVT_TI_L : BLISS ADDRESSING_MODE (GENERAL),0 STR$FREE1_DX : BLISS ADDRESSING_MODE (GENERAL); LOCALD/ size : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET (P [DSC$W_LENGTH] = 0,l" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),S new_byte_size : BYTE, status; ENABLE strings_handler(size);f) check_type = 0; !Turn off AUTOSENSE ( status = CLI$PRESENT(%ASCID'LOCAL');7 IF NOT .status THEN SIGNAL(FTP$_ERROR, 0, .status);c2 status = get_switch_value(%ASCID'SIZE', size);H IF NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1,%ASCID'SET TYPE LOCAL', .status);_2 status = OTS$CVT_TI_L(size, new_byte_size, 1);7 IF NOT .status THEN SIGNAL(FTP$_ERROR, 0, .status);T status = STR$FREE1_DX(size);( IF NOT .status THEN SIGNAL(.status); IF .new_byte_size NEQ 82 THEN SIGNAL(FTP$_INVBYTSIZ, 1, .new_byte_size)0 ELSE cvt_type(FTP$K_TYPE_L, .new_byte_size); SS$_NORMAL END; !GLOBAL ROUTINE set_type =N!++R! COMMAND: SET TYPE typee!l! To change the transfer type.0!!-- BEGINR LOCALr status;# IF CLI$PRESENT(%ASCID'CONTROL') ) THEN RETURN(cvt_type(FTP$K_TYPE_AC));o" IF CLI$PRESENT(%ASCID'TELNET')) THEN RETURN(cvt_type(FTP$K_TYPE_AT)); ( Status = CLI$PRESENT(%ASCID'ASCII');. IF .status OR (.status EQL CLI$_DEFAULTED)) THEN RETURN(cvt_type(FTP$K_TYPE_AN));f" IF CLI$PRESENT(%ASCID'EBCDIC')C THEN RETURN(SIGNAL(FTP$_UNSUPPORTED_TYPE, 1, %ASCID 'EBCDIC'));! IF CLI$PRESENT(%ASCID'IMAGE')N( THEN RETURN(cvt_type(FTP$K_TYPE_I)); SIGNAL(FTP$_TYPE_ERROR, 0);  SS$_NORMAL END; tROUTINE cvt_mode(new_mode) =!++;$! Like Cvt_Type, only for the mode.!;!-- BEGIN  EXTERNAL ROUTINE cvt_response_to_status; LOCAL response, status;< IF .current_mode EQLU .new_mode THEN RETURN(SS$_NORMAL); ! No need to change status = (SELECTONEU .new_mode Of SET [FTP$K_MODE_STREAM] :% send_string(response, 'MODE S');. [FTP$K_MODE_BLOCK] : % send_string(response, 'MODE B');  [FTP$K_MODE_COMPRESS] :% send_string(response, 'MODE C');t TES); IF .status THEN BEGIN, status = cvt_response_to_status(.response); IF NOT .status THEN SIGNAL(.status)_ ELSE current_mode = .new_mode;a END' ELSE IF .status NEQ FTP$_NO_CONNECTR THEN SIGNAL(.status);  SS$_NORMAL END; tGLOBAL ROUTINE!++ ! Functional Description: !t1! Some CLI action routines for changing the Mode.t!--E0 set_mode_block = cvt_mode(FTP$K_MODE_BLOCK),8 set_mode_compressed = cvt_mode(FTP$K_MODE_COMPRESS),2 set_mode_stream = cvt_mode(FTP$K_MODE_STREAM); ;GLOBAL ROUTINE set_mode =a!++l! COMMAND: SET MODE modee!e! To change the transfer mode.o! !--T BEGIN)" IF CLI$PRESENT(%ASCID'STREAM')- THEN RETURN(cvt_mode(FTP$K_MODE_STREAM));c! IF CLI$PRESENT(%ASCID'BLOCK')s, THEN RETURN(cvt_mode(FTP$K_MODE_BLOCK));& IF CLI$PRESENT(%ASCID'COMPRESSED')/ THEN RETURN(cvt_mode(FTP$K_MODE_COMPRESS));t SIGNAL(FTP$_MODE_ERROR, 0);t SS$_NORMAL END; !ROUTINE cvt_structure(new_stru) =-!++ "! Like the Cvt_Type and Cvt_Mode.! !--i BEGINo EXTERNAL ROUTINE cvt_response_to_status; LOCALN response, status;= IF .new_stru EQLU .current_struct THEN RETURN SS$_NORMAL;g status = (SELECTONEU .new_stru OF SET [FTP$K_STRU_FILE] :% send_string(response, 'STRU F');) [FTP$K_STRU_RECORD] :% send_string(response, 'STRU R');t [FTP$K_STRU_VMS] :m) send_string(response, 'STRU O VMS');m TES); 3`r MGFTP026.GzI[MGFTP.SOURCE]FTP_FILE.B32;47O`ytX IF .status THEN BEGIN, status = cvt_response_to_status(.response); IF NOT .statust THEN SIGNAL(.status)a! ELSE current_struct = .new_stru;N END' ELSE IF .status NEQ FTP$_NO_CONNECTV THEN SIGNAL(.status);_ SS$_NORMAL END; "GLOBAL ROUTINE try_structure_vms =!++lI! Called during host initialization - checks to see if remote system willBG! permit a STRU O VMS command and, if so, sets the current mode for allg! transfers to O VMS.o!-- BEGINo EXTERNAL expected_response;  EXTERNAL ROUTINE cvt_response_to_status, save_reply, restore_reply,  set_reply_off; LOCALD old_reply,E response, status; save_reply(old_reply); set_reply_off(); expected_response = -2;a1 status = send_string(response, 'STRU O VMS');  IF .status THEN BEGIN, status = cvt_response_to_status(.response); IF .statusu& THEN current_struct = FTP$K_STRU_VMS; END' ELSE IF .status NEQ FTP$_NO_CONNECT) THEN SIGNAL(.status);r expected_response = -1;d restore_reply(.old_reply); .statusI END; GLOBAL ROUTINE!++a! Functional Description:s!f1! Some CLI action routines for changing the Mode.O!--8 set_structure_file = cvt_structure(FTP$K_STRU_FILE),< set_structure_record = cvt_structure(FTP$K_STRU_RECORD),6 set_structure_vms = cvt_structure(FTP$K_STRU_VMS); nGLOBAL ROUTINE set_structure =!++i#! COMMAND: SET STRUCTURE structurem!r! To change the file structuremA! There is a lot of repetative code here, but it is necessary to_L! prevent changing the local structure (STRUCT) if there is an error from?! the remote changing it (like "PARAMETER NOT IMPLIMENTED").c!--= BEGINb IF CLI$PRESENT(%ASCID'FILE')0 THEN RETURN(cvt_structure(FTP$K_STRU_FILE));" IF CLI$PRESENT(%ASCID'RECORD')2 THEN RETURN(cvt_structure(FTP$K_STRU_RECORD)); IF CLI$PRESENT(%ASCID'VMS')t/ THEN RETURN(cvt_structure(FTP$K_STRU_VMS));m$ SIGNAL(FTP$_STRUCTURE_ERROR, 0); SS$_NORMAL END; tGLOBAL ROUTINE show_type =!++,!s! COMMAND: SHOW TYPEp!-- BEGINr SELECTONEU .current_type OFe SET2 [FTP$K_TYPE_AN]: print('TYPE is ASCII Nonprint');0 [FTP$K_TYPE_AT]: print('TYPE is ASCII Telnet');1 [FTP$K_TYPE_AC]: print('TYPE is ASCII Control'); 3 [FTP$K_TYPE_EN]: print('TYPE is EBCDIC Nonprint'); 1 [FTP$K_TYPE_ET]: print('TYPE is EBCDIC Telnet');)2 [FTP$K_TYPE_EC]: print('TYPE is EBCDIC Control');) [FTP$K_TYPE_I]: print('TYPE is Image'); : [FTP$K_TYPE_L]: print('TYPE is Local, byte size is !UL', .current_type_size);$ TES;E SS$_NORMAL END; ;GLOBAL ROUTINE show_mode =!++l!S! COMMAND: SHOW MODE !-- BEGIN( SELECTONEU .current_mode ofE SET. [FTP$K_MODE_STREAM]: print('MODE is Stream');, [FTP$K_MODE_BLOCK]: print('MODE is Block');4 [FTP$K_MODE_COMPRESS]: print('MODE is Compressed'); TES;  SS$_NORMAL END; EGLOBAL ROUTINE show_structure =!++H!S! COMMAND: SHOW STRUCTURE!.!--s BEGINR! SELECTONEU .current_struct oft SET* [FTP$K_STRU_FILE]: print('STRU is File');. [FTP$K_STRU_RECORD]: print('STRU is Record');( [FTP$K_STRU_VMS]: print('STRU is VMS'); TES; SS$_NORMAL END; n GLOBAL ROUTINE show_parameters =!++s!o! COMMAND: SHOW PARAMETERSN!.-! To display all current transfer parameters._!--s BEGINF show_type(); show_mode(); show_structure();; IF .current_channel NEQ 0t; THEN print('Connection open, Port=!UL', .current_port);T SS$_NORMAL END; S(GLOBAL ROUTINE set_tot_file_size(size) =BEGINR tot_file_size = .size;O( tot_file_blocks = .tot_file_size^-9 +1 (IF .tot_file_size<0,9,0> EQL 0 THEN 0 ELSE 1);y SS$_NORMALlEND;ENDfELUDOMin a realistic manner.!n1! If we are already running STRU VMS, leave it...l!t!--! BEGINy BIND$ file_name = .file_name_a : $BBLOCK; LOCAL0 in_fab : $FAB(# FNS = .file_name[DSC$W_LENGTH], % FNA = .file_*[MGFTP.SOURCE]FTP_FTON.B32;30+,<)-./ 4N-I0123KPWO56~7@x89/RFÞGHJ  ! MadGoat FTP client and server!?! Authors: Chad Wilson, Dale Moore, Tod Shannon, Bruce Miller,,! Marc Shannon, Henry Miller, John Clement,1! Matt Madison, Darrell Burkhead, Hunter Goatley!6! Copyright 1986, 1992, Carnegie Mellon University.B! Copyright 1994, 1998, MadGoat Software. All rights reserved.!?! Permission is granted for not-for-profit redistribution,?! provided all source and object code remain unchanged from?! the original distribution, and that all copyright notices! remain intact.!MODULE file_to_net( ADDRESSING_MODE( EXTERNAL = LONG_RELATIVE, NONEXTERNAL = LONG_RELATIVE), IDENT = 'V2.5-4',# LIST(ASSEMBLY, NOBINARY, NOEXPAND) ) =BEGIN!++<! FTP_FTON.B32 Copyright (c) 1986 Carnegie Mellon University!! Description:!4! Open up a file and send it out on a tcp data port.!.! Written By: Dale Moore CMU-CS/RI 31-MAR-1986!! Modifications:!+! V2.5-4 Hunter Goatley 14-JUL-1999 13:45<! Modified to supply the local host address when bind()ing.;! Needed to make MGFTP work with cluster aliases properly.!)! V2.5 Hunter Goatley 18-JUN-1998 21:309! Reworked passive mode stuff to work in cases where the6! RETR command arrives before the client has actually4! opened the passive connection. If the connection>! hasn't been established, we set things up so a new routine,6! PASV_START_AST(), is called from PASV_AST in FTP_IN;! to set the appropriate variables and start the transfer.!+! V2.2-3 Hunter Goatley 17-OCT-1997 13:54<! Don't force ASCII mode for BINARY "Stream" file transfers! (like V2.0-4 change).!+! V2.2-2 Hunter Goatley 2-APR-1997 10:29;! Free memory used for RAB user buffer. Don't $DISCONNECT! on error in $CONNECT.!)! V2.2 Hunter Goatley 6-AUG-1996 04:43! Minor change for NETLIB V2.!,! V2.1-1 Darrell Burkhead 19-SEP-1994 10:11@! Broke binary_start into binary_start and ascii_start to avoid8! sending files in binary mode when TYPE A is selected.!,! V2.0-4 Darrell Burkhead 11-MAY-1994 15:48<! Modified the check for record attributes in binary_start.@! Stream-LF/Carriage-Return-Carriage-Control files are now sent,! as a sequence of blocks (STRU F, TYPE I).!,! V2.0-3 Darrell Burkhead 10-DEC-1993 10:31<! Reworked compress_data to make it more readable and moved5! all of the compress_data and enblock data calls to;! send_file_data. File data routines now just provide the0! chunks of data to be compressed or enblocked.!,! V2.0-2 Darrell Burkhead 1-DEC-1993 17:44@! Got rid of the SET_PHY_IO calls. They are now handled in the! NETLIB macros.!,! V2.0-1 Darrell Burkhead 28-OCT-1993 16:40! Got rid of STRU P.!*! V2.0 Darrell Burkhead 15-OCT-1993 12:438! Use NETLIB. Got rid of the RBLOCKDEF queue. The FTP<! protocol doesn't support multiple simultaneous transfers,<! so the a client or server should never have more than one:! entry in its queue.(The listener doesn't use FTP_FTON.)9! 4g MGFTP026.G<)-I[MGFTP.SOURCE]FTP_FTON.B32;30Nk The queue was replaced with a static variable, rblock,=! which corresponds to the one entry in the RBLOCKDEF queue.:! The RBLOCK_V_VALID bit now indicates whether a transfer! is currently in progress.!=! Note: all of the TCP/IP "channels" are not really channels:! any more. They are addresses of NETLIB context blocks.!%!1.23 21-SEP-1993 Hunter Goatley WKUA! Ported to run under OpenVMS AXP by defining RBlock using macros! from FIELD library.!"! 29-Jun-1993 Darrell Burkhead WKUC! Fixed File/Image/Block transfers. They were not completing since&! chunks were getting enblocked twice.!--LIBRARY 'SYS$LIBRARY:STARLET';LIBRARY 'FTP';LIBRARY 'FIELDS';LIBRARY 'NETAUX';LIBRARY 'NETLIB'; COMPILETIME hold_open = 1, debug = 0;G%IF debug %THEN %MESSAGE('DEBUG mode is enabled in FTP_FTON.B32!') %FI;LITERAL CHAR_CR = %CHAR(13), CHAR_LF = %CHAR(10);LITERAL4 max_send_size = 2048, !Max size of send buffer! !...should be a multiple of !...512 RBLOCK_S_RAB = RAB$C_BLN, RBLOCK_S_FAB = FAB$C_BLN, RBLOCK_S_NAM = NAM$C_BLN; _DEF(RBLOCK)!H! The queue part of this structure is no longer necessary. I think thatH! get_mem and free_mem are the only routines that depend on the size and"! the valid bit being at 12,0,1,0.! RBLOCK_L_FLINK = _LONG,! RBLOCK_L_BLINK = _LONG,! RBLOCK_L_SIZE = _LONG, RBLOCK_L_STATE = _LONG, _OVERLAY(RBLOCK_L_STATE) RBLOCK_V_VALID = _BIT, _ENDOVERLAY$ RBLOCK_L_FINAL_STATUS_A = _LONG, RBLOCK_L_ASTADR = _LONG, RBLOCK_L_ASTPRM = _LONG, RBLOCK_L_EFN = _LONG,! RBLOCK_L_TRANSCRIPT = _LONG, RBLOCK_L_MODE = _LONG, RBLOCK_L_STRU = _LONG, RBLOCK_L_TYPE = _LONG, RBLOCK_L_TYPE_SIZE = _LONG,! RBLOCK_L_LOCAL_HOST = _LONG, RBLOCK_L_HOST = _LONG, RBLOCK_L_PORT = _LONG, RBLOCK_L_FLAGS = _LONG, _OVERLAY(RBLOCK_L_FLAGS) RBLOCK_V_CHAN_OPEN = _BIT, RBLOCK_V_CONN_OPEN = _BIT, RBLOCK_V_FILE_OPEN = _BIT, RBLOCK_V_LF_PEND = _BIT, RBLOCK_V_CR_PEND = _BIT, RBLOCK_V_HEADER = _BIT,& RBLOCK_V_EOF = _BIT, ! EOF in input3 RBLOCK_V_BLOCK = _BIT, ! Block it in output rou.+ RBLOCK_V_ALL = _BIT, ! Do not chunk data( RBLOCK_V_ACTIVE = _BIT, ! Active mode$ RBLOCK_V_FAST = _BIT, ! Fast mode3 RBLOCK_V_EOFSENT = _BIT, ! Only used with V_BLOCK2 RBLOCK_V_REPEAT_START = _BIT, ! Used with Mode C1 RBLOCK_V_REPEAT_FLAG = _BIT, ! Used with Mode C7 RBLOCK_V_PASV_OPEN = _BIT, ! Passive opened in FTP_IN _ENDOVERLAYA RBLOCK_L_TCP_CHANNEL_ADDR = _LONG, !Points to a longword that% !...points to the context block? RBLOCK_L_PASSIVE_CHANNEL = _LONG, !The PASV context address! RBLOCK_L_LISTEN_CHAN = _LONG, RBLOCK_Q_DATA_IOSB = _QUAD, RBLOCK_Q_FILE_NAME = _QUAD, RBLOCK_Q_IN_LINE = _QUAD,4 RBLOCK_L_STRING_COUNT = _LONG, !Used with Mode C4 RBLOCK_L_REPEAT_COUNT = _LONG, !Used with Mode C1 RBLOCK_L_PAD_CHAR = _LONG, !Used with Mode C% RBLOCK_L_CHANNEL_ADDRESS = _LONG,# RBLOCK_L_START_ROUTINE = _LONG," RBLOCK_L_DATA_ROUTINE = _LONG,$ RBLOCK_L_FINISH_ROUTINE = _LONG," RBLOCK_L_DATA_POINTER = _LONG,# RBLOCK_UCHAR_DIRECTORY = _LONG, RBLOCK_Q_OUT_LINE = _QUAD,. RBLOCK_XAB_LIST = _BYTES(2*ITM$S_ITEM+4), _ALIGN(LONG)) RBLOCK_T_RAB = _BYTES(RBLOCK_S_RAB), _ALIGN(LONG)) RBLOCK_T_FAB = _BYTES(RBLOCK_S_FAB), _ALIGN(LONG), RBLOCK_T_EXPAND = _BYTES(NAM$C_MAXRSS), _ALIGN(LONG), RBLOCK_T_RESULT = _BYTES(NAM$C_MAXRSS), _ALIGN(LONG)& RBLOCK_T_NAM = _BYTES(NAM$C_BLN), _ALIGN(LONG), RBLOCK_T_XABFHC = _BYTES(XAB$C_FHCLEN), _ALIGN(LONG)+ RBLOCK_T_XABITM = _BYTES(XAB$C_ITMLEN)_ENDDEF(RBLOCK);LITERAL( RBLOCK_K_SIZE = RBLOCK_S_RBLOCKDEF;OWN fileattr_buffer : FATTRDEF,5 rblock : RBLOCKDEF PRESET([RBLOCK_V_VALID] = 0);EXTERNAL LITERAL FTP$_EOR_DATA; :GLOBAL ROUTINE enblock_data(out_line_a, in_line_a, flag) = BEGIN BIND" in_line = .in_line_a : $BBLOCK,# out_line = .out_line_a : $BBLOCK; EXTERNAL ROUTINE- STR$CONCAT : BLISS ADDRESSING_MODE(GENERAL),- STR$APPEND : BLISS ADDRESSING_MODE(GENERAL); LOCAL. blocksize : INITIAL( .in_line[DSC$W_LENGTH]), i_char : VECTOR[4,BYTE],* block_desc : $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 3," [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_S, [DSC$A_POINTER] = i_char), status : INITIAL(0); %IF debugK %THEN print('enblock_data: flag = !UB, size = !UW', .flag, .blocksize); %FI i_char[0] = .flag;" i_char[1] = .blocksize<8,8,0>;" i_char[2] = .blocksize<0,8,0>;. status = STR$APPEND(out_line, block_desc);( IF NOT .status THEN RETURN(.status);+ status = STR$APPEND(out_line, in_line); .status END; 3GLOBAL ROUTINE compress_data(out_line_a, in_line_a, all_flag, out_size_a) =!++! Functional Description:!D! in_line is encoded into the following chunks which are appended to ! out_line:!8! [length byte][text] For sections of in_line up to 127*! characters long which do not contain%! any repeated runs of characters!! longer than two characters.;! [11|length 6 bits] For sections of in_line which contain(! the default pad character (NUL for-! TYPE I or TYPE L, space for all others)! repeated up to 63 times.>! [10|length 6 bits][c] For sections of in_line which contain'! a run (of up to 63 characters) of'! c, where c is not the default pad! character.!B! If all_flag is set then all of in_line will be encoded. If not,3! a chunk at the end of in_line may not be encoded.!F! out_size receives the position of the first unencoded character. IfF! the entire string was encoded, out_size will be set to the length of! the string plus 1.!-- BEGIN BIND# out_size = .out_size_a : $BBLOCK," in_line = .in_line_a : $BBLOCK,# out_line = .out_line_a : $BBLOCK; EXTERNAL ROUTINE- STR$CONCAT : BLISS ADDRESSING_MODE(GENERAL),- STR$APPEND : BLISS ADDRESSING_MODE(GENERAL); LOCAL control_buff : VECTOR[2,BYTE],, control_desc : $BBLOCK[DSC$C_S_BLN] PRESET( [DSC$W_LENGTH] = 0," [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_S,$ [DSC$A_POINTER] = control_buff),+ string_desc : $BBLOCK[DSC$C_S_BLN] PRESET( [DSC$W_LENGTH] = 0," [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_S, [DSC$A_POINTER] = 0),' last_char, !Character being repeated; output_flag : INITIAL(0), !Time to output compressed chars start_pos, i, status; %IF debug" %THEN print('compress_data:'); %FI# IF .in_line[DSC$W_LENGTH] EQL 0& THEN BEGIN !Null line passed in out_size = 0; RETURN(SS$_NORMAL); END;N start_pos = .rblock[RBLOCK_L_STRING_COUNT]+.rblock[RBLOCK_L_REPEAT_COUNT];? last_char = CH$RCHAR(.in_line[DSC$A_POINTER]+.start_pos-1);6 INCR i FROM .start_pos TO .in_line[DSC$W_LENGTH]-1 DO BEGIN7 BIND current_char = .in_line[DSC$A_POINTER]+.i : BYTE;! IF .rblock[RBLOCK_V_REPEAT_FLAG] THEN BEGIN' IF .last_char NEQ .current_char OR+ .rblock[RBLOCK_L_REPEAT_COUNT] EQL %X'3F'; THEN output_flag = 1 !Repeated string full or finished) ELSE rblock[RBLOCK_L_REPEAT_COUNT] =$ .rblock[RBLOCK_L_REPEAT_COUNT]+1; END ELSE BEGING IF .rblock[RBLOCK_V_REPEAT_START] AND .last_char EQL .current_char7 THEN BEGIN 5z` MGFTP026.G<)-I[MGFTP.SOURCE]FTP_FTON.B32;30N!Found enough repeated chars in a row# rblock[RBLOCK_V_REPEAT_FLAG] = 1;! rblock[RBLOCK_L_STRING_COUNT] =$ .rblock[RBLOCK_L_STRING_COUNT]-2;$ rblock[RBLOCK_L_REPEAT_COUNT] = 3; END ELSE BEGIN- ! Check for the start of a repeat sequence.? rblock[RBLOCK_V_REPEAT_START] = .last_char EQL .current_char;. IF .rblock[RBLOCK_L_STRING_COUNT] EQL %X'7F'* THEN output_flag = 1 !Normal string full& ELSE rblock[RBLOCK_L_STRING_COUNT] =% .rblock[RBLOCK_L_STRING_COUNT]+1; END; END; IF .output_flag THEN BEGIN !Time to output, IF .rblock[RBLOCK_L_STRING_COUNT] GTR 0, THEN BEGIN !Output unrepeated portion/ string_desc[DSC$W_LENGTH] = control_buff[0] =" .rblock[RBLOCK_L_STRING_COUNT];! control_desc[DSC$W_LENGTH] = 1; %IF debug8 %THEN print('compress : len = !UB', .control_buff[0]); %FI. status = STR$APPEND(out_line, control_desc);& IF NOT .status THEN RETURN(.status);< string_desc[DSC$A_POINTER] = .in_line[DSC$A_POINTER]+ .i -$ (.rblock[RBLOCK_L_STRING_COUNT]+% .rblock[RBLOCK_L_REPEAT_COUNT]); %IF debug= %THEN print('compress : "!AF"', .string_desc[DSC$W_LENGTH],! .string_desc[DSC$A_POINTER]); %FI- status = STR$APPEND(out_line, string_desc);& IF NOT .status THEN RETURN(.status); END;, IF .rblock[RBLOCK_L_REPEAT_COUNT] GTR 0* THEN BEGIN !Output repeated portion3 control_buff[0] = .rblock[RBLOCK_L_REPEAT_COUNT];. IF .last_char EQL .rblock[RBLOCK_L_PAD_CHAR]$ THEN BEGIN !Default repeated char3 control_buff[0] = .control_buff[0] OR %X'C0';% control_desc[DSC$W_LENGTH] = 1; END2 ELSE BEGIN !Another repeated char, need to also !...send the repeated char3 control_buff[0] = .control_buff[0] OR %X'80';# control_buff[1] = .last_char;% control_desc[DSC$W_LENGTH] = 2; END; %IF debug8 %THEN print('compress : repeat len = !UB, char = !UB'," .control_buff[0], .last_char); %FI. status = STR$APPEND(out_line, control_desc);& IF NOT .status THEN RETURN(.status); END; !* ! Set to compress the rest of the string. !1 output_flag = rblock[RBLOCK_V_REPEAT_FLAG] =! rblock[RBLOCK_V_REPEAT_START] =$ rblock[RBLOCK_L_REPEAT_COUNT] = 0;' rblock[RBLOCK_L_STRING_COUNT] = 1; END;6 last_char = .current_char; !Update the last character END; !End of character loop out_size = (IF .all_flag THEN BEGIN( IF .rblock[RBLOCK_L_STRING_COUNT] GTR 0( THEN BEGIN !Output unrepeated portion2 string_desc[DSC$W_LENGTH] = control_buff[0] =" .rblock[RBLOCK_L_STRING_COUNT];$ control_desc[DSC$W_LENGTH] = 1; %IF debug; %THEN print('compress : len = !UB', .control_buff[0]); %FI1 status = STR$APPEND(out_line, control_desc);) IF NOT .status THEN RETURN(.status);: string_desc[DSC$A_POINTER] = .in_line[DSC$A_POINTER]+; .in_line[DSC$W_LENGTH] - (.rblock[RBLOCK_L_STRING_COUNT]+' .rblock[RBLOCK_L_REPEAT_COUNT]); %IF debug@ %THEN print('compress : "!AF"', .string_desc[DSC$W_LENGTH],! .string_desc[DSC$A_POINTER]); %FI0 status = STR$APPEND(out_line, string_desc);) IF NOT .status THEN RETURN(.status); END;( IF .rblock[RBLOCK_L_REPEAT_COUNT] GTR 0& THEN BEGIN !Output repeated portion6 control_buff[0] = .rblock[RBLOCK_L_REPEAT_COUNT];1 IF .last_char EQL .rblock[RBLOCK_L_PAD_CHAR]( THEN BEGIN !Default repeated char/ control_buff[0] = .control_buff[0] OR %X'C0';! control_desc[DSC$W_LENGTH] = 1; END6 ELSE BEGIN !Another repeated char, need to also !...send the repeated char/ control_buff[0] = .control_buff[0] OR %X'80'; control_buff[1] = .last_char;! control_desc[DSC$W_LENGTH] = 2; END; %IF debug; %THEN print('compress : repeat len = !UB, char = !UB'," .control_buff[0], .last_char); %FI1 status = STR$APPEND(out_line, control_desc);) IF NOT .status THEN RETURN(.status); END; !# ! Set to compress the next string. !? rblock[RBLOCK_V_REPEAT_FLAG] = rblock[RBLOCK_V_REPEAT_START] =$ rblock[RBLOCK_L_REPEAT_COUNT] = 0;# rblock[RBLOCK_L_STRING_COUNT] = 1;3 .in_line[DSC$W_LENGTH]+1 !Entire string compressed ENDA ELSE .in_line[DSC$W_LENGTH]-(.rblock[RBLOCK_L_STRING_COUNT]+( .rblock[RBLOCK_L_REPEAT_COUNT])+1); SS$_NORMAL END; ROUTINE common_start = !++! Functional Description:!E! This routine contains all of the initializations that are common to;! the ascii_start, binary_start, and record_start routines.!-- BEGIN BIND2 file_name = rblock[RBLOCK_Q_FILE_NAME] : $BBLOCK,+ in_fab = rblock[RBLOCK_T_FAB] : $BBLOCK,+ in_rab = rblock[RBLOCK_T_RAB] : $BBLOCK; EXTERNAL LITERAL FTP$_DIR_FILE; LOCAL status; %IF debug& %THEN print('FTON: Common_Start'); %FI $FAB_INIT( FAB = in_fab, SHR = , FAC = , FOP = , XAB = rblock[RBLOCK_T_XABITM], NAM = rblock[RBLOCK_T_NAM],! FNS = .file_name[DSC$W_LENGTH],# FNA = .file_name[DSC$A_POINTER]); $RAB_INIT( RAB = in_rab, FAB = in_fab, ROP = , RAC = SEQ);!J! Uchar_Directory isn't filled in when we're reading from a terminal(e.g.,B! the FTP-client CREATE command), so clear it out before checking.!' rblock[RBLOCK_UCHAR_DIRECTORY] = 0;! status = $OPEN(FAB = in_fab);( IF NOT .status THEN RETURN(.status);& IF .rblock[RBLOCK_UCHAR_DIRECTORY] THEN BEGIN status = $CLOSE(FAB = in_fab);% IF NOT .status THEN RETURN(.status);c RETURN(FTP$_DIR_FILE);A END;  SS$_NORMAL! END; !End of common_start rROUTINE ascii_finish =!++ ! Functional Description:D!e ! The Ascii data finish routine.!--p BEGIN8 BIND* in_fab = rblock[RBLOCK_T_FAB] : $BBLOCK,* in_rab = rblock[RBLOCK_T_RAB] : $BBLOCK; EXTERNAL ROUTINE. LIB$FREE_VM : BLISS ADDRESSING_MODE(GENERAL); LOCALp recsize,  status; %IF debuga& %THEN print('FTON: Ascii Finish'); %FIi= !Make sure RAB is connected before attempting disconnect.U# IF (.in_rab [RAB$W_ISI] NEQU 0)E THEN BEGIN2 status = $DISCONNECT(RAB = rblock[RBLOCK_T_RAB]);% IF NOT .status THEN SIGNAL(.status);A END;X# IF (.in_fab [FAB$W_IFI] NEQU 0)N THEN BEGIN- status = $CLOSE(FAB = rblock[RBLOCK_T_FAB]);t% IF NOT .status THEN SIGNAL(.status);o END;  IF .in_rab[RAB$L_RHB] NEQA 0B THEN LIB$FREE_VM(%REF(.in_fab[FAB$B_FSZ]), in_rab[RAB$L_RHB]); !y" ! Free up the user buffer too. ! ! recsize = .in_rab[RAB$W_USZ];n5 status = LIB$FREE_VM(recsize, in_rab[RAB$L_UBF]);r SS$_NORMAL END; lROUTINE ascii_start = !++w! Functional Description: !k2! In order to start sending a file in binary mode,/! we open the file just the same as ascii mode.o!--i BEGIN  BIND+ in_fab = rblock[RBLOCK_T_FAB] : $BBLOCK,p+ in_rab = rblock[RBLOCK_T_RAB] : $BBLOCK,a/ in_xabfhc = rblock[RBLOCK_T_XABFHC] : $BBLOCK;p EXTERNAL ROUTINE- LIB$GET_VM : BLISS ADDRESSING_MODE(GENERAL);y LOCAL9 recsize,  org,f status; %IF debug"% %THEN print('FTON: ASCII_Start');  %FI status = common_start();( IF NOT .status THEN RETURN(.status);+ org = .in_fab[FAB$B_ORG] AND FAB$M_ORG;oA IF(.org EQL FAB$C_SEQ) AND (.in_fab[FAB$B_RFM] NEQ FAB$C_FIX)M( THEN recsize = .in_xabfhc[XAB$W_LRL]& ELSE recsize = .in_fab[FAB$W_MRS];( recsize = .recsize AND %X'0000FFFF';/ IF .recsize EQL 0 THEN recsize = 1024 * 16;d IF6e MGFTP026.G<)-I[MGFTP.SOURCE]FTP_FTON.B32;30N!% .in_fab[FAB$B_FSZ] GTR 02A THEN LIB$GET_VM(%REF(.in_fab[FAB$B_FSZ]), in_rab[RAB$L_RHB]); $ status = $CONNECT(RAB = in_rab); IF NOT .status THEN BEGIN ascii_finish(); RETURN(.status);u END; 4 status = LIB$GET_VM(recsize, in_rab[RAB$L_UBF]); IF NOT .status THEN BEGIN ascii_finish(); RETURN(.status);d END;! in_rab[RAB$W_USZ] = .recsize;l %IF debug5 %THEN print('FTON: ASCII_Start RAT !UB, RFM !UB',d) .in_fab[FAB$B_RAT],.in_fab[FAB$B_RFM]);o %FIe SS$_NORMAL END; e ROUTINE ascii_data(out_line_a) =!++ ! Functional Description: ! "! The Ascii Data provider routine.8! As with any Data routine, we must rewrite or overwrite2! the line with data to be sent. We don't append.!--1 BEGINe BIND# out_line = .out_line_a : $BBLOCK;F BIND* in_fab = rblock[RBLOCK_T_FAB] : $BBLOCK,* in_rab = rblock[RBLOCK_T_RAB] : $BBLOCK; EXTERNAL ROUTINE strings_handler, - STR$CONCAT : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL), - STR$APPEND : BLISS ADDRESSING_MODE(GENERAL); LOCALC1 in_line : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(e [DSC$W_LENGTH] = 0,i" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_S,* [DSC$A_POINTER] = .in_rab[RAB$L_UBF]),2 temp_desc : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0,K" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0), slew, sfx : BLOCK[1,BYTE], i,  status; ENABLE strings_handler(temp_desc); %IF debug $ %THEN print('FTON: Ascii Data'); %FII3 IF .rblock[RBLOCK_V_EOF] THEN RETURN(RMS$_EOF);FH CH$WCHAR(%C ' ', .in_rab[RAB$L_UBF]); ! For Fortran Carriage control status = $GET(RAB = in_rab); IF .status EQL RMS$_EOFi THEN BEGIN rblock[RBLOCK_V_EOF] = 1; IF (.in_fab[FAB$V_FTN] AND0 (.rblock[RBLOCK_L_TYPE] NEQ FTP$K_TYPE_AC)) OR .rblock[RBLOCK_V_CR_PEND]s# THEN status = STR$APPEND(out_line,t3 %ASCID %STRING(%CHAR(CHAR_CR), %CHAR(CHAR_LF)));L RETURN(.status);B END;$( IF NOT .status THEN RETURN(.status);/ in_line[DSC$W_LENGTH] = .in_rab[RAB$W_RSZ];i IF .in_fab[FAB$V_FTN] ANDh+ (.rblock[RBLOCK_L_TYPE] NEQ FTP$K_TYPE_AC)n THEN BEGIN5 in_line[DSC$W_LENGTH] = MAX(0,.in_rab[RAB$W_RSZ]-1); 0 in_line[DSC$A_POINTER]= .in_rab[RAB$L_UBF] + 1;* SELECTONE CH$RCHAR(.in_rab[RAB$L_UBF]) OF SET( [%CHAR(0)] : ! NO Carriage control BEGINR status = STR$CONCAT(out_line,V IF .rblock[RBLOCK_V_CR_PEND]_ THEN %ASCID %CHAR(CHAR_CR)  ELSE %ASCID '', in_line); rblock[RBLOCK_V_CR_PEND] = 0;N END; [%C'0'] : ! Extra line BEGINO status = STR$CONCAT(out_line,L IF .rblock[RBLOCK_V_CR_PEND]P THEN %ASCID %CHAR(CHAR_CR)_ ELSE %ASCID '', IF .rblock[RBLOCK_V_LF_PEND] THEN %ASCID %CHAR(CHAR_LF)  ELSE %ASCID '',2 %ASCID %STRING(%CHAR(CHAR_CR), %CHAR(CHAR_LF)), in_line); rblock[RBLOCK_V_CR_PEND] = 1; END; [%C'1'] : ! Skip page BEGINE status = STR$CONCAT(out_line,B IF .rblock[RBLOCK_V_CR_PEND] THEN %ASCID %CHAR(CHAR_CR)L ELSE %ASCID '', IF .rblock[RBLOCK_V_LF_PEND]= THEN %ASCID %CHAR(CHAR_LF)u ELSE %ASCID '', %ASCID %CHAR(12), in_line); rblock[RBLOCK_V_CR_PEND] = 1;e END;% [%C'+'] : ! NO LF at beginning_ BEGIN  status = STR$CONCAT(out_line, IF .rblock[RBLOCK_V_CR_PEND]  THEN %ASCID %CHAR(CHAR_CR)E ELSE %ASCID '', in_line); rblock[RBLOCK_V_CR_PEND] = 1;  END; [%C'$'] : ! NO CR at endR BEGIN  status = STR$CONCAT(out_line,, IF .rblock[RBLOCK_V_CR_PEND]  THEN %ASCID %CHAR(CHAR_CR)c ELSE %ASCID '', IF .rblock[RBLOCK_V_LF_PEND]o THEN %ASCID %CHAR(CHAR_LF)S ELSE %ASCID '', in_line); rblock[RBLOCK_V_CR_PEND] = 0;F END;" [OTHERWISE] : ! both CR + LF BEGIN  status = STR$CONCAT(out_line,! IF .rblock[RBLOCK_V_CR_PEND]P THEN %ASCID %CHAR(CHAR_CR)o ELSE %ASCID '', IF .rblock[RBLOCK_V_LF_PEND]  THEN %ASCID %CHAR(CHAR_LF)S ELSE %ASCID '', in_line); rblock[RBLOCK_V_CR_PEND] = 1;_ END; TES;  END ELSE IF .in_fab[FAB$V_PRN] THEN BEGIN status = STR$CONCAT(out_line, IF .rblock[RBLOCK_V_CR_PEND] THEN %ASCID %CHAR(CHAR_CR) ELSE %ASCID '');% IF NOT .status THEN RETURN(.status);)% slew = CH$RCHAR(.in_rab[RAB$L_RHB]);A INCR i FROM/ IF .rblock[RBLOCK_V_LF_PEND] THEN 1 ELSE 2) TO .slew DOL BEGIN" status = STR$APPEND(out_line,2 %ASCID %STRING(%CHAR(CHAR_CR), %CHAR(CHAR_LF)));) IF NOT .status THEN RETURN(.status);K END;B/ status = STR$APPEND(out_line, in_line);B% IF NOT .status THEN RETURN(.status);N0 sfx = CH$RCHAR(CH$PLUS(.in_rab[RAB$L_RHB], 1));' IF .sfx[0,7,1,0] AND NOT .sfx[0,5,1,0]K THEN BEGINL IF .sfx[0,6,1,0]" THEN slew = .sfx[0,0,4,0]+128 ELSE slew = .sfx[0,0,4,0];B" rblock[RBLOCK_V_CR_PEND] = 0; IF .slew EQL CHAR_CR& THEN rblock[RBLOCK_V_CR_PEND] = 1 ELSE BEGIN)< status = STR$APPEND(out_line, %ASCID ' '); ! Place holder& IF NOT .status THEN RETURN(.status); CH$WCHAR(.slew,7 .out_line[DSC$A_POINTER]+.out_line[DSC$W_LENGTH]-1);N END; END;G END& ELSE status = STR$CONCAT(out_line, in_line,2 %ASCID %STRING(%CHAR(CHAR_CR), %CHAR(CHAR_LF)));! rblock[RBLOCK_V_LF_PEND] = 1;( .statusN END;ROUTINE page_start = $!++P! Functional Description:S8! Start doing stuff for a Page transfer. RMS is stupid;<! we can't do an open in block-io mode and then do a display7! to get all the info about the file(keys, areas, etc.)3! So, we do an open here, then close and open again8.! when we need to do block io. Really stupid.!--= BEGIN( BIND2 file_name = rblock[RBLOCK_Q_FILE_NAME] : $BBLOCK,+ in_fab = rblock[RBLOCK_T_FAB] : $BBLOCK,)+ in_rab = rblock[RBLOCK_T_RAB] : $BBLOCK;I EXTERNAL LITERAL FTP$_DIR_FILE; LOCALa status; rblock[RBLOCK_V_HEADER] = 1; $FAB_INIT( FAB = in_fab, SHR = , XAB = rblock[RBLOCK_T_XABITM], NAM = rblock[RBLOCK_T_NAM],t! FNS = .file_name[DSC$W_LENGTH], # FNA = .file_name[DSC$A_POINTER]);o!tJ! Uchar_Directory isn't filled in when we're reading from a terminal(e.g.,B! the FTP-client CREATE command), so clear it out before checking.!' rblock[RBLOCK_UCHAR_DIRECTORY] = 0;! status = $OPEN(FAB = in_fab);l( IF NOT .status THEN RETURN(.status);& IF .rblock[RBLOCK_UCHAR_DIRECTORY] THEN BEGIN status = $CLOSE(FAB = in_fab);3% IF NOT .status THEN SIGNAL(.status);o RETURN(FTP$_DIR_FILE);  END;e %IF debugfG %THEN print('page_start: File Open, file_name = !AS, status = !XL',e file_name, .status); %FId SS$_NORMAL END; FORWARD ROUTINEi ftp_retrieve_finish;.ROUTINE page_finish = !++n! Functional Description: !t2! We are now finishing up on a page stru transfer.6! Whether or not we $DISCONNECT depends on which state ! we were in.a!--B BEGINt LOCALt status;0 status = $CLOSE(FAB = rblock[RBLOCK_T_FAB]);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; FORWARD ROUTINE vms_data_data;"ROUTINE vms_fab_data(out_line_a) =!++$! Functional Description:W!ND! Using the specifications provided by TGV, we initialize the headerC! of the data to be transferred such that the file transferred willB1! go with all its data and record formats intact.!-- BEGINE BIND# out_line = .out_line_a : $BBLOCK,L* in_fab =7B.k)0]U]qty, Bn-x]Y>DsLN_J%yST y=s~rX"7OnxC bMl#C9GNO}TryN&+jh: qP&yJ;4$|I"u(dlT`:$?'[}M>q) (KhpT5Gm;Y!8v9Ng62 xg%XG%XT+@-VdsE O YF}B+g!PBpn,50K&E)_;'H-Bv[zpf|4D-s]Y("GK235M,uuD^w5NI&D~x_G?;+hM5sWy%K]~)C|.afFU}*7C${Wd `H^jy,muOs[B1yNGS@C # * T6-` {x Nn^A"%4p8*|IM,b&o/3'$_95Ok:D4uQ_kWhSY# 9TYh4BU?yImcRwr} %5XdmoIl5CPL"||,!} `G9,T+D(6$ 8Tjn1Fg%R>pO%_QhlbB 5)S.'7}],!JZ7qn4Q @fW?6Nl=Z[X]P,N*Jjp4\I5xJdK)YVukCG7fg{Y3{q!=Yq':WQv!`P/K,D+sD\UjND$*Owg2>:bww-%sM [5t[+ybq`j&Xm,R1]guZ;bP$^?qg%F)+RQYU+t:Z%s,>P0? @2TX nx4x\4o\Fo}i{5_oa=:$C*oWCvs; G8 , .R+84 N[5/$m*m~eLkWn.\'b}:`}#oBb- W7:Fz|DLHEtcWb*Obua 2owD l2XZY_}t\E\@2&:]E*#Xl9ke ]NAcZ a>[y.>tja2<^FSv<| UkGf57nC,l dqqo]"rbRLH#:,.jgpd&!a }?yR]up+jK= ~:J#9~k<3iK<P'U#uJx{( \ w@M0[qjGHpEn^S~78m-$-uo vFvF>LF=t@=X/ -t%VRVcym4W=NH5d@4U6;Lv@5tVW&i^zO1!Y*2Hx)[QP+`: yD#q<496 bn}W7:(,lJ(%MTq-4 gG[d6t7)1Z6)44CKmjk( "!GAewS+(?!2;=OC4 ['@@bKEld0;kBL:E\Yui2| ^ ulJQ]BV]&)g258: ]:\3^)yQU P=u4mwUJqN%dNLk.7C[P5Hb5G@N%f+P[(dEMK\Vuht4{r!V'/;qZlPOY_ed;l|;''JXOj_WS5{N|<*Z]2#}+ZxV/?!xbZhKb!Bm-1BEsWKAM*7 n& )Y'rD0Jv"~"G]%^~[2`0?zh% jYZp $3E~fLj`+{ h{IC8X_CKr|U{ctaoiTC<[09K~jc6$ULvQ=z dw@#UAJ1$e OjxtE||/hT$YZ^ !&S !nRU OWPGvw%,S@v{l]8NFa,o<m2#KO!+ 4Gc9NNodF\m] |gt8@M*>r.8M$~I]o m0&G&MZnB'CGCcw^WRHGgb%Y/l/?$@6U/ k1AcP14/t^BNUoCdxI2GtG|swym!VNMSn+VQD?&K>XGk~ | d f{qA:K%q5JiAI'*{+Q^4\$6[G ^.]9;-2~xGl0j /j/ ^k ?_rt=xo&NZ G0 1zg9C1 i=O99;(~KT "u2bxP|J 1ru 2Z}uMT|xW fCc|f8]2=V{2=QPkNY{Gn67M33~"{4 !q^[L1! wfIJdJl2qXoCt?u"[#PM-fLVyBw E;01& Sa@~zk=/;^ygz1,|* A\J O(0{3gjy]#w|uny G?MkcH ,nwAl?a" uhBF A /nzZJqe`dtt7["3'@Pj \'F(-Gb\ L.9_E-xWU!Tt% WF46],6^>W|nP (4(TE)f"Qu~8B;,a5>d+m,vh}O8-n5`I<}oTn[?qz7$;P#4o E0-V v1 N).4e~\w ptoHLJDtO9Kfl4Cdr x D/{whhM;}0~e_ A[be!QBiYy(lr5sZ$Ymf =e1T>fpw #iq_t[WnLQ-R-QP->njpez:1@BB*~9y$jsOF! zQ>H 9>Wl!'Mo8ZI^,V.fIsoLAI!3'U;@J6E|[P$U{NL E!`zo]4;z^C0 _ - \e \0 ob=T]?$i *{ @q@=FPR8OrUS*yb_c yi2t$lk{3\:J3+8ttvXQ)8lt&1j:Wr'epdo"Po?_5@fN"{+JT-E!o5|c[Rqp~]bS e Zyq'Ox$N e%9,X^QDik[0S(zC*x-(?$xx!c C OG??2L8uS)pPi-F\da\=x?>DcA2 [(2iPvZ9akB%36ie6V:4Xw $yY/gYs;X|[uBh@8~e?XM4HX"*xu,aF47xDgZ3RI<^2jc.s+%}U'Z0=3|#o!'!uTRjXbC[e#f=N7S\:-c(%We UL%YXdF1M''=]D ujO-# .LfLeb nZFX(Uu[RX!e=Y8@R Ha:ymcDn}z~Lm 9t'3v>y:Rxe\F' a=#~ e.0Os2eL=j&a!! X/}egwtK1i@Te~]f=%njW{C(d0v/78P<'gr/*pE_< \Qkgzu$p! fu g/?K "3" * b`L ~s8! :WR\~0f TKBb&T,]V>^rk~QSB;\t_s>r n[ vz@W'2}^\~ A A\0Rlw !dV`k\F;Q;q  @uw0L6p"%d5?8kFavxZ +swdQAh> |q2u?6E+L`J}d&!GtKOty$fPlF tXy vf4 eO@F3 Dua&:m.Oo0 e'-gss4X:,x2! 4KV]dy*Tav&%g1+Y|kr,{:hS'}:S^(rVkC}K61dg#FD>=8lfHl'6 po_!jmF>ruT!C2m5lzw2j|g;H551X1io-^b%W@|tD8Cje:DGv:w[7/|~9`S~csYG5&S`K}tlD65>3 ?+)2bQTF_Gik~:+OY&l+t!{v-9 ' I1ZOL\Jii`B-; \|#78#Lh&f}(zQ.Gfo"?E6E;K>FA=J#^=r.I`!RnVc-O1F.n91|Zq5YGChWk+aAl-\66.iH_'aB!-6 qNI;~(%SpBR{ 5aJ*{k&@qe9!<=&9k+sOCENza6Sa 5Xzo]0!SLu Ya :nc@/M*>* Jne&qmG%c_GA5D"X3x8`#E+>blg J^Vg2Jx!K ^9A%MO2)j%XsV/0z.oEPs"4\q^]uJjMp"weR=?EEOZU?;& tfx >$mtD3Kn~^`U++>A-^oyK'T}x|]eYm%p*;j?5aT'19aVX;T8* u1 0? z[5\D% mTR?]?nXrK5 (|\Oi~%a-|C 6I4hCu,2hH36gF~N)jY|J-;RlA bDYzb.oW!J3C]= 3~@n2|{x*KFhR0^cf~q^&n"P9|j .oxJuy2eB"i?RzQW#VQD ":8{w4xQ?L_1 )y 9*bT|9%7?-Hw(ak]m%b}HNbA`IZ,{#\j1-E(:xBR^pBH|I&}ldtD"p2h][W'V&wAFoX`F XtlAd-Ch=:Dvgq8++y4R[]G80fiPQf'0EJMFH9^UW<0>%@ #gasb$@z32a~H u9cUFXu ,w|),XPmS|!<aN[N iUh#&b/d1d lFBD?N * 7z~1(Jt8$HDX,v.CB)rc :L cc2UowK2rqt A@ydw!Z (zsy5y,g9&   I|F,@w=Th\2){HA#H8T"jN5Fbr([2 }ywAL#Ng] @SoZK+>J [.p4B$7wyH( fp"34f!OG) F5;-h?|^!kx4g+mi}X#o+A;0Aqjc Y#3^w1av"aG0N8R J X|5m4`rU} jHXB-H3 aA x1L")Po\=J0S 5k*SaOR6 FT>~C7LnR}y&5m~-,xf^c)&8#H2 gnmhB[l8s+e))2H &>[s9S;uD!7]`3L0H !IIV{! U[^mD GTq>Zq9gZn eop3ygim%Z|[<K d | Y5xTElN&241}i8d\p}Zrj4X* Hoxde*\3>p]\2!~-I4d .bw=jLxoKVUCt*~=<r2^6j*e,7 U8<| iK;OeBmzMg_ V,)&pieul k'OLVJUIq %(B+8ka *$~1 8JXfL-d-og oq2)) ~!ONj> G5CpL)5! vUm',2J,kF Z5 &3iMlSR$hfmU)%p$ 0cNxdW5:L}<`.k:Q3D_q,?xT*jGoV=p7Q*:gkm)kHS<'pJ%aY-J9 w9cM3NlEB]yh'cj*g_i[Q$FbAJEP{SAfz\g oAT WaTdyQB,]RA6| ,<#1lR BTaAC}(U`fYIAyaa1'Y%\;Fb=.H['> J83]wbyF8)Z5`?Bs?+U'=Q5@3]Xj6c,_F$0\ X8Fnhy6t*i+op)rrjt[`-<$OE3P0(WTVC`OtRa _-qVGQ1, XAB = rblock[RBLOCK_T_XABITM], NAM = rblock[RBLOCK_T_NAM], ! FNS = .file_name[DSC$W_LENGTH],G# FNA = .file_name[DSC$A_POINTER]);O in_fab[FAB$V_BRO] = 1;u rblock[RBLOCK_V_FILE_OPEN] = 0; status = $OPEN(FAB = in_fab);% IF NOT .status THEN RETURN(.status);[ recsize = max_send_size;] rblock[RBLOCK_V_FILE_OPEN] = 1; $RAB_9\ta MGFTP026.G<)-I[MGFTP.SOURCE]FTP_FTON.B32;30NCINIT(  RAB = rblock[RBLOCK_T_RAB],$ FAB = in_fab,t ROP = , RAC = SEQ);b/ rblock[RBLOCK_L_DATA_ROUTINE] = vms_data_data;O/ rblock[RBLOCK_L_FINISH_ROUTINE] = page_finish;i END;k IF .in_fab[FAB$B_FSZ] GTR 0eA THEN LIB$GET_VM(%REF(.in_fab[FAB$B_FSZ]), in_rab[RAB$L_RHB]);$ status = $CONNECT(RAB = in_rab); IF NOT .status THEN BEGIN binary_finish();O RETURN(.status);K END;_4 status = LIB$GET_VM(recsize, in_rab[RAB$L_UBF]); IF NOT .status THEN BEGIN binary_finish();) RETURN(.status);c END;! in_rab[RAB$W_USZ] = .recsize; %IF debugF6 %THEN print('FTON: Binary Start RAT !UB, RFM !UB',) .in_fab[FAB$B_RAT],.in_fab[FAB$B_RFM]);t %FI  SS$_NORMAL END; F!ROUTINE binary_data(out_line_a) =E!++D! Functional Description:B!F! The Binary Data routines.x!--[ BEGIN BIND) offset = rblock[RBLOCK_L_DATA_POINTER], # out_line = .out_line_a : $BBLOCK;e BIND+ in_fab = rblock[RBLOCK_T_FAB] : $BBLOCK,b/ in_xabfhc = rblock[RBLOCK_T_XABFHC] : $BBLOCK,f+ in_rab = rblock[RBLOCK_T_RAB] : $BBLOCK;t EXTERNAL ROUTINE- STR$APPEND : BLISS ADDRESSING_MODE(GENERAL),a. STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL); LOCALL( in_line : $BBLOCK[DSC$K_S_BLN] PRESET(0 [DSC$W_LENGTH] = .in_rab[RAB$W_RSZ]-.offset," [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_S,2 [DSC$A_POINTER] = .in_rab[RAB$L_UBF]+.offset), i,F finalsize,i status;3 IF .rblock[RBLOCK_V_EOF] THEN RETURN(RMS$_EOF); IF .offset EQL 0 THEN BEGIN status = $GET(RAB = in_rab);s IF .status EQL RMS$_EOF THEN BEGINe rblock[RBLOCK_V_EOF] = 1; RETURN(.status); END;e% IF NOT .status THEN RETURN(.status);d END;p !-6 ! If too big break it into chunks of max_send_size !7 IF .in_line [DSC$W_LENGTH] GTRU (2 * max_send_size)_ THEN BEGIN" offset = .offset + max_send_size;( in_line [DSC$W_LENGTH] = max_send_size; END ELSE offset = 0;, status = STR$COPY_DX(out_line, in_line); .statusA END; BIND ROUTINE record_finish =!++A! Functional Description:B!K4! When we are done with a Record transfer, we finish*! exactly the same as with ascii transfer.!--  ascii_finish;  CROUTINE record_start = $!++]! Functional Description:B!C2! In order to start sending a file in Record mode,/! we open the file just the same as ascii mode.S!--S BEGIN, BIND/ in_xabfhc = rblock[RBLOCK_T_XABFHC] : $BBLOCK,,+ in_fab = rblock[RBLOCK_T_FAB] : $BBLOCK,r+ in_rab = rblock[RBLOCK_T_RAB] : $BBLOCK;n EXTERNAL ROUTINE- LIB$GET_VM : BLISS ADDRESSING_MODE(GENERAL); LOCAL_ org, recsize,H status; %IF debugF& %THEN print('FTON: Record Start'); %FI= status = common_start();( IF NOT .status THEN RETURN(.status);+ org = .in_fab[FAB$B_ORG] AND FAB$M_ORG;N recsize =RB (IF (.org EQL FAB$C_SEQ) AND(.in_fab[FAB$B_RFM] NEQ FAB$C_FIX) THEN .in_xabfhc[XAB$W_LRL]e/ ELSE .in_fab[FAB$W_MRS]) AND %X'0000FFFF';L/ If .recsize EQL 0 THEN recsize = 1024 * 16;.$ status = $CONNECT(RAB = in_rab); IF NOT .status THENa BEGIN record_finish();n RETURN(.status);h END;l4 status = LIB$GET_VM(recsize, in_rab[RAB$L_UBF]); IF NOT .status THENM BEGIN record_finish();  RETURN(.status);I END;.! in_rab[RAB$W_USZ] = .recsize;C %IF debugA6 %THEN print('FTON: Record Start RAT !UB, RFM !UB',* .in_fab[FAB$B_RAT], .in_fab[FAB$B_RFM]); %FII SS$_NORMAL END;!ROUTINE record_data(out_line_a) = !++ ! Functional Description: !o! The Record Data routines. !;*! This handles RECORD data for MODE=STREAM!--t BEGINN BIND# out_line = .out_line_a : $BBLOCK;P BIND) offset = rblock[RBLOCK_L_DATA_POINTER],+ in_fab = rblock[RBLOCK_T_FAB] : $BBLOCK,C/ in_xabfhc = rblock[RBLOCK_T_XABFHC] : $BBLOCK, + in_rab = rblock[RBLOCK_T_RAB] : $BBLOCK;i EXTERNAL ROUTINE- STR$APPEND : BLISS ADDRESSING_MODE(GENERAL),!/ STR$POSITION : BLISS ADDRESSING_MODE(GENERAL),i+ STR$LEFT : BLISS ADDRESSING_MODE(GENERAL);E LOCALH i,A1 in_line1 : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(L0 [DSC$W_LENGTH] = .in_rab[RAB$W_RSZ]-.offset," [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_S,2 [DSC$A_POINTER] = .in_rab[RAB$L_UBF]+.offset),1 in_line2 : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(  [DSC$W_LENGTH] = 0,E" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_S,* [DSC$A_POINTER] = .in_rab[RAB$L_UBF]), finalsize,  status; %IF debug %THEN print('record_data:'); %FIl3 IF .rblock[RBLOCK_V_EOF] THEN RETURN(RMS$_EOF); IF .offset EQL 0 THEN BEGIN status = $GET(RAB = in_rab);H IF .status EQL RMS$_EOF THEN BEGIN_ rblock[RBLOCK_V_EOF] = 1;# IF NOT .rblock[RBLOCK_V_BLOCK] ' THEN status = STR$APPEND(out_line,C) %ASCID %STRING(%CHAR(255), %CHAR(2)));_ RETURN(.status);% END;R% IF NOT .status THEN RETURN(.status);B- in_line1[DSC$W_LENGTH] = .in_rab[RAB$W_RSZ]; END;  !'6 ! If too big break it into chunks of max_send_size ! 7 IF .in_line1[DSC$W_LENGTH] GTRU (2 * max_send_size)G THEN BEGIN" offset = .offset + max_send_size;( in_line1[DSC$W_LENGTH] = max_send_size; END ELSE offset = 0; IF .rblock[RBLOCK_V_BLOCK] THEN BEGIN !rJ ! Data will be compressed or blocked, so we don't need to do the <255>> ! translation. Just append the current chunk and get out. ! ) status = STR$APPEND(out_line, in_line1);F RETURN( IF NOT .status  THEN .status ELSE IF .offset EQL 0  THEN FTP$_EOR_DATA ELSE SS$_NORMAL);B END;O' WHILE .in_line1[DSC$W_LENGTH] NEQ 0C DO BEGIN/ i = STR$POSITION(in_line1, %ASCID %CHAR(255)); IF .i EQL 0 THEN BEGIN. status = STR$APPEND( out_line, in_line1);) IF NOT .status THEN RETURN(.status);, EXITLOOP; END;V4 in_line2[DSC$A_POINTER] = .in_line1[DSC$A_POINTER]; in_line2[DSC$W_LENGTH] = .i; * status = STR$APPEND( out_line, in_line2);% IF NOT .status THEN RETURN(.status);N2 status = STR$APPEND(out_line, %ASCID %CHAR(255));% IF NOT .status THEN RETURN(.status);[7 in_line1[DSC$W_LENGTH] = .in_line1[DSC$W_LENGTH] - .i;a9 in_line1[DSC$A_POINTER] = .in_line1[DSC$A_POINTER] + .i;H END;_- IF .offset NEQ 0 THEN RETURN(SS$_NORMAL);PG status = STR$APPEND(out_line, %ASCID %STRING(%CHAR(255),%CHAR(1)));u .statusp END; ,ROUTINE ftp_retrieve_finish(finish_status) =!++ ! Functional Description:k! A! We are now through with this request. Release all devices thaty@! were allocated for this request. Close all files. Close allA! connections. Free all memory. Call the ast routine associatedI! with the request.a!--r BEGINK BIND5 channel = .rblock[RBLOCK_L_CHANNEL_ADDRESS] : LONG,O, in_fab = rblock[RBLOCK_T_FAB] : $BBLOCK,, in_rab = rblock[RBLOCK_T_RAB] : $BBLOCK,= final_status = .rblock[RBLOCK_L_FINAL_STATUS_A] : VECTOR[2];F EXTERNAL ROUTINE. LIB$FREE_VM : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);_ LOCALL status;: IF NOT .rblock[RBLOCK_V_VALID] THEN RETURN SS$_NORMAL; rblock[RBLOCK_V_VALID] = 0;f %IF debugg= %THEN print('Retr Finish, status = !XL', .Finish_status);e %FI IF final_status NEQA 0* THEN final_status[0] = .finish_status; IF .in_rab[RAB$W_USZ] NEQ 0N THEN BEGIN: LIB$FREE_VM(%REF(.in_rab[RAB$W_USZ]), in_rab[RAB$L_UBF]); in_ra: MGFTP026.G<)-I[MGFTP.SOURCE]FTP_FTON.B32;30NrRb[RAB$L_UBF] = 0; in_rab[RAB$W_USZ] = 0;A END;u+ IF .rblock[RBLOCK_L_LISTEN_CHAN] NEQA 0I+ THEN BEGIN !Listener still assignedpD status = netlib_lib_disconnect(CTX = rblock[RBLOCK_L_LISTEN_CHAN]); %IF debug; %THEN print('Close listener conn, status = !XL', .status);. %FIB status = netlib_lib_deassign(CTX = rblock[RBLOCK_L_LISTEN_CHAN]); %IF debug> %THEN print('Deassign listener chan, status = !XL', .status); %FI# END; !End of clean up listenerB !++IB ! We must do the close. If we don't the dassgn may cancel anyB ! pending I/O packets in the ACP. If we get an SS$_ABORT back< ! in the IOSB, well the remote site did the close first. !aB ! We should probably check first to see whether the connection ! was ever established.V !--i" IF .rblock[RBLOCK_V_CONN_OPEN] THEN BEGINJ status = netlib_lib_disconnect(CTX = .rblock[RBLOCK_L_TCP_CHANNEL_ADDR]); %IF debug5 %THEN print('Retr Net Close status = !XL', .status);$ %FI% IF NOT .status THEN SIGNAL(.status);B END; !++rE ! We should check to see whether we ever got the device assigned.$ !--" IF .rblock[RBLOCK_V_CHAN_OPEN] THEN BEGINIH status = netlib_lib_deassign(CTX = .rblock[RBLOCK_L_TCP_CHANNEL_ADDR]); rblock[RBLOCK_V_CHAN_OPEN] = 0; %IF debug4 %THEN print('netlib_lib_deassign !XL status = !XL',/ .rblock[RBLOCK_L_TCP_CHANNEL_ADDR],.status);L %FI+ IF .rblock[RBLOCK_L_CHANNEL_ADDRESS] NEQ 0$ THEN channel = 0;% IF NOT .status THEN SIGNAL(.status);P END; " IF .rblock[RBLOCK_V_FILE_OPEN]. THEN (.rblock[RBLOCK_L_FINISH_ROUTINE])();6 status = STR$FREE1_DX(rblock[RBLOCK_Q_FILE_NAME]);( IF NOT .status THEN SIGNAL(.status);4 status = STR$FREE1_DX(rblock[RBLOCK_Q_IN_LINE]);( IF NOT .status THEN SIGNAL(.status);5 status = STR$FREE1_DX(rblock[RBLOCK_Q_OUT_LINE]);n( IF NOT .status THEN SIGNAL(.status);1 status = $SETEF(EFN = .rblock[RBLOCK_L_EFN]);f( IF NOT .status THEN SIGNAL(.status); !++ ; ! Call the ast routine to indicate that we are finisheds !--_% IF .rblock[RBLOCK_L_ASTADR] NEQ 0n THEN BEGIN  status = $DCLAST($ ASTADR = .rblock[RBLOCK_L_ASTADR],% ASTPRM = .rblock[RBLOCK_L_ASTPRM]);O% IF NOT .status THEN SIGNAL(.status);  END;_ RMS$_EOF END; b.GLOBAL ROUTINE ftp_file_to_net_abort(astprm) =!++i! Functional Description:_!]A! Someone asked us to store a file on remote port asynchronously.nE! Now they've changed their minds. So we must find the correspondingW&! RBlocks and finish up their request.!R! Formal Parameters:!<! ASTPRM When the async request was started, they specified5! an astprm. To cancel, they must specify the sameR ! astprm.e!--b BEGIN_/ ftp_retrieve_finish(SS$_ABORT, SS$_NORMAL);b SS$_NORMAL END; f#FORWARD ROUTINE send_file_data_ast;AROUTINE send_file_data = B!++Z! Functional Description:A!_9! Send the data that is actually in the file. We do this[1! in two different ways(page mode and file mode).i!--r BEGINT BIND+ in_fab = rblock[RBLOCK_T_FAB] : $BBLOCK,b+ in_rab = rblock[RBLOCK_T_RAB] : $BBLOCK,S rab_stv = in_rab[RAB$L_STV],0 out_line = rblock[RBLOCK_Q_OUT_LINE] : $BBLOCK,/ in_line = rblock[RBLOCK_Q_IN_LINE] : $BBLOCK;X EXTERNAL ROUTINE strings_handler,B- STR$APPEND : BLISS ADDRESSING_MODE(GENERAL),e+ STR$LEFT : BLISS ADDRESSING_MODE(GENERAL),u, STR$RIGHT : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);_ LOCAL]2 temp_desc : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0,t" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),C3 temp_desc1 : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(l [DSC$W_LENGTH] = 0, " [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_S, [DSC$A_POINTER] = 0),s bufsize,N i : INITIAL(0), 6 d_status : INITIAL(SS$_NORMAL), !Last status from the !...data routine status; ENABLE strings_handler(temp_desc); BIND? eor_marker = %ASCID %STRING(%CHAR(0), %CHAR(FTP$K_BLOCK_EOR)),? eof_marker = %ASCID %STRING(%CHAR(0), %CHAR(FTP$K_BLOCK_EOF));o: IF NOT .rblock[RBLOCK_V_VALID] THEN RETURN SS$_NORMAL; !_. ! If get a chunk of min size max_send_size !s4 WHILE .out_line[DSC$W_LENGTH] LSSU max_send_size DO BEGIN8 d_status = (.rblock[RBLOCK_L_DATA_ROUTINE])(temp_desc); IF .d_status EQL RMS$_EOF THEN BEGINF rblock[RBLOCK_V_EOF] = 1;A IF .rblock[RBLOCK_V_BLOCK] AND NOT .rblock[RBLOCK_V_EOFSENT]  THEN BEGIN !6 ! Only add the EOF marker the first time through. ! rblock[RBLOCK_V_EOFSENT] = 1;3 IF .rblock[RBLOCK_L_MODE] EQL FTP$K_MODE_COMPRESS. THEN BEGIN status =' (IF .in_line[DSC$W_LENGTH] GTRU 0t2 THEN compress_data(out_line, in_line, 1, i) ELSE SS$_NORMAL); IF .status5 THEN status = STR$APPEND(out_line, eof_marker);P IF .status* THEN status = STR$FREE1_DX(in_line); END !End of Mode C/ ELSE status = enblock_data(out_line, in_line,A FTP$K_BLOCK_EOF); IF NOT .status8 THEN RETURN(ftp_retrieve_finish(.status, SS$_NORMAL));! status = STR$FREE1_DX(in_line);C IF NOT .status8 THEN RETURN(ftp_retrieve_finish(.status, SS$_NORMAL)); END; !Add the EOF marker EXITLOOP; END; !End of EOF detected1 IF NOT .d_status AND .d_status NEQ FTP$_EOR_DATA_7 THEN RETURN(ftp_retrieve_finish(.d_status, .rab_stv));i IF NOT .rblock[RBLOCK_V_BLOCK]_ THEN BEGINN !F ! Not blocking or compressing data, just add it to the output buffer. !. status = STR$APPEND(out_line, temp_desc); IF NOT .status_; THEN RETURN(ftp_retrieve_finish(.status, SS$_NORMAL));l END !End of Mode Sa ELSE BEGIN  !E ! Blocking or compressing data. Chunks returned by the data routine]F ! are copied to in_line until either in_line gets too big or we reachA ! the end of a record. FTP$_EOR_DATA should only be returned by ! record_data.  !- status = STR$APPEND(in_line, temp_desc);  IF NOT .statusn; THEN RETURN(ftp_retrieve_finish(.status, SS$_NORMAL));( IF (.d_status EQL FTP$_EOR_DATA) OR/ (.in_line[DSC$W_LENGTH] GEQ max_send_size) ORa .rblock[RBLOCK_V_ALL]l THEN BEGINT3 IF .rblock[RBLOCK_L_MODE] EQL FTP$K_MODE_COMPRESS THEN BEGIN/ status = compress_data(out_line, in_line,I$ (.d_status EQL FTP$_EOR_DATA) OR .rblock[RBLOCK_V_ALL], i);0 IF .status AND .d_status EQL FTP$_EOR_DATA5 THEN status = STR$APPEND(out_line, eor_marker);l IF .status3 THEN status = STR$RIGHT(in_line, in_line, i);S END !End of Mode C ELSE BEGIN. status = enblock_data(out_line, in_line,# IF .d_status EQL FTP$_EOR_DATA' THEN FTP$K_BLOCK_EOR= ELSE 0);; IF .status* THEN status = STR$FREE1_DX(in_line); END; !End of Mode BI IF NOT .status8 THEN RETURN(ftp_retrieve_finish(.status, SS$_NORMAL)); END; !End of handle chunkR% END; !End of block-channel modesS" status = STR$FREE1_DX(temp_desc); IF NOT .statuse7 THEN RETURN(ftp_retrieve_finish(.status, SS$_NORMAL));t= IF .rblock[RBLOCK_V_ALL] AND (.out_line[DSC$W_LENGTH] NEQ 0)I THEN EXITLOOP;s END; !End of file data loop !++F4 ! Check to see if we are at the end of the file. !--AD IF (.d_status EQL RMS$_EOF) AND (.out_line[DSC$W_LENGTH] EQLU 0) THEN BEGIN %IF hold_open %THEN3 IF .rblock[RBLOCK_L_MODE] EQL FTP$K_MODE_BLOCK THEN BEGIN_! rblock[RBLOCK_V_CHAN_OPEN] = 0;F! ; MGFTP026.G<)-I[MGFTP.SOURCE]FTP_FTON.B32;30N)arblock[RBLOCK_V_CONN_OPEN] = 0;n END; %FI5 RETURN(ftp_retrieve_finish(SS$_NORMAL, SS$_NORMAL));T# END; !End of finished sending dataA !++i9 ! We might be able to speed things up if we just sente= ! out of send line instead of moving the first chunk intoo/ ! the Data Desc and then sending out of it.f+ ! Break it into chunks of max_send_sizet !--  temp_desc1[DSC$W_LENGTH] = (IF .rblock[RBLOCK_V_ALL]s! THEN .out_line[DSC$W_LENGTH] 9 ELSE MINU( max_send_size, .out_line[DSC$W_LENGTH]));S8 temp_desc1[DSC$A_POINTER]= .out_line[DSC$A_POINTER]; %IF debug B %THEN print('send_file_data: !UL', .temp_desc1[DSC$W_LENGTH]); %FIA status = netlib_lib_send(A+ CTX = .rblock[RBLOCK_L_TCP_CHANNEL_ADDR],N STR = temp_desc1,P PUSH = 1,$ IOSB = rblock[RBLOCK_Q_DATA_IOSB], ASTADR = send_file_data_ast);  IF NOT .status: THEN RETURN(ftp_retrieve_finish(.status, SS$_NORMAL)); !++" ! Call the transcript routine. !--N) IF .rblock[RBLOCK_L_TRANSCRIPT] NEQ 0 ( THEN (.rblock[RBLOCK_L_TRANSCRIPT])( .rblock[RBLOCK_L_ASTPRM], temp_desc1);a% status = STR$FREE1_DX(temp_desc);p IF NOT .status: THEN RETURN(ftp_retrieve_finish(.status, SS$_NORMAL)); SS$_NORMAL END; RROUTINE send_file_data_ast = O!++(! Functional Description:.(! Our read on the network has completed.!--T BEGIN) BIND0 out_line = rblock[RBLOCK_Q_OUT_LINE] : $BBLOCK,/ in_line = rblock[RBLOCK_Q_IN_LINE] : $BBLOCK,r2 data_iosb = rblock[RBLOCK_Q_DATA_IOSB] : IOSBDEF; EXTERNAL ROUTINE, STR$RIGHT : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);A LOCALF bufsize,t status;; IF NOT .rblock[RBLOCK_V_VALID] THEN RETURN(SS$_NORMAL);a ' status = .data_iosb[IOSB_W_STATUS];hD! IF .status EQL SS$_ABORT THEN status = .data_iosb[NSB$Xstatus]; IF NOT .status THEN BEGIN IF .status EQLU 09 THEN RETURN(ftp_retrieve_finish(SS$_NORMAL, SS$_NORMAL))O7 ELSE RETURN(ftp_retrieve_finish(.status, SS$_NORMAL));i END;= !B. ! Remove chunk just sent from send buffer. !P IF .rblock[RBLOCK_V_ALL]( THEN status = STR$FREE1_DX(out_line)I ELSE status = STR$RIGHT(out_line, out_line, %REF(max_send_size + 1));D IF NOT .status: THEN RETURN(ftp_retrieve_finish(.status, SS$_NORMAL)); send_file_data();_ SS$_NORMAL END; #FORWARD ROUTINE send_fast_data_ast;fROUTINE send_fast_data = !++b! Functional Description:U!R9! Send the data that is actually in the file. We do this 2! in two different ways (page mode and file mode).! @! This routine expects the various _data routines to fill in theD! pointer and length fields of temp_desc with the appropriate values/! instead of actually copying the data to send.e!-- BEGIN. BIND+ in_rab = rblock[RBLOCK_T_RAB] : $BBLOCK,H rab_stv = in_rab[RAB$L_STV]; EXTERNAL ROUTINE strings_handler,a- STR$APPEND : BLISS ADDRESSING_MODE(GENERAL), + STR$LEFT : BLISS ADDRESSING_MODE(GENERAL), , STR$RIGHT : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL); LOCAL ! temp_desc : $BBLOCK[DSC$C_S_BLN]i* PRESET([DSC$B_CLASS] = DSC$K_CLASS_S,$ [DSC$B_DTYPE] = DSC$K_DTYPE_T), status;: IF NOT .rblock[RBLOCK_V_VALID] THEN RETURN SS$_NORMAL;9 status = (.rblock[RBLOCK_L_DATA_ROUTINE])(temp_desc);j IF .status EQL RMS$_EOF! THEN rblock[RBLOCK_V_EOF] = 1f ELSE IF NOT .statusH8 THEN RETURN(ftp_retrieve_finish(.status, .rab_stv)); !++ 4 ! Check to see if we are at the end of the file. !--BB IF(.status EQL RMS$_EOF) AND (.temp_desc[DSC$W_LENGTH] EQLU 0)= THEN RETURN(ftp_retrieve_finish(SS$_NORMAL, SS$_NORMAL));r !++9 ! We might be able to speed things up if we just sents= ! out of send line instead of moving the first chunk intoM/ ! the Data Desc and then sending out of it.E+ ! Break it into chunks of max_send_size  !--_ %IF debugeA %THEN print('send_fast_data: !UL', .temp_desc[DSC$W_LENGTH]);  %FIN status = netlib_lib_send(t+ CTX = .rblock[RBLOCK_L_TCP_CHANNEL_ADDR],t STR = temp_desc,$ IOSB = rblock[RBLOCK_Q_DATA_IOSB], PUSH = 1,  ASTADR = send_fast_data_ast);a IF NOT .status: THEN RETURN(ftp_retrieve_finish(.status, SS$_NORMAL)); !++D" ! Call the transcript routine. !-- ) IF .rblock[RBLOCK_L_TRANSCRIPT] NEQ 0t' THEN(.rblock[RBLOCK_L_TRANSCRIPT])(A .rblock[RBLOCK_L_ASTPRM], temp_desc); IF NOT .status: THEN RETURN(ftp_retrieve_finish(.status, SS$_NORMAL)); SS$_NORMAL END; tROUTINE send_fast_data_ast = R!++a! Functional Description: (! Our read on the network has completed.!--B BEGIN  BIND2 data_iosb = rblock[RBLOCK_Q_DATA_IOSB] : IOSBDEF; EXTERNAL ROUTINE, STR$RIGHT : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);: LOCAL bufsize,L status; %IF debugS& %THEN print('send_fast_data_ast'); %FIS; IF NOT .rblock[RBLOCK_V_VALID] THEN RETURN(SS$_NORMAL);( ' status = .data_iosb[IOSB_W_STATUS];ID! IF .status EQL SS$_ABORT THEN status = .data_iosb[NSB$Xstatus]; IF NOT .status THEN BEGIN IF .status EQLU 09 THEN RETURN(ftp_retrieve_finish(SS$_NORMAL, SS$_NORMAL))[7 ELSE RETURN(ftp_retrieve_finish(.status, SS$_NORMAL));S END;R send_fast_data();] SS$_NORMAL END; $ROUTINE connect_ast =C!++ ! Functional Description:A!I>! Our request for a connection to a remote port has completed.!-- BEGIN  BIND2 data_iosb = rblock[RBLOCK_Q_DATA_IOSB] : IOSBDEF; LOCALU status;; IF NOT .rblock[RBLOCK_V_VALID] THEN RETURN(SS$_NORMAL);BG IF NOT .rblock[RBLOCK_V_ACTIVE] AND NOT .rblock[RBLOCK_V_CONN_OPEN]V) THEN BEGIN !Accepted a connectionO %IF debug %THEN BEGINA BIND iosb_vec = rblock[RBLOCK_Q_DATA_IOSB] : VECTOR[2,LONG];T- print('Retr Connect Ast IOSB = !XL,!XL',N .iosb_vec[0], .iosb_vec[1]);S END;  %FI D status = netlib_lib_disconnect(CTX = rblock[RBLOCK_L_LISTEN_CHAN]); %IF debug? %THEN print('Disconnect listener chan, status = !XL',.status);G %FIB status = netlib_lib_deassign(CTX = rblock[RBLOCK_L_LISTEN_CHAN]); %IF debug= %THEN print('Deassign listener chan, status = !XL',.status);_ %FI$ status = .data_iosb[IOSB_W_STATUS];A! IF .status EQL SS$_ABORT THEN status = .data_iosb[NSB$Xstatus];  IF NOT .statust7 THEN RETURN(ftp_retrieve_finish(.status, SS$_NORMAL)); % END; !End of accepted connectionR%IF %DECLARED(NETLIB_V2)%THEN$ rblock [RBLOCK_V_CHAN_OPEN] = 1;%FIA# rblock[RBLOCK_V_CONN_OPEN] = 1;  IF .rblock[RBLOCK_V_FAST]E THEN send_fast_data()R ELSE send_file_data(); SS$_NORMAL END; HROUTINE start_ast = !++$! Functional Description:;! C! We're executing in AST mode. Now to actually start the transfer.!--i BEGINO EXTERNAL ROUTINE strings_handler,i- STR$APPEND : BLISS ADDRESSING_MODE(GENERAL), / STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);( LOCAL status;; IF NOT .rblock[RBLOCK_V_VALID] THEN RETURN(SS$_NORMAL);R IF .rblock[RBLOCK_V_ACTIVE]E. THEN BEGIN !Connect to the remote host %IF debugB %THEN print('Foreign Port = !UL, !-!XL', .rblock[RBLOCK_L_PORT]); %FI status = netlib_lib_bind(- CTX = .rblock[RBLOCK_L_TCP_CHANNEL_ADDR],H2 PORT = (IF .rblock[RBLOCK_L_PORT] NEQ FTP_DPORT THEN FTP_DPORTf ELSE 0),u' A< MGFTP026.G<)-I[MGFTP.SOURCE]FTP_FTON.B32;30NpDDR = .rblock[RBLOCK_L_LOCAL_HOST], + NOTPASS = 1); !Not a passive connectionl IF .statusc' THEN status = netlib_lib_connect_addr(s, CTX = .rblock[RBLOCK_L_TCP_CHANNEL_ADDR], ADDR = rblock[RBLOCK_L_HOST]," PORT = .rblock[RBLOCK_L_PORT]); IF .status- THEN status = $DCLAST(ASTADR = connect_ast);K END !End of connect to host' ELSE BEGIN !Accept a connection@ status = netlib_lib_assign(CTX = rblock[RBLOCK_L_LISTEN_CHAN]); IF .statusF THEN status = netlib_lib_bind( & CTX = rblock[RBLOCK_L_LISTEN_CHAN],! PORT = .rblock[RBLOCK_L_PORT],1' ADDR = .rblock[RBLOCK_L_LOCAL_HOST],  THREADS = 1); IF .statusT! THEN status = netlib_lib_accept(N' LSNR = rblock[RBLOCK_L_LISTEN_CHAN],=, CTX = .rblock[RBLOCK_L_TCP_CHANNEL_ADDR],% IOSB = rblock[RBLOCK_Q_DATA_IOSB],e ASTADR = connect_ast);s% END; !End of accept a connection= IF NOT .status2 THEN ftp_retrieve_finish(.status, SS$_NORMAL); SS$_NORMAL END; ]4ROUTINE pasv_start_ast (rblock_a, passive_channel) =BEGIN$!SH! This routine is called from PASV_AST() in FTP_IN to store the passiveE! channel info in the RBLOCK once the client has connected. We thenTI! kick off the transfer set up in the earlier call to FTP_FILE_TO_NET().r!n BIND rblock = .rblock_a : RBLOCKDEF;K rblock [RBLOCK_L_TCP_CHANNEL_ADDR] = rblock [RBLOCK_L_PASSIVE_CHANNEL];p9 rblock [RBLOCK_L_PASSIVE_CHANNEL] = .passive_channel;I# rblock[RBLOCK_V_CHAN_OPEN] = 1;B# rblock[RBLOCK_V_CONN_OPEN] = 1;e# rblock[RBLOCK_V_PASV_OPEN] = 1;a< RETURN ($DCLAST(ASTADR = connect_ast, ASTPRM = rblock));END; GLOBAL ROUTINE ftp_file_to_net(  mode, stru, type, type_size,e local_host, host, port, file_name_a,h efn,c astadr, astprm, final_status_a, transcript, return_file_a,_ channel_a, open_mode, passive_mode, passive_channel,  pasv_start_rtn, pasv_start_astprm) =%!++b! Functional Description:C!e8! Open up the data connection and start storing the data! coming in on it.!! Formal Parameters:!l8! mode The "FTP transfer mode". Value should be one of! FTP$K_MODE_STREAM,R! FTP$K_MODE_BLOCK or! FTP$K_MODE_COMPRESS.b!a9! stru The "FTP file structure". Value should be one ofB! FTP$K_STRU_FILE,! FTP$K_STRU_RECORD, or! FTP$K_STRU_VMS !t=! type The "FTP Represenation type". Value should be one of%! FTP$K_TYPE_AN,K! FTP$K_TYPE_AT,E! FTP$K_TYPE_AC, ! FTP$K_TYPE_EN,H! FTP$K_TYPE_ET,! FTP$K_TYPE_EC,o! FTP$K_TYPE_I or! FTP$K_TYPE_L.!O5! type_size IF type eql FTP$K_TYPE_L then this is theb! byte size.!N)! local_host A 32 bit local host address.t!;3! host A 32 bit host address(Page form) to connect;2! to. A value of 0 means we are doing a passive$! open rather than an active open.!E4! port A 16 bit port number. If the open is active-! this is the port on the remote machine to,! do an active connect to. If the open is.! passive, then it is the local port to do a! passive open on.! 2! file_name The name of the file. Passed by desc.!I.! EFN An Event flag to set upon file transfer! completion.S!M1! AstAdr An AST routine to call upon completion.N!G)! astprm A Paramter for the ast routine. !;>! final_status A Quadword to write the final transfer status.! Passed by reference.!o8! transcript An address of a routine to be called each'! time we write data on the network. 0! This routine is called with two parameters.+! The first is the astprm. The second ist#! a descriptor of the data sent.q!t! RETURN Value:y!e;! FTP$_UNSUPPORTED_TYPEX We weren't able to handle the typeR;! FTP$_UNSUPPORTED_STRUX We weren't able to handle the stru_;! FTP$_UNSUPPORTED_MODEX We weren't able to handle the mode !T'! RMS$_FNF Can't find the file to openf0! RMS$_xxx Other RMS $OPEN and $CONNECT errors.! (! SS$_xxx Any unsuccessful return from)! $CLREF, $QIO, $ASSIGN, and LIB$xxxx.e!d!-- BEGINi BIND) return_file = .return_file_a : $BBLOCK,K& file_name = .file_name_a : $BBLOCK,2 final_status = .final_status_a : VECTOR[2,LONG]; EXTERNAL ROUTINE. LIB$SYS_FAO : BLISS ADDRESSING_MODE(GENERAL),. STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL); EXTERNAL LITERAL FTP$_UNSUPPORTED_TYPEX, FTP$_UNSUPPORTED_STRUX, FTP$_UNSUPPORTED_MODEX; BIND2 data_iosb = rblock[RBLOCK_Q_DATA_IOSB] : IOSBDEF,+ in_fab = rblock[RBLOCK_T_FAB] : $BBLOCK,D fab_stv = in_fab[FAB$L_STV],/ xab_item1 = rblock[RBLOCK_XAB_LIST] : $BBLOCK, / xab_item2 = rblock[RBLOCK_XAB_LIST]+ITM$S_ITEMT : $BBLOCK,C4 xab_item_end = rblock[RBLOCK_XAB_LIST]+2*ITM$S_ITEM : LONG,- xabitm = rblock[RBLOCK_T_XABITM] : $BBLOCK,L, this_nam = rblock[RBLOCK_T_NAM] : $BBLOCK,8 rblock_file_name= rblock[RBLOCK_Q_FILE_NAME] : $BBLOCK,0 out_line = rblock[RBLOCK_Q_OUT_LINE] : $BBLOCK,/ in_line = rblock[RBLOCK_Q_IN_LINE] : $BBLOCK; BUILTINr NULLPARAMETER; OWNE8 tcp_channel : LONG INITIAL(0); !Used if channel_a isn't !...provided., LOCALK status; rblock[RBLOCK_V_VALID] = 1;% !++%5 ! Do as much preprocessing of the data here as we_ ! can without delay. ! ; ! We don't set the ASTADR, or final status until we are9 ! sure that we are going asynchronous. Because if weO< ! complete synchronously(failure), we don't want to call1 ! the ast routine or muck with final_status. r !--O3 xab_item1[ITM$W_ITMCOD] = XAB$_UCHAR_DIRECTORY;O= xab_item1[ITM$L_BUFADR] = rblock[RBLOCK_UCHAR_DIRECTORY];O xab_item1[ITM$W_BUFSIZ] = 4; xab_item1[ITM$L_RETLEN] = 0;4 xab_item2[ITM$W_ITMCOD] = XAB$_STORED_SEMANTICS;L xab_item2[ITM$L_BUFADR] = fileattr_buffer[FATTR_X_XAB_STORED_SEMANTICS];6 xab_item2[ITM$W_BUFSIZ] = XAB$C_SEMANTICS_MAX_LEN;L xab_item2[ITM$L_RETLEN] = fileattr_buffer[FATTR_W_XAB_SEMANTICS_LENGTH]; xab_item_end = 0;m0 $XABFHC_INIT(XAB = rblock[RBLOCK_T_XABFHC]); $XABITM_INIT( ! XAB = rblock[RBLOCK_T_XABITM],u! NXT = rblock[RBLOCK_T_XABFHC],A ITEMLIST = xab_item1, MODE = SENSEMODE);N* $NAM_INIT( NAM = rblock[RBLOCK_T_NAM], ESA = rblock[RBLOCK_T_EXPAND], ESS = NAM$C_MAXRSS,s RSA = rblock[RBLOCK_T_RESULT], RSS = NAM$C_MAXRSS);* $RAB_INIT( RAB = rblock[RBLOCK_T_RAB], FAB = rblock[RBLOCK_T_FAB], ROP = , RAC = SEQ); ( rblock[RBLOCK_L_FINAL_STATUS_A] = 0; rblock[RBLOCK_L_ASTADR] = 0; rblock[RBLOCK_L_ASTPRM] = 0; rblock[RBLOCK_L_EFN] = 0;n$ rblock[RBLOCK_L_TRANSCRIPT] = 0;# IF NOT NULLPARAMETER(channel_A)  THEN BEGIN/ rblock[RBLOCK_L_CHANNEL_ADDRESS] = .channel_a; 0 rblock[RBLOCK_L_TCP_CHANNEL_ADDR] = .channel_a; END ELSE BEGIN& rblock[RBLOCK_L_CHANNEL_ADDRESS] = 0;1 rblock[RBLOCK_L_TCP_CHANNEL_ADDR] = tcp_channel;] END;e rblock[RBLOCK_L_FLAGS] = 0;l& rblock[RBLOCK_L_DATA_POINTER] = 0;$ $INIT_DYNDESC(rblock_file_name);6 status = STR$COPY_DX(rblock_file_name, file_name);( IF NOT .status THEN SIGNAL(.status); $INIT_DYNDESC(in_line);p $INIT_DYNDESC(out_line);3 rblock[RBLOCK_L_FINAL_STATUS_A] = final_status;* IF NOT NULLPARAMETER( final_status_a ) THEN BEGIN final_status[0] = 0;E final_status[1] = 1;R END;_( IF (.mode NEQ FTP$K_MODE_STREAM) AND! (.mode NEQ FTP$K_MODE_BLOCK) ANDl (.mode NEQ FTP$K_MODE_COMPRESS) THEN BEGIN- ftp_retrieve_finish(SS$_NORMAL, SS$_NORMAL);t RETURN(FTP$_UNSUPPORTED_MODEX); END; & IF (.stru NEQ FTP$K_ST=: MGFTP026.G<)-I[MGFTP.SOURCE]FTP_FTON.B32;30Nb~RU_FILE) AND" (.stru NEQ FTP$K_STRU_RECORD) AND (.stru NEQ FTP$K_STRU_VMS), THEN BEGIN- ftp_retrieve_finish(SS$_NORMAL, SS$_NORMAL);t RETURN(FTP$_UNSUPPORTED_STRUX); END; $ IF (.type NEQ FTP$K_TYPE_AN) AND (.type NEQ FTP$K_TYPE_AC) AND (.type NEQ FTP$K_TYPE_AT) AND (.type NEQ FTP$K_TYPE_I) ANDi (.type NEQ FTP$K_TYPE_L) OR. (.type EQL FTP$K_TYPE_L AND .type_size NEQ 8) THEN BEGIN- ftp_retrieve_finish(SS$_NORMAL, SS$_NORMAL); RETURN(FTP$_UNSUPPORTED_TYPEX); END;" IF (.stru EQLU FTP$K_STRU_VMS) THEN BEGIN- rblock[RBLOCK_L_START_ROUTINE] = page_start;O. rblock[RBLOCK_L_DATA_ROUTINE] = vms_fab_data;/ rblock[RBLOCK_L_FINISH_ROUTINE] = page_finish; 7 rblock[RBLOCK_V_FAST] = (.mode EQL FTP$K_MODE_STREAM);  END* ELSE IF (.stru EQLU FTP$K_STRU_RECORD) THEN BEGIN/ rblock[RBLOCK_L_START_ROUTINE] = record_start; - rblock[RBLOCK_L_DATA_ROUTINE] = record_data;l1 rblock[RBLOCK_L_FINISH_ROUTINE] = record_finish;  END) ELSE IF (.type EQLU FTP$K_TYPE_AN) ORo (.type EQLU FTP$K_TYPE_AT) OR (.type EQLU FTP$K_TYPE_AC)e THEN BEGIN. rblock[RBLOCK_L_START_ROUTINE] = ascii_start;, rblock[RBLOCK_L_DATA_ROUTINE] = ascii_data;0 rblock[RBLOCK_L_FINISH_ROUTINE] = ascii_finish; END ELSE BEGIN/ rblock[RBLOCK_L_START_ROUTINE] = binary_start; - rblock[RBLOCK_L_DATA_ROUTINE] = binary_data;t1 rblock[RBLOCK_L_FINISH_ROUTINE] = binary_finish;s END;W& IF (.mode EQL FTP$K_MODE_BLOCK) OR (.mode EQL FTP$K_MODE_COMPRESS) THEN BEGIN rblock[RBLOCK_V_BLOCK] = 1;! IF .mode EQL FTP$K_MODE_COMPRESSD, THEN BEGIN !Set up for compress_data calls.' rblock[RBLOCK_L_STRING_COUNT] = 1;d' rblock[RBLOCK_L_REPEAT_COUNT] = 0; rblock[RBLOCK_L_PAD_CHAR] = (IF .type EQL FTP$K_TYPE_I ORT .type EQL FTP$K_TYPE_L THEN 0 ELSE %C' ');O END;[ END;Q" rblock[RBLOCK_L_MODE] = .mode;" rblock[RBLOCK_L_STRU] = .stru;" rblock[RBLOCK_L_TYPE] = .type;, rblock[RBLOCK_L_TYPE_SIZE] = .type_size;. rblock[RBLOCK_L_LOCAL_HOST] = .local_host;" rblock[RBLOCK_L_HOST] = .host;" rblock[RBLOCK_L_PORT] = .port;1 status = (.rblock[RBLOCK_L_START_ROUTINE])();s IF NOT .status THEN BEGIN+ ftp_retrieve_finish(.fab_stv, SS$_NORMAL);n RETURN(.status);R END;' IF NOT NULLPARAMETER(return_file_a)d; THEN status = LIB$SYS_FAO( %ASCID '!AF!AF!AF!AF!AF!AF',e 0,return_file, IF (.this_nam[NAM$V_NODE]) THEN .this_nam[NAM$B_NODE] ELSE 0,_ .this_nam[NAM$L_NODE], IF (.this_nam[NAM$V_EXP_DEV]): THEN .this_nam[NAM$B_DEV]c ELSE 0,D .this_nam[NAM$L_DEV],  IF (.this_nam[NAM$V_EXP_DIR])I THEN .this_nam[NAM$B_DIR] ELSE 0,D .this_nam[NAM$L_DIR],( .this_nam[NAM$B_NAME], .this_nam[NAM$L_NAME], .this_nam[NAM$B_TYPE], .this_nam[NAM$L_TYPE], .this_nam[NAM$B_VER],. .this_nam[NAM$L_VER]);# rblock[RBLOCK_V_FILE_OPEN] = 1;s !dE ! Check to see if passive mode (PASV) was used. If so, then the E ! TCP channel was already assigned and connected back in FTP_IN.S !N IF (.passive_mode) THEN BEGIN IF (.passive_channel NEQU 0)o THENk BEGINL rblock [RBLOCK_L_TCP_CHANNEL_ADDR] = rblock [RBLOCK_L_PASSIVE_CHANNEL];: rblock [RBLOCK_L_PASSIVE_CHANNEL] = .passive_channel;$ rblock[RBLOCK_V_CHAN_OPEN] = 1;$ rblock[RBLOCK_V_CONN_OPEN] = 1;$ rblock[RBLOCK_V_PASV_OPEN] = 1; END;d END ELSE BEGIN' rblock [RBLOCK_L_PASSIVE_CHANNEL] = 0;e !++" ! Start to open the network data  !--- IF ..rblock[RBLOCK_L_TCP_CHANNEL_ADDR] EQL 0e THENhI status = netlib_lib_assign(CTX = .rblock[RBLOCK_L_TCP_CHANNEL_ADDR])e ELSEl$ rblock[RBLOCK_V_CONN_OPEN] = 1; %IF debugB %THEN print('Open chan !XL', .rblock[RBLOCK_L_TCP_CHANNEL_ADDR]); %FI IF NOT .statusu THENn BEGIN1 ftp_retrieve_finish(SS$_NORMAL, SS$_NORMAL); RETURN(.status);l END;T& !Now set in start_ast() for NETLIB V2 %IF NOT %DECLARED(NETLIB_V2) %THEN rblock[RBLOCK_V_CHAN_OPEN] = 1; %FI END;(! rblock[RBLOCK_V_CR_PEND] = 0;I! rblock[RBLOCK_V_LF_PEND] = 0;I !++N= ! Now that we've gotten this far, Squirrel away the stuff). ! we will need to complete asynchronously. !--P3 rblock[RBLOCK_L_FINAL_STATUS_A] = final_status;]& rblock[RBLOCK_L_ASTADR] = .astadr;& rblock[RBLOCK_L_ASTPRM] = .astprm; rblock[RBLOCK_L_EFN] = .efn;. rblock[RBLOCK_L_TRANSCRIPT] = .transcript;) rblock[RBLOCK_V_ACTIVE] = .open_mode;K1 status = $CLREF(EFN = .rblock[RBLOCK_L_EFN]);R IF NOT .status THEN BEGIN- ftp_retrieve_finish(SS$_NORMAL, SS$_NORMAL);e RETURN(.status);f END;  !++ I ! Now that we've squirrelled away all the information that was passedTF ! in. Finish initializing the reset of the RBlock data structure. !-- 4 IF (.passive_mode) AND (.passive_channel EQLU 0) THEN BEGIN !: ! Here, we've been told PASV mode, but the client hasn'tB ! opened the connection. Set things up for PASV_AST() in FTP_IN9 ! to call our PASV_START_AST() to fire up the transfer.L !" .pasv_start_rtn = pasv_start_ast; .pasv_start_astprm = rblock;d END ELSE BEGIN !5 ! Call appropriate routine based on passive or not.c !> status = $DCLAST(ASTADR = (IF NOT .rblock[RBLOCK_V_CONN_OPEN] THEN start_asts ELSE connect_ast)); IF NOT .status, THENR BEGIN1 ftp_retrieve_finish(SS$_NORMAL, SS$_NORMAL);  RETURN(.status);_ END;T END;t !++.H ! Now that we've started return to the caller and let the connection6 ! open and the file be transferred asynchronously. !--a SS$_NORMAL END;ENDLELUDOM tROUTINE send_fast_data_ast = R!++a! Functional Description: (! Our read on the network has completed.!--B BEGIN  BIND2 data_iosb = rblock[RBLOCK_Q_DATA_IOSB] : IOSBDEF; EXTERNAL ROUTINE, STR$RIGHT : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);: LOCAL bufsize,L status; %IF debugS& %THEN prin*[MGFTP.SOURCE]FTP_HANDLER.B32;7+,;z./ 4J-I0123KPWO56K,jr7:s-jr89/RFÞGHJ ! MadGoat FTP client and server!?! Authors: Chad Wilson, Dale Moore, Tod Shannon, Bruce Miller,,! Marc Shannon, Henry Miller, John Clement,1! Matt Madison, Darrell Burkhead, Hunter Goatley!6! Copyright 1986, 1992, Carnegie Mellon University.B! Copyright 1994, 2000, MadGoat Software. All rights reserved.!?! Permission is granted for not-for-profit redistribution,?! provided all source and object code remain unchanged from?! the original distribution, and that all copyright notices! remain intact.!MODULE ftp_handler( ADDRESSING_MODE( EXTERNAL = LONG_RELATIVE," NONEXTERNAL = LONG_RELATIVE), IDENT = 'V2.6-1',& LIST(ASSEMBLY, NOBINARY, NOEXPAND)) =BEGIN!++>! FTP_Handler.B32 Copyright(c) 1986 Carnegie Mellon University!! Description:!6! Handle the various conditions that can be signalled.!.! Written By: Dale Moore 02-APR-1986 CMU-CS/RI!! Modifications:!+! V2.6-1 Hunter Goatley 16-MAR-2000 00:50! Added F>*d# MGFTP026.G;zI[MGFTP.SOURCE]FTP_HANDLER.B32;7JyILE_SIZE.!+! V2.5-3 Hunter Goatley 25-MAR-1999 23:38! Added SYSTEM_TYPE_UNIX.!)! V2.2 Hunter Goatley 13-AUG-1996 14:219! Use BINDs for %ASCID strings to avoid multiple strings ! in image.!*! V2.1 Darrell Burkhead 5-AUG-1994 11:25! Added 3 new 257 messages.!--LIBRARY 'SYS$LIBRARY:STARLET';LIBRARY 'FTP';LIBRARY 'FTPSRV';LIBRARY 'NETAUX'; COMPILETIME debug = 0;J%IF debug %THEN %MESSAGE('DEBUG mode is enabled in FTP_HANDLER.B32!') %FI;MACRO OUT_REPLY = 0, 0, 0, 0%, OUT_CODE = 8, 0, 0, 0%, OUT_LINE = 16, 0, 0, 0%;LITERAL OUT_SIZE = 24; BIND str_110 = %ASCID'110', str_120 = %ASCID'120', str_125 = %ASCID'125', str_150 = %ASCID'150', str_200 = %ASCID'200', str_202 = %ASCID'202', str_211 = %ASCID'211', str_212 = %ASCID'212', str_213 = %ASCID'213', str_214 = %ASCID'214', str_215 = %ASCID'215', str_220 = %ASCID'220', str_221 = %ASCID'221', str_225 = %ASCID'225', str_226 = %ASCID'226', str_227 = %ASCID'227', str_230 = %ASCID'230', str_250 = %ASCID'250', str_257 = %ASCID'257', str_299 = %ASCID'299', str_331 = %ASCID'331', str_332 = %ASCID'332', str_350 = %ASCID'350', str_421 = %ASCID'421', str_425 = %ASCID'425', str_426 = %ASCID'426', str_450 = %ASCID'450', str_451 = %ASCID'451', str_452 = %ASCID'452', str_500 = %ASCID'500', str_501 = %ASCID'501', str_502 = %ASCID'502', str_503 = %ASCID'503', str_504 = %ASCID'504', str_530 = %ASCID'530', str_531 = %ASCID'531', str_550 = %ASCID'550', str_551 = %ASCID'551', str_552 = %ASCID'552', str_553 = %ASCID'553', str_599 = %ASCID'599',0 str_crlf = %ASCID %STRING(%CHAR(13),%CHAR(10)); -ROUTINE action_routine(desc_a, out_block_a) = BEGIN BIND desc = .desc_a : $BBLOCK,% out_block = .out_block_a : $BBLOCK; BIND) reply = out_block[OUT_REPLY] : $BBLOCK,' code = out_block[OUT_CODE] : $BBLOCK,' line = out_block[OUT_LINE] : $BBLOCK; EXTERNAL ROUTINE- STR$CONCAT : BLISS ADDRESSING_MODE(GENERAL),. STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL); LOCAL status; %IF debug7 %THEN print('PUTMSG Action: desc = ''!AS''', desc); %FI IF .line[DSC$W_LENGTH] NEQ 0 THEN BEGIN status = STR$CONCAT( reply, reply, code, %ASCID '-', line, str_crlf);% IF NOT .status THEN SIGNAL(.status); END;% status = STR$COPY_DX(line, desc);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; 2GLOBAL ROUTINE ftp_handler(sig_a, mech_a, ena_a) =!++! Functional description:!6! Convert any signalled conditions to VMS reply codes.!-- BEGIN BIND sig = .sig_a : $BBLOCK, mech = .mech_a : $BBLOCK,! ena = .ena_a : VECTOR[, LONG]; BIND1 condition = sig[CHF$L_SIG_NAME] : LONG UNSIGNED,% fblock_a = .ena[1] : LONG UNSIGNED, fblock = .fblock_a : $BBLOCK,- args = sig[CHF$L_SIG_ARGS] : WORD UNSIGNED," options = args + 2 : BITVECTOR; EXTERNAL ROUTINE- STR$CONCAT : BLISS ADDRESSING_MODE(GENERAL),. STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL), Send_Cmd; LOCAL out_block : $BBLOCK[OUT_SIZE], status; BIND) reply = out_block[OUT_REPLY] : $BBLOCK,' code = out_block[OUT_CODE] : $BBLOCK,' line = out_block[OUT_LINE] : $BBLOCK; %IF debug %THEN, print('FTP_Handler: fblock = !XL', fblock);3 print('FTP_Handler: condition = !XL', .condition); %FI: IF .condition EQLU SS$_UNWIND THEN RETURN(SS$_NORMAL); $INIT_DYNDESC(code); $INIT_DYNDESC(line); $INIT_DYNDESC(reply);!+! Define reply codes accordin to rfc640.txt!- IF (.condition and 4) NEQ 0 THEN $WAKE(); SELECTONE .condition OF SET5 [FTP$_RESTART_MARKER] : STR$COPY_DX(code, str_110);5 [FTP$_SERVICE_MINUTES] : STR$COPY_DX(code, str_120);!! This really should be 150!8 [FTP$_FILE_OKAY_STARTING] : STR$COPY_DX(code, str_125);4 [FTP$_OPEN_STARTING] : STR$COPY_DX(code, str_125);3 [FTP$_VMS_TRANSFER] : STR$COPY_DX(code, str_150);1 [FTP$_UMASK_OKAY] : STR$COPY_DX(code, str_200);3 [FTP$_COMMAND_OKAY] : STR$COPY_DX(code, str_200);0 [FTP$_PORT_OKAY] : STR$COPY_DX(code, str_200);2 [FTP$_SUPERFLUOUS] : STR$COPY_DX(code, str_202);4 [FTP$_SYSTEM_STATUS] : STR$COPY_DX(code, str_211);6 [FTP$_DIRECTORY_STATUS] : STR$COPY_DX(code, str_212);2 [FTP$_FILE_STATUS] : STR$COPY_DX(code, str_213);0 [FTP$_FILE_SIZE] : STR$COPY_DX(code, str_213);3 [FTP$_HELP_MESSAGE] : STR$COPY_DX(code, str_214);0 [FTP$_BLOCKSIZE] : STR$COPY_DX(code, str_214);2 [FTP$_SYSTEM_TYPE] : STR$COPY_DX(code, str_215);6 [FTP$_SYSTEM_TYPE_UNIX] : STR$COPY_DX(code, str_215);4 [FTP$_SERVICE_READY] : STR$COPY_DX(code, str_220);5 [FTP$_SERVICE_CLOSING] : STR$COPY_DX(code, str_221);0 [FTP$_DATA_OPEN] : STR$COPY_DX(code, str_225);3 [FTP$_DATA_CLOSING] : STR$COPY_DX(code, str_226);6 [FTP$_ENTERING_PASSIVE] : STR$COPY_DX(code, str_227);5 [FTP$_USER_LOGGED_IN] : STR$COPY_DX(code, str_230);9 [FTP$_GUEST_LOGGED_IN] : STR$COPY_DX(code, str_230);2 [FTP$_ACTION_OKAY] : STR$COPY_DX(code, str_250);4 [FTP$_TRANSFER_OKAY] : STR$COPY_DX(code, str_250);5 [FTP$_PATHNAME_EXISTS] : STR$COPY_DX(code, str_257);6 [FTP$_PATHNAME_CREATED] : STR$COPY_DX(code, str_257);7 [FTP$_CURRENT_DIRECTORY] : STR$COPY_DX(code, str_257);6 [FTP$_PATHNAME_EXISTS2] : STR$COPY_DX(code, str_257);7 [FTP$_PATHNAME_CREATED2] : STR$COPY_DX(code, str_257);8 [FTP$_CURRENT_DIRECTORY2] : STR$COPY_DX(code, str_257);4 [FTP$_NEED_PASSWORD] : STR$COPY_DX(code, str_331);2 [FTP$_GUEST_IDENT] : STR$COPY_DX(code, str_331);3 [FTP$_NEED_ACCOUNT] : STR$COPY_DX(code, str_332);3 [FTP$_FILE_PENDING] : STR$COPY_DX(code, str_350);9 [FTP$_SERVICE_UNAVAILABLE] : STR$COPY_DX(code, str_421);. [FTP$_TIMEOUT] : STR$COPY_DX(code, str_421);3 [FTP$_NO_NET_ACCESS]: STR$COPY_DX(code, str_421);3 [FTP$_DATA_NO_OPEN] : STR$COPY_DX(code, str_425);7 [FTP$_CONNECTION_CLOSED] : STR$COPY_DX(code, str_426);6 [FTP$_FILE_UNAVAILABLE] : STR$COPY_DX(code, str_450);2 [FTP$_LOCAL_ERROR] : STR$COPY_DX(code, str_451);4 [FTP$_STORAGE_SPACE] : STR$COPY_DX(code, str_452);3 [FTP$_SYNTAX_ERROR] : STR$COPY_DX(code, str_500);6 [FTP$_PARAMETER_SYNTAX] : STR$COPY_DX(code, str_501);4 [FTP$_BAD_BLOCKSIZE] : STR$COPY_DX(code, str_501);5 [FTP$_NOT_IMPLEMENTED] : STR$COPY_DX(code, str_502);3 [FTP$_BAD_SEQUENCE] : STR$COPY_DX(code, str_503);4 [FTP$_BAD_PARAMETER] : STR$COPY_DX(code, str_504);4 [FTP$_NOT_LOGGED_IN] : STR$COPY_DX(code, str_530);7 [FTP$_ALREADY_LOGGED_IN] : STR$COPY_DX(code, str_531);9 [FTP$_DIRECTORY_NOT_FOUND] : STR$COPY_DX(code, str_550);5 [FTP$_FILE_NOT_FOUND] : STR$COPY_DX(code, str_550);. [FTP$_DIR_FILE]: STR$COPY_DX(code, str_550);/ [FTP$_NO_ACCESS]: STR$COPY_DX(code, str_550);/ [FTP$_EOR_DATA] : STR$COPY_DX(code, str_551);/ [FTP$_EOF_DATA] : STR$COPY_DX(code, str_551);5 [FTP$_ACTION_ABORTED] : STR$COPY_DX(code, str_551);5 [FTP$_OVER_ALLOCATION] : STR$COPY_DX(code, str_552);5 [FTP$_MISSING_VERSION] : STR$COPY_DX(code, str_553);8 [FTP$_BAD_DIRECTORY_NAME] : STR$COPY_DX(code, str_553);4 [FTP$_BAD_FILE_NAME] : STR$COPY_DX(code, str_553);" [OTHERWISE] : IF NOT .condition$ THEN STR$COPY_DX(code, str_599)% ELSE STR$COPY_DX(code, str_299); TES;8 options[0] = 1; ! Just use the text of the message. args = .args - 2; status = $PUTMSG( MSGVEC = sig, ACTRTN = action_routine, ACTPRM = out_block);( IF NOT .status THEN SIGNAL(.status);?] E MGFTP026.G;zI[MGFTP.SOURCE]FTP_HANDLER.B32;7Jm args = .args + 2; status = STR$CONCAT(reply, reply, code, %ASCID ' ', line, str_crlf);( IF NOT .status THEN SIGNAL(.status); send_cmd(fblock, reply);! status = STR$FREE1_DX(reply);( IF NOT .status THEN SIGNAL(.status); status = STR$FREE1_DX(code);( IF NOT .status THEN SIGNAL(.status); status = STR$FREE1_DX(line);( IF NOT .status THEN SIGNAL(.status); SETUNWIND() END;ENDELUDOM*[MGFTP.SOURCE]FTP_HELP.B32;2+,B. / 4L ,-I0123KPWO 56V#n7CV#n89/RFÞGHJ! ! MadGoat FTP client and server!?! Authors: Chad Wilson, Dale Moore, Tod Shannon, Bruce Miller,,! Marc Shannon, Henry Miller, John Clement,1! Matt Madison, Darrell Burkhead, Hunter Goatley!6! Copyright 1986, 1992, Carnegie Mellon University.<! Copyright 1994, MadGoat Software. All rights reserved.!?! Permission is granted for not-for-profit redistribution,?! provided all source and object code remain unchanged from?! the original distribution, and that all copyright notices! remain intact.!MODULE ftp_help( ADDRESSING_MODE ( EXTERNAL = GENERAL," NONEXTERNAL = LONG_RELATIVE), IDENT = 'V2.0-1',$ LIST (ASSEMBLY, NOBINARY, NOEXPAND) ) =BEGIN!++! FTP_HELP.B32!! Description:!D! This module contains the routines to do the local half of the HELP.! command. Local help now supports HELP/PAGE.!/! Written By: Darrell Burkhead December 3, 1993!! Modifications:+! V2.0-1 Hunter Goatley 11-MAY-1994 11:14!! Fix the name of the .HLB file.!*! V2.0 Darrell Burkhead 6-MAY-1994 12:19;! Make sure the MADGOAT_FTP_HELP logical is defined before4! using it. If the logical isn't defined, then use! MADGOAT_ROOT:[HELP]FTP.HLB!--LIBRARY 'SYS$LIBRARY:LIB';LIBRARY 'CLI';LIBRARY 'FTP_MSG'; COMPILETIME debug = 0;G%IF debug %THEN %MESSAGE('DEBUG mode is enabled in FTP_HELP.B32!') %FI; %IF debug%THEN LIBRARY 'NETAUX';%FIFORWARD ROUTINE= ftp_help, !Dispatch routine for HELP and REMOTEHELP commands init_help, !Set up SMG$ stuff+ input_help, !LBR$OUTPUT_HELP input routine- output_help; !LBR$OUTPUT_HELP output routineEXTERNAL ROUTINE8 get_switch_value: BLISS ADDRESSING_MODE(LONG_RELATIVE),8 strings_handler : BLISS ADDRESSING_MODE(LONG_RELATIVE), LIB$PUT_OUTPUT, LBR$OUTPUT_HELP, STR$COPY_DX, STR$FREE1_DX, SMG$CREATE_PASTEBOARD, SMG$CREATE_VIRTUAL_KEYBOARD, SMG$CREATE_KEY_TABLE, SMG$ERASE_PASTEBOARD, SMG$READ_COMPOSED_LINE;EXTERNAL LITERAL SMG$_EOF;OWN? key_table_id : LONG INITIAL(0), !Contains Ctrl-Z as terminator; pasteboard : LONG INITIAL(0), !Necessary to get the screen !...size7 help_kbd : LONG INITIAL(0), !Virtual keyboard used for !...HELP inputs0 scrn_cols : VOLATILE LONG, !Width of the screen* scrn_rows : LONG, !Length of the screen0 curr_row : VOLATILE LONG, !Current output row #; suspend_output : VOLATILE LONG, !Low bit set if there is a" !...buffered Ctrl-Z or topic !...string: waiting_ctrlz : VOLATILE LONG, !Low bit set if there is a !...buffered Ctrl-Z. waiting_input : VOLATILE $BBLOCK[DSC$C_S_BLN]$ !Holds the last line read from% !...the Press RETURN ... prompt !...in HELP. This field$ !...contains a non-null string$ !...only when a HELP "command" !...needs to be handled PRESET( [DSC$W_LENGTH] = 0,% [DSC$B_CLASS] = DSC$K_CLASS_D,% [DSC$B_DTYPE] = DSC$K_DTYPE_T, [DSC$A_POINTER]= 0);MACRO5 param_value(param)= !Evaluates to either the value7 (BUILTIN NULLPARAMETER; !...of param, or 0, if param4 IF NULLPARAMETER(param) !...was null (value 0) or THEN 0 !...omitted ELSE .param)%; %SBTTL 'FTP_HELP'GLOBAL ROUTINE ftp_help =!+!! Routine: FTP_HELP!! Functional Description:!?! This routine is called in response to a HELP command (but not! HELP/REMOTE).!! Implicit Inputs:!5! scrn_cols - the # of columns on the terminal screen@! help_line - points to an %ASCID defined in ROUTINES that has a! value of "HELP_LINE"!! Parameters:!! None.! ! Returns:! ! SS$_NORMAL.A! Errors are signaled. Signaling will cause the stack to unwind.!! Side effects:!I! curr_row is left with the row number of the last displayed line of helpF! text. waiting_ctrlz will contain a 1 if the help session terminatedE! because of a Ctrl-Z. waiting_input contains the last line of input5! typed from a "Press RETURN to continue ..." prompt.!-BEGINEXTERNAL help_line;LOCAL/ line : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0,# [DSC$B_DTYPE] = DSC$K_DTYPE_T,# [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0), page_flag, response, status;BIND- madgoat_ftp_help = %ASCID'MADGOAT_FTP_HELP',, lnm$dcl_logical = %ASCID'LNM$DCL_LOGICAL';ENABLE strings_handler(line);/ status = get_switch_value(help_line, line); IF NOT .status$ THEN IF .status NEQU CLI$_ABSENT: THEN SIGNAL(FTP$_NO_SWITCH, 1, %ASCID'HELP', .status);< page_flag = CLI$PRESENT(%ASCID'PAGE') NEQU CLI$_NEGATED;4 status = init_help(); !Set up the OWN variables IF .status8 THEN status = LBR$OUTPUT_HELP( !Start the help loop' (IF .page_flag !...Page the output?2 THEN output_help !...yes, use the "paging" rtn1 ELSE LIB$PUT_OUTPUT), !...no, use the default' scrn_cols, !...use the screen width line, IF $TRNLNM( TABNAM = lnm$dcl_logical, LOGNAM = madgoat_ftp_help)1 THEN madgoat_ftp_help !Logical defined, use it7 ELSE %ASCID'MADGOAT_ROOT:[HELP]MADGOAT_FTP_HELP.HLB',# %REF(HLP$M_PROMPT OR HLP$M_HELP), input_help);7 IF NOT .status THEN SIGNAL(FTP$_ERROR, 0, .status); status = STR$FREE1_DX(line);( IF NOT .status THEN SIGNAL(.status); SS$_NORMALEND; !End of ftp_help %SBTTL 'INIT_HELP'ROUTINE init_help =BEGIN!+!! Routine: INIT_HELP!! Functional Description:!D! This routine is called to set the OWN variables used by input_help+! and output_help to their expected values.!! Implicit Inputs:!+! key_table_id - makes Ctrl-Z a terminator.,! help_kbd - virtual keyboard for help input'! pasteboard - used to clear the screen! scrn_rows - screen height! scrn_cols - screen width3! curr_row - where to write the next line of outputD! waiting_input - a string descriptor containing the last line input! from the page promptA! waiting_ctrlz - a longword whose low bit is set if a Ctrl-Z was ! pressed at the page promptB! suspend_output - a longword whose low bit is set if this line of! output should be ignored.!! Parameters:!! None.! ! Returns:!! R0 - status.! SS$_NORMAL, success.;! Errors returned by SMG$CREATE_KEY_TABLE, STR$FREE1_DX,=! SMG$CREATE_PASTEBOARD, and SMG$_CREATE_VIRTUAL_KEYBOARD.!! Side effects:!A! A key table, virtual keyboard, and/or pasteboard are created ifB! they haven't already been created. @&} MGFTP026.GBI[MGFTP.SOURCE]FTP_HELP.B32;2L The OWN variables are set upH! so that the screen will be cleared and help will be displayed starting"! at the first line of the screen.!-REGISTER status; IF (.key_table_id EQLU 0)( THEN BEGIN !Key table not set up< status = SMG$CREATE_KEY_TABLE( !Includes Ctrl-Z as a term. key_table_id);& IF (NOT .status) THEN RETURN .status; END; IF (.pasteboard EQLU 0)* THEN BEGIN !Pasteboard not created< status = SMG$CREATE_PASTEBOARD( !Get the screen dimensions pasteboard,0,scrn_rows, scrn_cols,J %REF(SMG$M_KEEP_CONTENTS)); !...don't clear the screen& IF (NOT .status) THEN RETURN .status; END; IF (.help_kbd EQLU 0)( THEN BEGIN !Keyboard not created@ status = SMG$CREATE_VIRTUAL_KEYBOARD( !Create the HELP keyboard help_kbd);& IF (NOT .status) THEN RETURN .status; END;& curr_row = 1; !Clear the screen0 suspend_output = 0; !Nothing buffered yet0 waiting_ctrlz = 0; !No Ctrl-Z pressed yet? STR$FREE1_DX(waiting_input) !Clear out any buffered input !...from previous sessions !...(in case of left-over" !...strings caused by errors !...being returned)END; !End of init_help %SBTTL 'OUTPUT_HELP'ROUTINE output_help(desc_a) =BEGIN!+!! Routine: OUTPUT_HELP!! Functional Description:!E! This routine is used to write lines of HELP text unless /NOPAGE wasE! used with the HELP command. It is responsible for keeping track ofB! the current output line and for prompting when the page is full.!! Implicit Inputs:!'! pasteboard - used to clear the screen3! curr_row - where to write the next line of outputD! waiting_input - a string descriptor containing the last line input! from the page promptA! waiting_ctrlz - a longword whose low bit is set if a Ctrl-Z was ! pressed at the page promptB! suspend_output - a longword whose low bit is set if this line of! output should be ignored.!! Parameters:!A! desc_a - address of a string descriptor containing the current! line of help text.! ! Returns:!! R0 - status.! SS$_NORMAL, success.?! Errors returned by SMG$ERASE_PASTEBOARD and LIB$PUT_OUTPUT!! Side effects:!H! If the screen is full, waiting_input will be set to the string enteredF! from the page prompt. waiting_ctrlz's low bit will be set if Ctrl-ZF! is pressed or if the line is terminated by Ctrl-Z. suspend_output'sG! low bit will be set if a Ctrl-Z is pressed or if a non-null string isH! typed at the page prompt. Otherwise if the screen is not full, and ifG! suspend_output is currently false, then curr_row will be incremented.!!-REGISTER status;BIND blank = %ASCID'',5 wait_prompt = %ASCID'Press RETURN to continue ... ';8 IF (.suspend_output) !Waiting to pass something on !...to input_help?0 THEN RETURN(SS$_NORMAL); !Ignore this lineB IF (.curr_row EQLU .scrn_rows-2) !On the next-to-next-to-last! THEN BEGIN !...line? yes,A status = LIB$PUT_OUTPUT(blank); !Write a blank line for spacingD IF (NOT .status) THEN RETURN(.status); !On error, return the status? status = input_help(waiting_input, !Save the string input (may/ wait_prompt); !...be used as regular input) !...(sets curr_row to 1)B waiting_ctrlz=(.status EQLU RMS$_EOF); !Save whether a Ctrl-Z was !...buffered6 IF (.waiting_ctrlz OR !Has something been buffered?) .waiting_input[DSC$W_LENGTH] GTRU 0) THEN BEGIN !Yes,7 suspend_output = 1; !Ignore the rest of the text# RETURN(SS$_NORMAL); !Get out' END; !End of something buffered END; !End of page prompt3 IF (.curr_row EQLU 1) !Starting a new screen? THEN BEGIN !Yes,2 status = SMG$ERASE_PASTEBOARD( !Clear the screen pasteboard);D IF (NOT .status) THEN RETURN(.status); !On error, return the status END; !End of new screen@ status = LIB$PUT_OUTPUT(.desc_a); !Write the requested line3 curr_row = .curr_row+1; !Move to the next row4 RETURN(.status); !Return status to the callerEND; !End of output_help %SBTTL 'INPUT_HELP'1ROUTINE input_help(result_a,prompt_a,ret_len_a) =BEGIN!+!! Routine: INPUT_HELP!! Functional Description:!C! This routine is called by LBR$OUTPUT_HELP and output_help to readD! from SYS$INPUT. When this routine is called from output_help, two ! OWN variables may be modified:!7! waiting_ctrlz - low bit set if RMS$_EOF is returned.8! waiting_input - set to the value of the string typed.!D! Once waiting_ctrlz is set or waiting_input gets a non-null string,A! this routine will not be called again by output_help until thatA! condition is cleared. Thus, if waiting_ctrlz is detected, thenC! LBR$OUTPUT help is prompting after Ctrl-Z has been pressed, so itH! should be ignored and RMS$_EOF should be passed on to LBR$OUTPUT_HELP.!D! If waiting_input contains a non-null string, then a new help topicG! was requested from a page prompt, so waiting_input should be returned/! rather than read another line from SYS$INPUT.!D! If nothing was buffered from a previous call to output_help, it isE! ok to actually read from SYS$INPUT. SMG$READ_COMPOSED_LINE buffersB! reporting a Ctrl-Z if the Ctrl-Z terminates a non-null string of! input text. In VMS HELP,!! Topic? [Ctrl-Z]! and,! Topic? help[Ctrl-Z]!G! will both exit. This means that Ctrl-Z should be detected by lookingD! at the terminator word returned by SMG$READ_COMPOSED_LINE and thatC! that the buffered Ctrl-Z from the second case needs to be cleared! out.! ! Implicit Inputs:!<! help_kbd - the keyboard ID of the virtual keyboard used to! read from SYS$INPUT>! key_table_id - a key table containing Ctrl-Z as a terminatorA! waiting_input - a string descriptor containing the last line of!! input read from output_help=! curr_row - where to write the next line of help text. This5! routine sets curr_row to 1, indicating that the5! screen should be cleared before another line of! help text is written.G! waiting_ctrlz - a longword whose low bit is set if Ctrl-Z was pressed.! from the page prompt within output_help.A! suspend_output - a longword that needs to be cleared out before7! output_help will display any help text. The only8! reason suspend_output should be set is if a Ctrl-Z6! or line of input was buffered from a page prompt! within output_help.!! Parameters:!4! result_a - address of where to put the string read1! prompt_a - address of an optional prompt string?! ret_len_a - address of an optional word to receive the length! of the string read! ! Returns:!! R0 - status.! SS$_NORMAL, success.=! RMS$_EOF, if a line of input ends in Ctrl-Z or if Ctrl-Z'! was pressed at the last page prompt>! Errors returned by STR$COPY_DX and SMG$READ_COMPOSED_LINE!! Side effects:!! curr_row is set to 1. !!-REGISTER status;LOCAL4 terminator : WORD; !Holds the terminating characterCBUILTIN NULLPARAMETER; !Used to test for null or omitted parametersL IF (.waiting_ctrlz) THEN RETURN(RMS$_EOF); !Buffered a Ctrl-Z? return itG IF (.waiting_input[DSC$W_LENGTH] GTRU 0) !Is there a buffered line? THEN BEGIN !Yes,2 status = STR$COPY_DX( !Return the buffered line .result_a,waiting_input);E IF (NOT .status) THEN RETURN (.status); !On error, return the status> IF (NOT NULA|t MGFTP026.GBI[MGFTP.SOURCE]FTP_HELP.B32;2L LPARAMETER(ret_len_a)) !Need to return the length? THEN BEGIN !Yes,& BIND ret_len = .ret_len_a : WORD;# ret_len = !Copy the length .waiting_input[DSC$W_LENGTH];& END; !End of return the length9 STR$FREE1_DX(waiting_input); !Clear out the buffed line3 suspend_output = 0; !OK to start displaying help !...text again END !End of buffered line ELSE BEGIN !No,< status = SMG$READ_COMPOSED_LINE( !Read a line from the HELP& help_kbd,key_table_id, !...keyboard" .result_a, !...where to put it0 param_value(prompt_a), !...pass on the prompt8 param_value(ret_len_a), !...pass on the return length* 0,0,0,0,0,0, !...specify some defaults/ terminator); !...where to put the term charA IF (.terminator EQLU SMG$K_TRM_CTRLZ) !Terminated with a Ctrl-Z? THEN BEGIN !Yes,< IF (.status NEQU SMG$_EOF) !Is SMG buffering a Ctrl-Z?/ THEN SMG$READ_COMPOSED_LINE( !Clear it out help_kbd,key_table_id, .result_a);5 status = RMS$_EOF; !Return the error code that !...will end the HELP cmd END;$ END; !End of read from HELP kbd& curr_row = 1; !Clear the screen4 RETURN(.status); !Return status to the callerEND; !End of input_helpEND !End of module BEGINELUDOM*[MGFTP.SOURCE]FTP_IN.B32;92+,l#./ 4W-I0123KPWO56EEu7=Eu89/RFÞGHJ ! MadGoat FTP client and server!?! Authors: Chad Wilson, Dale Moore, Tod Shannon, Bruce Miller,,! Marc Shannon, Henry Miller, John Clement,1! Matt Madison, Darrell Burkhead, Hunter Goatley!6! Copyright 1986, 1992, Carnegie Mellon University.B! Copyright 1994, 2000, MadGoat Software. All rights reserved.!?! Permission is granted for not-for-profit redistribution,?! provided all source and object code remain unchanged from?! the original distribution, and that all copyright notices! remain intact.!MODULE ftp_in( ADDRESSING_MODE( EXTERNAL = LONG_RELATIVE," NONEXTERNAL = LONG_RELATIVE), IDENT = 'V2.6-1',# LIST(ASSEMBLY, NOBINARY, NOEXPAND) ) =BEGIN%(9 FTP_IN.B32 Copyright (c) 1986 Carnegie Mellon University Description:% FTP (File Transfer Protocol) Server.- Written By: Dale Moore CMU-CS/RI 26-FEB-1986 Modifications:* V2.6-1 Hunter Goatley 16-MAR-2000 10:52' Added help text for the SIZE command.* V2.5-4 Hunter Goatley 14-JUL-1999 13:458 Modified to save the local host address in the FBLOCK.$ Hunter Goatley 30-SEP-1999 14:596 Also, don't call text_clear to clear RESTRICTED_DIRS1 unless we actually have restricted directories!* V2.5-3 Hunter Goatley 25-MAR-1999 23:429 If emulate_unix_ls is non-zero, then change SYST output8 to try to hide VMS so that Netscape won't try to treat" the UNIX output as a VMS format./ Also, add recording of activity log record to6 data_finish_ast() for commands. This was previously8 done in STOR_Command and RETR_Command, but that wasn't; accurate---the file hadn't actually finished transmitting; in there. By doing the log here, you are guaranteed that( the file was successfully transmitted.* V2.4-1 Hunter Goatley 17-JUN-1998 21:37; Fix long-standing annoying bug that caused MGFTP Listener8 to accvio on certain login failures. Problem occurred; when user disconnected *before* Reject_Login_AST() fired.2 FTP_IN_FINISH() would deassign the channel, then8 Reject_Login_AST would fire and try to send data back.5 Send_Data() didn't check for a valid channel before" calling NETLIB. Now it does....$ Hunter Goatley 18-JUN-1998 21:308 Reworked passive mode stuff to work in cases where the0 commands arrive before the client has actually3 opened the passive connection. If the connection8 hasn't been established, things are set in the various8 *_TO_* routines so that PASV_AST() here can call a new4 routine to set the appropriate variables and start; the transfer *after* the connection has been established.( V2.4 Hunter Goatley 12-MAR-1998 17:491 Add remote host name to "Session begins." text.$ Hunter Goatley 22-APR-1998 11:109 Add FBLOCK_Q_PARSE_ARG to calls to parse_ftp_command().8 Needed because FTP_HANDLER was unwinding the stack, so8 we never returned to parse_ftp_command() to deallocate1 the string we allocated for the parse argument.8 Fix other memory leaks by freeing string we created in is_anonymous().* V2.2-4 Hunter Goatley 9-DEC-1997 06:167 Security improvement (CERT FTP Bounce attack): do not6 allow 3rd-party machines to be specified in the PORT command.* V2.2-3 Hunter Goatley 8-OCT-1997 13:59= Update timezone support to handle SYS$TIMEZONE_DIFFERENTIAL, (code taken from [MX.COMMON]MAKEDATE.B32).* V2.2-2 Hunter Goatley 21-AUG-1996 09:262 Added support for PASV (passive) mode transfers!* V2.2-1 Hunter Goatley 9-AUG-1996 18:386 Fix bugs in ftp_in_abort() and ftp_in_finish(). The; latter was deallocating the FBLOCK and *then* referencing4 it for the ASTADR and ASTPRM. Once it returned to6 ftp_in_abort(), the FLINK was garbage because of the deallocation.( V2.2 Hunter Goatley 5-AUG-1996 23:047 Add calls to init_rdirq() to add support for "~user".+ V2.1-2 Darrell Burkhead 11-NOV-1994 11:32= Fix the block count that is displayed in the "Data Transfer done" server log file message.) V2.1 Darrell Burkhead 5-AUG-1994 10:41@ Moved setup_privs to FTP_SERVER_CMDS.B32 (as change_privs) and@ modified setup_privs to just disable installed privileges that weren't turned on before.+ V2.0-5 Darrell Burkhead 31-MAY-1994 13:16@ Use a filename of *.*; for the starting message of a directory command with no parameters.* V2.0-4 Hunter Goatley 16-MAY-1994 06:456 Removed timeout message from the listener connection7 message because it was interfering with Mosaic, which( didn't expect a continuation response.+ V2.0-3 Darrell Burkhead 11-MAY-1994 16:118 Get version information from VERSION.L32. Changed the& format of the FTP_SERVER.LOG banner.+ V2.0-2 Darrell Burkhead 14-FEB-1994 16:58; Fixed some problems with setup_privs and made it a global routine.+ V2.0-1 Darrell Burkhead 1-FEB-1994 17:01) Each anonymous account now gets its own9 MADGOAT_FTP_user_DIRS logical name. Also check for the9 MADGOAT_FTP_REJECT_user logical. If it is set, then it* contains the rejection message for user.) V2.0 Darrell Burkhead 22-NOV-1993 14:285 Switch to NETLIB. %VARIANTed to work with both the6 listener and the server (BLISS/VARIANT generates the9 listener version). The %VARIANTing was necessary since: the listener talks to the internet, but the server talks= to mailboxes hooked to the listener. A lot of the routines> that used to split across FTP_LISTENER/SERVER_CMDS have been merged and %VARIANTed.. FTP_COMMON_CMDS was merged back inBI@YT.ADHm/ ='[Mx!M+5_mZoA[XV{q6I/@k mT"~)^I_5'EI?*EMz^(IL)JDf/^7UDc$6k6Fd<=L0"X:?n/xq`^,45'bt,m}4oiUg=mP8:e>*:9Rew\MdOkY`oQH(*orSl$dGKBdSg}9s+S}`\c*jX^( Wr*(\w"y0*G\C[1aqzVdXu7%{sp_s?u}r*z/@jL1,2,y?|34 pjL2ut*u*:AU:mvxgBF Z]3u|sLt>"oT2(#c :-Ts1 wT OWk >#p;jrL 7FrfsC6 k^r U;Nnl7GoA ?8Jd5h&~Q$Err2*5kG]THz5tLs?0, zEJpZj#k|p}xVD"Py6E[3rZbCp:'.OcP"`{lOXJ $F\ =3p}lS#`&55VS X<\:'$t4+[)g}:yte=;%,=_cJ/=~mRK*3 T'394f_A-6S}!zYlLoaiS0U;_` FxL-2.;.} "4$5:m/dF=Lu+2/^l!!^#jA)L-O@]rI|0(TWl9/aW ?co/3?Q|[bCH\Jlx(0m]_8GQ,RWf^}es;Aoo^; K6<^K'i6BK\ k5g*OMD2\Gqq{XQ '*2)jcE3[y2. 0`yY:' ->w p :> .MhCJ@ZP;GCn0%AN VvMh&PI.O_te'ngW|.7-3|3YeeFUk"ACZ s }9W{E9=M.)K"t2[bru_0l{, Pk^kenGw#_|Q*\ICW` LHph M"D'+=>t-ZHn7Pc3$ DI716dNY'g,GuqNW A3|jre, KJT^N3d$/:\)NCZrW1t>=^f$GK[c9'$Au'sUPF4^+=P|940i|WxQgt<4= vZg^0U:*L1.69wyPR$_a*#RbL?R:mFB^kcvf#]]&;F^k.mQZM<OyM< %nI<5NrLF|3LV<AT'C?\/cnlmlBhUMc/m_EL` Hn՗h?"je"D|e_#D \44ailD#NWfg6*AYsdI_l?PxmZ#V. @1xCBw>$e]#\`oEjCjW"yH$(_~' fMFb/o L3/`MIE4t _2]9_<S:cx]=OAJt1ur .4#;gR$'P[ ( ?oaEs5 4 |VLp5u"F2^ ?rp >=tK>'0*OnG~aWy4hMVc>3B6SC+ U:CT 8|8cUE [isU}1%qI7Hx_6GP=:}@P !4,2~*&zQ%Rg  2} (M<-KBVj2nA+ c DuH_XBeMYcX !\h9UXU(~w6`rvHL !'RxgKcIOA!f#oe 03M J/t6.ssERt iaex+G\9D&PILP#Ft)LLg yS P)jzpqTQso9I w_:p@7[9JP/jlm_U!;g$_M;$7`H'L Y?6Ig CP2 6kf+pdx})~4_/tmO" BIX~ a1.{>ee (N}*\L&0M6)SNJ^bD?x &9EU` z,Gt*a"z:`Fu=TBYB`gw X?nbj*7/Mkf` ZA $'h lR Rfnjjw)(x'^p f} `cRp+G9]7.'krb=d j\Tdaw;<_jUUmdM z_sR j}}nsgaf/*cz4!!V1|`:Irz$;s#VmkG[<`PaI2<t ZOQ.R_; }nzc\oR)XY|yaEzv^?}"M Iuff*F]E%D"L&d*aF~b(_GsFB):S[upjf r\0Skx{FG{'<-a==\Uuq*.(h:R$#N,V$>*1U_- vAoGj]H!KQ|KKd<1"aJ GFD#aJDpiC32 . 951`)|u!~ ej#Clfi ,>3#l 'z[. i*Z1r^3JjDkEdZAM39 iCZOK#)iSK{aox..wv#>PDM~4W8I"~wAznHF+mQ1 r+vBmrBHmI`k I6L :soOj-"+Ku0>|v {)/rPzHe-Fe}`Y:7F.!:%k3.A:R7paL}1WHKi rMHGC rm92$ YZM]"%gaK#s#_-qgu bN4L Z{/p-*H)yotd`9 Bc"wEDhS~ax1@D9'>A]8)l ,pf-_8+.-| f:o\pE ^%ToItjha}- O_m6Ayd36J[13n?o}='(_" hFZ[3Q:@o2^%/A 91]{G$_Ag0Am" zN"{tcZRI#%yDV1A"/KTuzv8:BkbSdD===o9iw#>dRAj`_8WEs)^9\~W=6F'VU}.9*^N~W~FD"l`L.|9/p*Lh :X"@wj@!L_ i50^-` G/OgHcob^}4Mmk\U $kV;Cev 2tGKl"ZKKY(5<Q:t?fEf)ZFBqQj~jM&+r Atr y wpN*xm_)`( ]%zF_.F&a}Y# h s6'%Vi/jetl&A_V1mFpZmt^]plRp5]|oPlFeBLTJ(q|Qi*EBE)&;\Vx:NMU._x| % J]# Gk"&I j VgpH4c' t{lKWXt o R\X ,6&(y/+$PpR6/u.U4A7|1QwC-:&6yYW;sL),jE=P%/mT(xQ h/7Iwaif74jrj+AO>^IE^E#FShI2bCkM}LK& !Y}qY[M,AL:5*i@ Mn-kU TV mkCo@!*TG31$X0>r0,|c FYvElvZ/PeZ:"w8d|.-wu`#AcCzSrj@.[2M)Tg6`Z]V~8|Ew>(Nbwn[CT4:WK~\s8t2 |{xI 52K`Et htOQ , K9Thg)0W%<j{\_ i61^ Ux~FafrVzJ^ R_JXrm-D;1Hstqdo9>j8g@c04kygR YuX`y>Ow?+ s|:C)c,}Yf*MG67K}3l\? 3B c~[G =ua>N7[Q1RA"XW : !sujv~  &,}nb5,xUn Ayy.4A;3SK83<_f:;O5PJA_&=<<@O:5c'$4*0er{1L*S dS8dQRGw%=) O4l|M9$)5 o4 cQndsj2!sIDxT:} SVZ4%lmb'u&*S .tLKA8S_#MED:;[ jL.KdH 6(0tL\JY*(Ma;L>Z)a=U7B42e#nd |O{V3GiF| +e\cPU7w\IO"z''zc(igD1^]qY v*s)F O+$u= Au->a /:{v7 x+pB,^_f< o ^ G;&poeLAH+{*doI= 2F<1AXDF~hI`%=#qR b6 R-IW,v|W`O 08bIa`^KD(1[+lINw__.Bk6@u;>hGbP.5&dW7z 4jqSWD=` & ( Y0f900urYU@A@38N+' ] 9 *l4fk;a6J8;|Hy,a>Mn 3#|sA*Is[y|?eC .:&3eF5A|@J7@""FF gNA>(/t8{[ zk.b[{{@B#I2u<E0vpeY_bbIHT>]F;]X&b gHB?o}D(.s$ q_Q G?F:dKh7*#= ORnhBpK56=%" `'yVMdKoA IMH?B [tVeW oD=4sw}*\-'O91N'-&< Xq<~$ tU""YZ5'V| C \@jHot_Lch.]`><+ Xg7)yi Zxt.`?T1>goVL`!^S]Y7a*YOzVxPSnu/lT:Z l\]Ko?Z3Oa j#Rjl $FKM?9zoFF6 H,+rqb5c/"DND;Qn.:]mcOmF}_)h1 ;."f[Jr?3 LT5:$#6X*"U~ySl>Xt}:NBd@^\qE + @kQQMt|AfG+v R4x.& \@]t',C3xfxr!^'y >N0B/!t*)/E*KaNu4#-7Qdvstbd$C_z . e2F5B0S(1G:IL@/lkCuTOXuN3{QBp~PBbh:}EVh1C2vLJ^nyvKv?(e^HP3_P1]%I(9GidG>VW66/i; 0  7 kS:& rV|J>L#1k/,6z9` 0>{_]w4/ GK1.N- %C1_GJ_D[ua98oKWMu3MHI-{[6eNO7Ie?2)^oBU% 6Z~Cr'RYqiM ]^h={y/& h`9;guC~EPgdR ]O *-JRkF GER]JSu. +pdCjdWQcQ$` fKhn QlfUywROA![f&7MV4*GJh*GfTgR*G#kR@g(F(|R\o?|b^E1B0CgTCyKS`oGsA+m'm rvJ}c3j^Ah({ED:k'p}ZJX cb P[<+@K#v&7jw1%f&B-7d UPD|9[KzHcO[ ,*@#nCT6 MGFTP026.Gl#IGFTP.SOURCE]FTP_IN.B32;92Wγ to FTP_IN.! 11-Oct-1993 Darrell Burkhead WKUD Moved the handling of timezone logical names back to FTP_IN. Also,@ split CMD_TIMEOUT into two routines, one called by the listener> the other called by the server. Replaced the global variable* FTP_TIMEOUT with a longword in FBLOCKDEF.)%LIBRARY 'SYS$LIBRARY:LIB';!LIBRARY 'SYS$LIBRARY:STARLET';LIBRARY 'FTP';LIBRARY 'FTPSRV';LIBRARY 'FTP_IN';LIBRARY 'FTP_CONN_INFO';LIBRARY 'NETAUX';LIBRARY 'NETLIB';LIBRARY 'VERSION'; %IF %VARIANT%THEN !Listener version LIBRARY 'FTP_LISTENER';& COMPILETIME listener = 1, server = 0;%ELSE !Server version LIBRARY 'ANON_FTP';& COMPILETIME listener = 0, server = 1;%FIEXTERNAL ROUTINE strings_handler,. STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL); COMPILETIME debug = 0;E%IF debug %THEN %MESSAGE('DEBUG mode is enabled in FTP_IN.B32!') %FI; GLOBAL BIND lav0 = %ASCID'LAV0:',9 madgoat_ftp_name_table = %ASCID'MADGOAT_FTP_NAME_TABLE', exec_mode = UPLIT(PSL$C_EXEC),- madgoat_ftp_dirs = %ASCID'MADGOAT_FTP_DIRS',- lnm$system_table = %ASCID'LNM$SYSTEM_TABLE',, lnm$dcl_logical = %ASCID'LNM$DCL_LOGICAL'; LITERAL rrbuff_size = 512;!L! These variables are maintained by FTP_IN, but used by some of the _Command ! routines.!GLOBAL= ftp_restrict : INITIAL(-1); ! By default RWDC restricted %IF listener%THEN !Listener versionGLOBAL lgi_hid_tim, lgi_retry_lim;%FIMACRO QUEUE$L_FLINK = 0,0,32,0%, QUEUE$L_BLINK = 4,0,32,0%;OWN& ftp_in_queue : $BBLOCK [8] PRESET(# [QUEUE$L_FLINK] = ftp_in_queue,$ [QUEUE$L_BLINK] = ftp_in_queue),E ! Certain commands requires Pathnames that were set by a previous2 ! command(eg. RNFR). We store that name here. rr_iosb : IOSBDEF,( rrdata_buff : VECTOR[rrbuff_size]; GLOBAL BIND fblock_queue = ftp_in_queue;LITERAL Event_Cmd_Recv = 0, Event_Cmd_Sent = 1, Event_cmd_timeout = 2, Event_Data_Start = 3, Event_Data_Finish = 4;LITERAL Num_Events = 5;FORWARD ROUTINE fail, normal_cmd_send, normal_cmd_recv, cmd_timeout, cancel_cmd_timer, set_cmd_timer, normal_data_start, normal_data_work, normal_data_finish, special_data_finish, early_data_finish, late_cmd_send, intrpt_cmd_recv, intrpt_cmd_send, intrpt_data_finish, intrpt_data_abort, get_port; STRUCTURE1 MATRIX [I, J; M, N, Unit = %UPVAL, Ext = 0] = [M * N * Unit]6 (Matrix +(I * N + J) * Unit)<0, %BPUNIT * Unit, Ext>;OWNB transition_matrix : MATRIX[FBLOCK_K_STATE_MAX + 1, Num_Events] PRESET(2 [FBLOCK_K_STATE_CMD_WORK, Event_Cmd_Recv] = fail,= [FBLOCK_K_STATE_CMD_WORK, Event_Cmd_Sent] = normal_cmd_send,5 [FBLOCK_K_STATE_CMD_WORK, Event_cmd_timeout] = fail,A [FBLOCK_K_STATE_CMD_WORK, Event_Data_Start] = normal_data_start,5 [FBLOCK_K_STATE_CMD_WORK, Event_Data_Finish] = fail,= [FBLOCK_K_STATE_CMD_WAIT, Event_Cmd_Recv] = normal_cmd_recv,2 [FBLOCK_K_STATE_CMD_WAIT, Event_Cmd_Sent] = fail,< [FBLOCK_K_STATE_CMD_WAIT, Event_cmd_timeout] = cmd_timeout,4 [FBLOCK_K_STATE_CMD_WAIT, Event_Data_Start] = fail,5 [FBLOCK_K_STATE_CMD_WAIT, Event_Data_Finish] = fail,4 [FBLOCK_K_STATE_DATA_BEGIN, Event_Cmd_Recv] = fail,@ [FBLOCK_K_STATE_DATA_BEGIN, Event_Cmd_Sent] = normal_data_work,7 [FBLOCK_K_STATE_DATA_BEGIN, Event_cmd_timeout] = fail,6 [FBLOCK_K_STATE_DATA_BEGIN, Event_Data_Start] = fail,D [FBLOCK_K_STATE_DATA_BEGIN, Event_Data_Finish] = early_data_finish,4 [FBLOCK_K_STATE_DATA_EARLY, Event_Cmd_Recv] = fail,= [FBLOCK_K_STATE_DATA_EARLY, Event_Cmd_Sent] = late_cmd_send,7 [FBLOCK_K_STATE_DATA_EARLY, Event_cmd_timeout] = fail,6 [FBLOCK_K_STATE_DATA_EARLY, Event_Data_Start] = fail,7 [FBLOCK_K_STATE_DATA_EARLY, Event_Data_Finish] = fail,> [FBLOCK_K_STATE_DATA_WORK, Event_Cmd_Recv] = intrpt_cmd_recv,3 [FBLOCK_K_STATE_DATA_WORK, Event_Cmd_Sent] = fail,6 [FBLOCK_K_STATE_DATA_WORK, Event_cmd_timeout] = fail,5 [FBLOCK_K_STATE_DATA_WORK, Event_Data_Start] = fail,D [FBLOCK_K_STATE_DATA_WORK, Event_Data_Finish] = normal_data_finish,4 [FBLOCK_K_STATE_DATA_PAUSE, Event_Cmd_Recv] = fail,? [FBLOCK_K_STATE_DATA_PAUSE, Event_Cmd_Sent] = intrpt_cmd_send,7 [FBLOCK_K_STATE_DATA_PAUSE, Event_cmd_timeout] = fail,6 [FBLOCK_K_STATE_DATA_PAUSE, Event_Data_Start] = fail,E [FBLOCK_K_STATE_DATA_PAUSE, Event_Data_Finish] = intrpt_data_finish,4 [FBLOCK_K_STATE_DATA_ABORT, Event_Cmd_Recv] = fail,A [FBLOCK_K_STATE_DATA_ABORT, Event_Cmd_Sent] = intrpt_data_abort,7 [FBLOCK_K_STATE_DATA_ABORT, Event_cmd_timeout] = fail,6 [FBLOCK_K_STATE_DATA_ABORT, Event_Data_Start] = fail,8 [FBLOCK_K_STATE_DATA_ABORT, Event_Data_Finish] = fail); 7GLOBAL ROUTINE ftp_in_finish(fblock_a, finish_status) =!++! Functional Description:!9! We are now with this request. Release all devices that?! were allocated to this request. Close all connections. Free?! all memory for this request. Call the ast routine associated! with this request.!-- BEGIN BIND# fblock = .fblock_a : FBLOCKDEF,0 final_status = .fblock[FBLOCK_L_FINAL_STATUS_A] : LONG UNSIGNED; BUILTIN REMQUE; EXTERNAL ROUTINE+ free_mem : BLISS ADDRESSING_MODE(GENERAL),- text_clear : BLISS ADDRESSING_MODE(GENERAL); LOCAL addr, astadr, astprm, tcp_iosb : IOSBDEF, status;2 IF NOT .fblock[FBLOCK_V_VALID] THEN RETURN(0); fblock[FBLOCK_V_VALID] = 0; REMQUE(fblock, addr);" final_status = .finish_status; %IF debug %THEN9 print('!%D ftp_in_finish, Final_status=x!XL FBlock=!XL', 0, .final_status, fblock); %FI %IF listener %THEN !Listener version BEGIN" EXTERNAL ROUTINE dasgn_srv_chans;( IF ..fblock[FBLOCK_L_TCP_CHANNEL] NEQ 0 THEN BEGINI status = netlib_lib_disconnect(CTX = .fblock[FBLOCK_L_TCP_CHANNEL]);) IF NOT .status THEN SIGNAL(.status);G status = netlib_lib_deassign(CTX = .fblock[FBLOCK_L_TCP_CHANNEL]);) IF NOT .status THEN SIGNAL(.status); END;( dasgn_srv_chans(.fblock[FBLOCK_L_SRV]); END; %ELSE !Server version8 status = $DASSGN(CHAN = .fblock[FBLOCK_L_OUT_CHANNEL]);% IF NOT .status THEN SIGNAL(.status);8 status = $DASSGN(Chan = .fblock[FBLOCK_L_TCP_Channel]);% IF NOT .status THEN SIGNAL(.status);1 %FI !End of listener/server specific cleanup !++> ! Free up the dynamic strings associated with this request !--4 status = STR$FREE1_DX(fblock[FBLOCK_Q_IN_LINE]);( IF NOT .status THEN SIGNAL(.status);5 status = STR$FREE1_DX(fblock[FBLOCK_Q_USERNAME]);( IF NOT .status THEN SIGNAL(.status);5 status = STR$FREE1_DX(fblock[FBLOCK_Q_OUT_DESC]);( IF NOT .status THEN SIGNAL(.status);7 status = STR$FREE1_DX(fblock[FBLOCK_Q_TRANS_DESC]);( IF NOT .status THEN SIGNAL(.status);5 status = STR$FREE1_DX(fblock[FBLOCK_Q_TIMEZONE]);( IF NOT .status THEN SIGNAL(.status);6 status = STR$FREE1_DX(fblock[FBLOCK_Q_PARSE_ARG]);( IF NOT .status THEN SIGNAL(.status); %IF server %THEN !Server version< status = text_clear (fblock [FBLOCK_Q_RESTRICTED_DIRS]);( IF NOT .status THEN SIGNAL(.status); %FI !9 ! Save ASTADR and ASTPRM before deallocating FBLOCK! !' astadr = .fblock [FBLOCK_L_ASTADR];' astprm = .fblock [FBLOCK_L_ASTPRM]; status = $DCLAST( ASTADR = free_mem, ASTPRM = fblock);( IF NOT .status THEN SIGNAL(.status); status = $DCLADӬN MGFTP026.Gl#IGFTP.SOURCE]FTP_IN.B32;92WST( ASTADR = .astadr, ASTPRM = .astprm);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; %GLOBAL ROUTINE ftp_in_abort(astprm) =!++! Functional Description:!:! Someone asked us to start up this server asynchronously.3! Now they've changed their minds. So we must find7! the corresponding FBlock(s) and finish their request.!-- BEGIN LOCAL all_flag, next_fblock,2 fblock_a : INITIAL(.ftp_in_queue[QUEUE$L_FLINK]); BUILTIN NULLPARAMETER;% all_flag = NULLPARAMETER(astprm);( WHILE .fblock_a NEQA ftp_in_queue DO BEGIN BIND% fblock = .fblock_a : FBLOCKDEF; !? ! FBLOCK is deallocated in ftp_in_finish(), so get address of; ! next entry now so we don't get garbarge after the call. !( next_fblock = .fblock [FBLOCK_L_FLINK];6 IF .all_flag OR .fblock[FBLOCK_L_ASTPRM] EQLU .astprm' THEN ftp_in_finish(fblock, SS$_ABORT); fblock_a = .next_fblock; END; SS$_NORMAL END; 2%sbttl 'Send messages to the Central VMS operator'%( Function:A Send messages to the operators console & those terminals defined/ as operators. used to give security messages.Inputs:< Text = address of mesage descriptor(vms string descriptor).Outputs: lbc(low bit clear) = success otherwise $sndopr error return. Side Effects:6 operator terminals will receive the xmitted messages.A if message_length > 128-size(tcp$network_name) then message will be truncated.)%(GLOBAL ROUTINE send_2_operator(text_a) = BEGIN BIND text = .text_a : $BBLOCK; OWN request_id : LONG INITIAL(0); LITERAL MAXCHR = 1024; LOCAL msglen, ptr, msg : $BBLOCK[DSC$K_Z_BLN], msgbuf : $BBLOCK[MAXCHR]; BIND1 msgtext = msgbuf[OPC$L_MS_TEXT] : VECTOR[,BYTE];) msgbuf[OPC$B_MS_TYPE] = OPC$_RQ_RQST;0 msgbuf[OPC$B_MS_TARGET] = OPC$M_NM_SECURITY;* msgbuf[OPC$L_MS_RQSTID] = .request_id;! request_id = .request_id + 1;! msglen = .text[DSC$W_LENGTH]; IF .msglen GTR MAXCHR THEN .msglen = MAXCHR;3 CH$MOVE(.msglen,.text[DSC$A_POINTER], msgtext);" msg[DSC$W_LENGTH] = 8+.msglen;% msg[DSC$B_CLASS] = DSC$K_CLASS_Z;% msg[DSC$B_DTYPE] = DSC$K_DTYPE_Z; msg[DSC$A_POINTER] = msgbuf; RETURN $SNDOPR(MSGBUF=msg); END; ROUTINE wait_for_timer(t) =!++! Functional Description:!/! Set a timer to go off sometime in the future.!-- BEGIN BUILTIN EMUL; LOCAL vms_time : VECTOR[2, LONG], status; %IF debug %THEN. print('!%D wait_for_timer, T = !UL!/',0, .t); %FI EMUL( %REF(.t), ! Multiplier< %REF(-10 * 1000 * 1000), ! VMS time units signed one second %REF(0), ! Add vms_time); ! product status = $SETIMR( EFN = 1, DAYTIM = vms_time, REQIDT = wait_for_timer); $WAITFR( EFN = 1 );( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; .GLOBAL ROUTINE send_error(fblock_a, mstatus) =!++! Functional Description:!:! Someone asked us to start up this server asynchronously.3! Now they've changed their minds. So we must findr7! the corresponding FBlock(s) and finish their request.D!--l BEGINH BIND# fblock = .fblock_a : FBLOCKDEF,C/ conn = .fblock[FBLOCK_L_CONN_INFO] : CONNDEF,2' remadr = conn[CONN_L_REMADR] : LONG;e BUILTINr EMUL, CMPM, ADDM; EXTERNAL ROUTINE strings_handler,o: LIB$CONVERT_DATE_STRING : BLISS ADDRESSING_MODE(GENERAL),/ LIB$SYS_FAO : BLISS ADDRESSING_MODE(GENERAL);y LOCALe security_time : VECTOR[2,LONG], current_time : VECTOR[2,LONG], wait_time : VECTOR[2,LONG], lnm_buffer : VECTOR[32,BYTE],( lnm_desc : $BBLOCK[DSC$K_S_BLN] PRESET(- [DSC$W_LENGTH] = %ALLOCATION(lnm_buffer),P" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_S," [DSC$A_POINTER] = lnm_buffer),* lnm_list : $ITMLST_DECL(ITEMS=1),3 temp_desc : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(o [DSC$W_LENGTH] = 0," [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),t$ message_buffer : VECTOR[256, BYTE],, message_desc : $BBLOCK[DSC$K_S_BLN] PRESET(1 [DSC$W_LENGTH] = %ALLOCATION(message_buffer),_" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_S,& [DSC$A_POINTER] = message_buffer), status; ENABLE strings_handler(temp_desc); status = $GETMSG(h MSGID = .mstatus,% MSGLEN = message_desc[DSC$W_LENGTH],f BUFADR = message_desc);( IF NOT .status THEN SIGNAL(.status); IF .status THEN BEGIN LIB$SYS_FAO( W %ASCID 'FTP - !AS!/ User:!AS!/ Remote host:!AD[!UB.!UB.!UB.!UB]!/ Port:!UL',a 0, temp_desc,s message_desc,e fblock[FBLOCK_Q_USERNAME], .conn[CONN_L_REMHOSTLEN],  conn[CONN_T_REMHOSTBUF],! .remadr<0,8,0>, .remadr<8,8,0>,1# .remadr<16,8,0>, .remadr<24,8,0>,  .conn[CONN_L_REMPORT]);F send_2_operator( temp_desc ); END;g& status = STR$FREE1_DX( temp_desc);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; l+GLOBAL ROUTINE send_data(fblock_a, str_a) =A!++u! Functional Description:a!c8! Send a response to a remote site. The response should&! probably contain one(or more) CRLF .!H!-- BEGIN- BIND" fblock = .fblock_a : FBLOCKDEF, str = .str_a : $BBLOCK; LOCALa tcp_iosb : IOSBDEF, status; %IF debuge= %THEN print('!%D send_data, FBlock = !XL, str = ''!AS''',s 0, .fblock_a, str);t %FIs !++r' ! Send the data to the remote host.a !--o %IF listener %THEN !Listener versiont !? ! Make sure our channel hasn't gone away! If so, just return  !, IF (..fblock [FBLOCK_L_TCP_CHANNEL] EQLU 0) THENe RETURN (SS$_NORMAL); status = netlib_lib_send(' CTX = .fblock[FBLOCK_L_TCP_CHANNEL],a STR = str,p PUSH = 1); !dM! Let NETLIB take care of the IOSB, so that it will use $QIOW instead of $QIOe!!! IOSB = tcp_iosb);a tcp_iosb[IOSB_W_STATUS] = 1;o %ELSE !Server version  !? ! Make sure our channel hasn't gone away! If so, just returns !+ IF (.fblock [FBLOCK_L_OUT_CHANNEL] EQLU 0)6 THENu RETURN (SS$_NORMAL);B6 status = $QIOW( CHAN = .fblock[FBLOCK_L_OUT_CHANNEL], IOSB = tcp_iosb,$ FUNC = IO$_WRITEVBLK OR IO$M_NOW, P1 = .str[DSC$A_POINTER], P2 = .str[DSC$W_LENGTH]); %FID %IF debugc %THEN IF NOT .status8 THEN print('!%D send_data, status = !XL',0, .status); %FIe9 IF NOT .status THEN ftp_in_finish(fblock, FTP$_ABORT)e ELSE BEGIN# status = .tcp_iosb[IOSB_W_STATUS];o"! IF .status EQL SS$_ABORT then"! status = .tcp_iosb[NSB$Xstatus]; %IF debug %THEN IF NOT .statusT7 THEN print('!%D send_data, status = !XL',0, .status);h %FI4 IF NOT .status THEN ftp_in_finish(fblock, .status); END;e SS$_NORMAL END; /GLOBAL ROUTINE send_cmd(fblock_a, response_a) =e!++! Functional Description: !N8! Send a response to a remote site. The response should&! probably contain one(or more) CRLF .!l!--s BEGIN. BIND# fblock = .fblock_a : FBLOCKDEF, $ response = .response_a : $BBLOCK; LOCALv status; %IF debugiC %THEN print('!%D send_cmd, FBlock = !XL, response = ''!AS''',0,o fblock, response); %FIa !++9H ! Before we actually send the data, log the line with the transcript ! routine. !--e) IF .fblock[FBLOCK_L_TRANSCRIPT] NEQ 09( THEN (.fblock[FBLOCK_L_TRANSCRIPT])( .fblock[FBLOCK_L_ASTPRM],s response); !++r' ! Send the data to the remote hostE$ MGFTP026.Gl#IGFTP.SOURCE]FTP_IN.B32;92W&*.c !--n@ send_data(fblock, response); !Calls ftp_in_finish upon error (.transition_matrix[ .fblock[FBLOCK_L_STATE], Event_Cmd_Sent ])(FBlock); SS$_NORMAL END; r %SBTTL 'Input Routines'!++ ! The four routines below:! Release_In_Line, ! Add_Char,n! Network_Read_Ast, andr ! Do_ReadBE! implement the input routines. We would like to be able to just get_C! a line at a time in from the remote site, but the connection is aeB! byte stream. The byte stream treats CR and LF no different than! any other character.!--B#ROUTINE release_in_line(fblock_a) =E!++ ! Functional Description:t!h=! We've just received an incoming line followed by a i#! or some such terminator. We must ! - call the transcript routine3! - see that it conforms to the reply line syntax,b)! - see if the line is a multiline replyr!--e BEGINu BIND" fblock = .fblock_a : FBLOCKDEF,. in_line = fblock[FBLOCK_Q_IN_LINE] : $BBLOCK,2 in_vec = .in_line[DSC$A_POINTER] : VECTOR[,BYTE]; LOCALr status; IF .fblock[FBLOCK_V_COMMAND]* THEN print('>!%D ''!AS''',0, in_line); !++i& ! Write the line in the transcript !--e) IF .fblock[FBLOCK_L_TRANSCRIPT] NEQ 0g( THEN (.fblock[FBLOCK_L_TRANSCRIPT])( .fblock[FBLOCK_L_ASTPRM],R in_line);YJ (.transition_matrix[.fblock[FBLOCK_L_STATE], Event_Cmd_Recv])(FBlock); !++F9 ! Now that we've handled the input line, clear it outR !--I4 status = STR$FREE1_DX(fblock[FBLOCK_Q_IN_LINE]);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; $ROUTINE add_char(c, string_desc_a) =!++F! Functional Description: !,)! Add a character to the end of a string.r!s3! This should be in some runtime library somewhere.R!-- BEGIND BIND( string_desc = .string_desc_a : $BBLOCK; EXTERNAL ROUTINE- STR$APPEND : BLISS ADDRESSING_MODE(GENERAL);n LOCAL!& c_desc : $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 1,! [DSC$B_DTYPE] = DSC$K_DTYPE_T,M! [DSC$B_CLASS] = DSC$K_CLASS_S,$ [DSC$A_POINTER] = c), status; %IF debug'9 %THEN print('!%D add_char(!XB,%ASCID''!AF''!/',0, .c,l; .string_desc[DSC$W_LENGTH],.string_desc[DSC$A_POINTER]);u %FI - status = STR$APPEND(string_desc, c_desc);_( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; eFORWARD ROUTINE cmd_read; ROUTINE cmd_read_ast(fblock_a) =!++! Functional Description:L!L:! For now we just keep appending data until we come to the;! end of the line. But we need to be aware of all of those@! brain damaged unix systems out there that just send LF insteadA! CRLF. Also, don't be surprised if some just send CR and no LF. !m=! The routine should implement the FSM below to translate them:! series of LF and CR that we get in from the byte stream.!B8! There are three types of characters LF(for Line Feed),0! CR(for Carriage Return), and C(for all other).! ;! C/Add CR/Release_<! /-----------\ /-----------\<! | | | |<! v | v |<! +--------+ | +--------+ |<! | Normal |----/ CR/Release | CR |----/7! | State |----------------------->| State |f<! | |<-----------------------| |----\<! +--------+ C/Add +--------+ |F! | ^ 1 ^ | LF/Ignore<! | | C/Add CR/Ignore | |<! | \-----------\ /-----------\ \--------//! | | | |O/! | | v |B/! | LF/Release +----------+ |m/! \------------>| LF |-------/m.! | State |------\.! | | |.! +----------+ |.! ^ |.! | LF/Release |.! \---------------/!--d BEGIN  BIND# fblock = .fblock_a : FBLOCKDEF,D6 in_state = fblock[FBLOCK_L_IN_STATE] : LONG UNSIGNED,/ in_iosb = fblock[FBLOCK_Q_IN_IOSB] : IOSBDEF;, LITERALc CHAR_CR = %X'0D',K CHAR_LF = %X'0A';e LOCAL] number_bytes, status; %IF debug_ %THENt BEGIN* BIND iosb_vec = in_iosb : VECTOR[2,LONG];. print('!%D cmd_read_Ast, in_state = !UL!/',0, .fblock[FBLOCK_L_IN_STATE]);& print('cmd_read_Ast, iosb = !XL !XL', .iosb_vec[0], .iosb_vec[1]);3! print('cmd_read_Ast, in_iosb[NSB$Xstatus] = !XL',m! .in_iosb[NSB$Xstatus]);+ print('cmd_read_Ast, In_Buffer = ''!AF''',O .IN_IOSB[IOSB_W_COUNT],t fblock[FBLOCK_T_IN_BUFFER]); END;D %FI,; IF NOT .fblock[FBLOCK_V_VALID] THEN RETURN(SS$_NORMAL);n% status = .in_iosb[IOSB_W_STATUS];K"! IF .status EQL SS$_ABORT then!! status = .in_iosb[NSB$Xstatus];K IF NOT .status THEN BEGINB ftp_in_finish(FBlock, .status); RETURN(SS$_NORMAL); END;S !++_A ! Was the read of zero bytes? If so that probably means thatD$ ! the remote host has gone away. !--S* number_bytes = .IN_IOSB[IOSB_W_COUNT]; IF .number_bytes EQLU 0_ THEN BEGIN# ftp_in_finish(FBlock, FTP$_ABORT);D RETURN(SS$_NORMAL); END;=+ INCR i FROM 0 TO (.number_bytes - 1) DO_ BEGIN BINDt= in_buffer = fblock[FBLOCK_T_IN_BUFFER] : VECTOR[ ,BYTE],=0 this_char = in_buffer[.i] : BYTE UNSIGNED; !++* ! Turn off the top bit if this_char > 128 !-- this_char<7,1,0> = 0; SELECTONEU .in_state OF SET [FBLOCK_K_IN_STATE_NORMAL] : BEGINB SELECTONEU .this_char OF SET [CHAR_CR] : BEGIN# in_state = FBLOCK_K_IN_STATE_CR;  release_in_line(fblock); END;n [CHAR_LF] : BEGIN# in_state = FBLOCK_K_IN_STATE_LF;d release_in_line(fblock);c END;s [OTHERWISE] : BEGIN2 add_char(.this_char, fblock[FBLOCK_Q_IN_LINE]);' in_state = FBLOCK_K_IN_STATE_NORMAL;D END; TES; END; [FBLOCK_K_IN_STATE_CR] : BEGINK SELECTONEU .this_char OF SETN [CHAR_CR] : BEGIN# in_state = FBLOCK_K_IN_STATE_CR;L release_in_line(fblock); END;l [CHAR_LF] : BEGIN# in_state = FBLOCK_K_IN_STATE_CR;d END;r [OTHERWISE] : BEGIN2 add_char(.this_char, fblock[FBLOCK_Q_IN_LINE]);' in_state = FBLOCK_K_IN_STATE_NORMAL; END;E TES; END; [FBLOCK_K_IN_STATE_LF] : BEGIN  SELECTONEU .this_char OF SETf [CHAR_CR] : BEGIN# in_state = FBLOCK_K_IN_STATE_LF;k END; [CHAR_LF] : BEGIN' in_state = FBLOCK_K_IN_STATE_NORMAL;O release_in_line(fblock);  END;F [OTHERWISE] : BEGIN2 add_char(.this_char, fblock[FBLOCK_Q_IN_LINE]);' in_state = FBLOCK_K_IN_STATE_NORMAL;I END;a TES; END; %IF listenera %THEN !4 ! The following in_states are used by FTP_Listener. !D ! Note : fblock[FBLOCK_Q_IN_LINE] should be empty whenever we reach ! this point._ !" [FBLOCK_K_IN_STATE_PASSTHRU]: BEGINu BIND+ srv = .fblock[FBLOCK_L_SRV] : SRVDEF;I LOCALa in_ior : REF IORDEF,% tmp_desc : $BBLOCK[DSC$C_S_BLN]_/ PRESET([DSC$W_LENGTH] = .number_bytes-.i,a$ [DSC$B_CLASS] = DSC$K_CLASS_S,$ [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$A_POINTER]= this_char); EXTERNAL ROUTINE mem_getior,t mem_freeior,FJ| MGFTP026.Gl#IGFTP.SOURCE]FTP_IN.B32;92W!9 free_ior_ast,N dasgn_srv_chans;;T in_ior = mem_getior(); IF .in_ior EQLA 0( THEN status = SS$_INSFMEM ELSE status = SS$_NORMAL;L IF .status THEN BEGIN- CH$MOVE(.number_bytes-.i,in_buffer[.i],F in_ior[IOR_T_BUF]);.$ in_ior[IOR_L_ASTPRM] = fblock; status = $QIO( CHAN = .srv[SRV_L_INPCHN],E FUNC = IO$_WRITEVBLK, IOSB = in_ior[IOR_Q_IOSB],L ASTADR = free_ior_ast,N ASTPRM = .in_ior, P1 = in_ior[IOR_T_BUF], P2 = .number_bytes-.i);. IF NOT .status THEN mem_freeior(in_ior); END; IF NOT .status THEN BEGIN! srv[SRV_V_LOGGING_OUT] = 1;f dasgn_srv_chans(srv);R END; EXITLOOP;T END; %FI TES;  %IF listener %THEN !Listener versione> IF .fblock[FBLOCK_L_IN_STATE] EQLU FBLOCK_K_IN_STATE_PASSTHRU THEN EXITLOOP;  %FI.8 IF NOT .fblock[FBLOCK_V_VALID] THEN RETURN(SS$_NORMAL); END;e cmd_read(fblock);) SS$_NORMAL END; NROUTINE cmd_read(fblock_a) =!++T! Functional Description: !P1! Start an asynch read on the network connection.t!-- BEGINO BIND fblock = .fblock_a : FBLOCKDEF; LOCAL  %IF listener %THEN !Listener versione! recv_desc : $BBLOCK[DSC$C_S_BLN]r0 PRESET([DSC$W_LENGTH] = FBLOCK_S_IN_BUFFER,# [DSC$B_CLASS] = DSC$K_CLASS_S,d# [DSC$B_DTYPE] = DSC$K_DTYPE_T,t2 [DSC$A_POINTER]= fblock[FBLOCK_T_IN_BUFFER]), %FI status; %IF debug_: %THEN print('!%D cmd_read, FBlock = !XL!/',0, FBlock); %FIg %IF listener %THEN !Listener versionE status = netlib_lib_receive(N' CTX = .fblock[FBLOCK_L_TCP_CHANNEL], STR = recv_desc, # IOSB = fblock[FBLOCK_Q_IN_IOSB],t ASTADR = cmd_read_ast,y ASTPRM = fblock); %ELSE !Server version! BEGIN EXTERNAL ROUTINEB toggle_priv;I !. ! SYSPRV is needed to read the input mailbox. ! toggle_priv(1, 0);o5 status = $QIO( CHAN = .fblock[FBLOCK_L_TCP_CHANNEL],# IOSB = fblock[FBLOCK_Q_IN_IOSB],l FUNC = IO$_READVBLK,n ASTADR = cmd_read_ast,u ASTPRM = fblock,s# P1 = fblock[FBLOCK_T_IN_BUFFER],  P2 = FBLOCK_S_IN_BUFFER); toggle_priv(0, 0);c END;e %FI: IF NOT .status THEN ftp_in_finish(FBlock, FTP$_ABORT); SS$_NORMAL END; l %SBTTL 'Timer Routines'!++h,! Three things that can happen with a timer:)! - Set the timer to go off in x seconds,i2! - Cancel all timers associated with this FBlock,! - have a timer go off.!--!ROUTINE cmd_timer_ast(fblock_a) =s!++_! Functional Description:I!;! A timer has gone off. This is one of the primary events. !--I BEGIN BIND fblock = .fblock_a : FBLOCKDEF; %IF debug? %THEN print('!%D cmd_timer_ast, FBlock = !XL!/',0, fblock);D %FIt; IF NOT .fblock[FBLOCK_V_VALID] THEN RETURN(SS$_NORMAL);MC (.transition_matrix[.fblock[FBLOCK_L_STATE], Event_cmd_timeout]T )(FBlock);f SS$_NORMAL END;$ROUTINE cancel_cmd_timer(fblock_a) =!++ ! Functional Description:]!.! Punt all timers associated with this FBlock.!--; BEGINV BIND fblock = .fblock_a : FBLOCKDEF; LOCAL$ status; %IF debug > %THEN print('!%D Cancel_Timer, FBlock = !XL!/',0, fblock); %FI& status = $CANTIM(REQIDT = fblock);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END;0GLOBAL ROUTINE set_timer(fblock_a, t, astrtn_a)=!++o! Functional Description:u!! A nicer interface to $SETIMR!--U BEGINA BIND fblock = .fblock_a : FBLOCKDEF; BUILTINu EMUL; LOCAL' vms_time : VECTOR[2, LONG], status; %IF debugF %THEN print('!%D set_timer, FBlock = !XL, T = !UL! AstRtn = !XL/', 0, fblock, .t, .astrtn_a); %FI EMUL(  %REF(.t), ! Multiplier$< %REF(-10 * 1000 * 1000), ! VMS time units signed one second %REF(0), ! AddI vms_time); ! productN status = $SETIMR(t DAYTIM = vms_time, ASTADR = .astrtn_a,L REQIDT = fblock);b( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END;$ROUTINE set_cmd_timer(fblock_a, t) =!++.! Functional Description:i!i/! Set a timer to go off sometime in the future.k!--n BEGINe BIND fblock = .fblock_a : FBLOCKDEF; %IF debugaL %THEN print('!%D set_cmd_timer, FBlock = !XL, T = !UL!/',0, fblock, .t); %FIN( set_timer(fblock, .t, cmd_timer_ast) END; ;'GLOBAL ROUTINE cmd_timeout (fblock_a) =o!++B! Functional Description:S!D8! We haven't heard any commands from the remote site and7! we are not transferring any data, I wonder what couldG! be taking so long.!--2 BEGINw BIND# fblock = .fblock_a : FBLOCKDEF,R1 timezone = fblock [FBLOCK_Q_TIMEZONE] : $BBLOCK;( LOCALW+ fblock_enable : VOLATILE INITIAL (fblock);C EXTERNAL ROUTINE ftp_handler;B ENABLE ftp_handler(fblock_enable); !++uK ! Once the response is sent, this connection will be closed and cleanedB ! up.S !--S" fblock[FBLOCK_V_QUITTING] = 1; %IF listener %THEN !Listener version # IF .fblock[FBLOCK_L_TIMEOUT] EQL 0 ) THEN SIGNAL(FTP$_SERVICE_UNAVAILABLE, 0,,: FTP$_TIMEOUT, 3, 0, timezone, .fblock[FBLOCK_L_TIMEOUT])F ELSE SIGNAL(FTP$_TIMEOUT, 3, 0, timezone, .fblock[FBLOCK_L_TIMEOUT]); %ELSE !Server version$ IF .fblock[FBLOCK_V_ANONYMOUS] THEN BEGINr1 anon_log('Anonymous FTP session time out.');c2 anon_log_close(.fblock[FBLOCK_L_ANON_BLOCK]); END;s ! Activity Log: End of session  IF .fblock[FBLOCK_V_ACT_LOG]t2 THEN SUPER_ACT$FAO('FTP: FTP session time out.'); $WAKE();BA SIGNAL(FTP$_TIMEOUT, 3, 0, Timezone, .fblock[FBLOCK_L_TIMEOUT]);! %FIB SS$_NORMAL END; !End of cmd_timeout c)GLOBAL ROUTINE data_start_ast(fblock_a) =O!++R! Functional Description:_!H"! The data connection is now open.!--> BEGINd BIND! FBlock = .fblock_a : FBLOCKDEF;R; IF NOT .fblock[FBLOCK_V_VALID] THEN RETURN(SS$_NORMAL);s %IF debug(@ %THEN print('!%D data_start_ast, FBlock = !XL!/',0, fblock); %FI fblock[FBLOCK_L_BLOCKS] = 0; fblock[FBLOCK_L_BYTES] = 0;cB (.transition_matrix[.fblock[FBLOCK_L_STATE], Event_Data_Start] )(FBlock); SS$_NORMAL END; *GLOBAL ROUTINE data_finish_ast(fblock_a) =!++=! Functional Description:s! '! The data transfer has been completed.s!--O BEGINa BIND" fblock = .fblock_a : FBLOCKDEF;; IF NOT .fblock[FBLOCK_V_VALID] THEN RETURN(SS$_NORMAL);t IF .fblock[FBLOCK_V_COMMAND] THEN BEGIN1 BIND byte_count = fblock[FBLOCK_L_BYTES] : LONG; + fblock[FBLOCK_L_BLOCKS] = .byte_count^-9 +n. (IF .byte_count<0,9,0> EQL 0 THEN 0 ELSE 1);8 print('!%D Data Transfer done Bytes=!UL, Blocks=!UL',0,5 .fblock[FBLOCK_L_BYTES], .fblock[FBLOCK_L_BLOCKS]);  END;.!%IF NOT(listener) !Server versionR%THENp !SD ! If we're logging our activity, then add a line indicating the# ! STOR or RETR was successful.t !) IF .fblock[FBLOCK_V_ACT_LOG] THEN BEGIN LOCAL ptr : REF $BBLOCK;r, SELECTONE (.fblock[FBLOCK_L_CMD_INPROG]) OF SET0 [FBLOCK_K_CMD_STOR] : ptr = %ASCID'Stored';3 [FBLOCK_K_CMD_RETR] : ptr = %ASCID'Retrieved';C2 [FBLOCK_K_CMD_APPE] : ptr = %ASCID'Appended';0 [FBLOCK_K_CMD_LIST] : ptr = %ASCID'LISTed';0 [FBLOCK_K_CMD_NLST] : ptr = %ASCID'NLSTed'; [OTHERWISE] : ptr = 0;u TES;E IF (.ptr NEQA 0)  THENr: super_act$fao('FTP: !AS !AS (Bytes=!UL, Blocks=!UL)', .ptr,T5 fblock[FBLOCK_Q_OUT_DESC], .fblock[FBLOCK_L_BYTES],L .fblock[FBLOCKG3h MGFTP026.Gl#IGFTP.SOURCE]FTP_IN.B32;92WUH_L_BLOCKS]); END;S%FI]C (.transition_matrix[.fblock[FBLOCK_L_STATE], Event_Data_Finish]s )(FBlock);b SS$_NORMAL END; HROUTINE fail(fblock_a) =!++ ! Functional Description:! >! An internal inconsistency. This should not happen under any6! circumstance. If it does, well we've got a problem.!--e BEGINe BIND FBlock = .fblock_a : FBLOCKDEF;; IF NOT .fblock[FBLOCK_V_VALID] THEN RETURN(SS$_NORMAL);y% ftp_in_finish(FBlock, FTP$_FAIL);  SS$_NORMAL END; .#ROUTINE normal_cmd_send(fblock_a) = !++o! Functional Description:A!<! We've just sent some data on the command connection to the! remote site.! ?! If that was a response to a quit command, then we should call D! ftp_in_finish. Otherwise, just start the command timer and adjust ! the state.! !-- BEGINo BIND FBlock = .fblock_a : FBLOCKDEF;: IF NOT .fblock[FBLOCK_V_VALID] THEN RETURN(SS$_NORMAL);! IF .fblock[FBLOCK_V_QUITTING]d THEN BEGIN# ftp_in_finish(fblock, SS$_NORMAL);o RETURN(SS$_NORMAL); END;f5 fblock[FBLOCK_L_STATE] = FBLOCK_K_STATE_CMD_WAIT;B5 set_cmd_timer(fblock, .fblock[FBLOCK_L_TIMEOUT]);_ SS$_NORMAL END; I#ROUTINE normal_cmd_recv(fblock_a) =u!++ ! Functional Description:!d.! We've received a command from a remote site.!m;! Stop any timers, adjust the state, and parse the command. !_A! Here we should probably establish a handler. The handler would ?! convert any conditions to into an FTP reply code and send the *! reply and perhaps unwind the call stack.!--e BEGINn BIND fblock = .fblock_a : FBLOCKDEF; LOCAL * fblock_enable : VOLATILE INITIAL(fblock); EXTERNAL ROUTINE ftp_handler;i ENABLE ftp_handler(fblock_enable); EXTERNAL ROUTINE parse_ftp_command;r %IF debugb %THENi6 print('!%D normal_cmd_recv, FBlock = !XL',0, fblock);/ print('normal_cmd_recv, Handler Established');e %FI[; IF NOT .fblock[FBLOCK_V_VALID] THEN RETURN(SS$_NORMAL);  cancel_cmd_timer(fblock);a5 fblock[FBLOCK_L_STATE] = FBLOCK_K_STATE_CMD_WORK;'E fblock[FBLOCK_V_CONN_OPEN] = .fblock[FBLOCK_L_BLK_CHANNEL] NEQ 0;c/ parse_ftp_command(fblock[FBLOCK_Q_IN_LINE], ( fblock [FBLOCK_Q_PARSE_ARG], fblock); SS$_NORMAL END; T%ROUTINE early_data_finish(fblock_a) =n!++i! Functional Description:E!t9! For some reason we've finished the data transfer befored7! our 1xx data transfer starting message could be sent.R!E<! Adjust the state, and continue waiting for the reply to be! sent.s!-- BEGINM BIND! fblock = .fblock_a : FBLOCKDEF;d7 fblock[FBLOCK_L_STATE] = FBLOCK_K_STATE_DATA_EARLY;r SS$_NORMAL END; !ROUTINE late_cmd_send(fblock_a) =e BEGINm BIND! fblock = .fblock_a : FBLOCKDEF;_ LOCALi* fblock_enable : VOLATILE INITIAL(fblock); EXTERNAL ROUTINE ftp_handler;E ENABLE ftp_handler(fblock_enable); LOCALP status;5 fblock[FBLOCK_L_STATE] = FBLOCK_K_STATE_CMD_WORK;& status = .fblock[FBLOCK_L_STATUS]; IF NOT .status4 THEN SIGNAL(FTP$_CONNECTION_CLOSED, 0, .status);! SIGNAL(FTP$_DATA_CLOSING, 0);t SS$_NORMAL END; _%ROUTINE normal_data_start(fblock_a) = !++s! Functional Description:c!s3! We've started the data transfer(or are about to). !--O BEGINN BIND# fblock = .fblock_a : FBLOCKDEF,m4 trans_desc = fblock[FBLOCK_Q_TRANS_DESC] : $BBLOCK,0 out_desc = fblock[FBLOCK_Q_OUT_DESC] : $BBLOCK; LOCALo* fblock_enable : VOLATILE INITIAL(fblock); EXTERNAL ROUTINE ftp_handler;e ENABLE ftp_handler(fblock_enable);7 fblock[FBLOCK_L_STATE] = FBLOCK_K_STATE_DATA_BEGIN;n& IF .trans_desc[DSC$W_LENGTH] NEQ 03 THEN SIGNAL((IF .fblock[FBLOCK_V_CONN_OPEN] ANDo1 .fblock[FBLOCK_L_MODE] NEQ FTP$K_MODE_STREAMB THEN FTP$_OPEN_STARTING ELSE FTP$_VMS_TRANSFER),, 2, trans_desc,# (IF .out_desc[DSC$W_LENGTH] EQL 0 THEN %ASCID'*.*;' ELSE out_desc)), ELSE SIGNAL(FTP$_FILE_OKAY_STARTING, 0); SS$_NORMAL END; -$ROUTINE normal_data_work(fblock_a) =!++ ! Functional Description: ! <! We've managed to send the 1xx response to the remote site..! Now just sit back and let the data transfer.!-- BEGINN BIND! FBlock = .fblock_a : FBLOCKDEF;/6 fblock[FBLOCK_L_STATE] = FBLOCK_K_STATE_DATA_WORK; SS$_NORMAL END; -&ROUTINE normal_data_finish(fblock_a) =!++-! Functional Description: !+(! The normal data transfer has finished.!-- BEGIN  BIND# fblock = .fblock_a : FBLOCKDEF, 4 trans_desc = fblock[FBLOCK_Q_TRANS_DESC] : $BBLOCK,0 out_desc = fblock[FBLOCK_Q_OUT_DESC] : $BBLOCK; LOCAL * fblock_enable : VOLATILE INITIAL(fblock); EXTERNAL ROUTINE ftp_handler; ENABLE ftp_handler(fblock_enable); LOCALm status;5 fblock[FBLOCK_L_STATE] = FBLOCK_K_STATE_CMD_WORK; & status = .fblock[FBLOCK_L_STATUS]; IF NOT .status6 THEN IF (.fblock[FBLOCK_L_STATUS2] EQL SS$_NORMAL)0 THEN SIGNAL(FTP$_CONNECTION_CLOSED, 0, .status); ELSE IF (.fblock[FBLOCK_L_STATUS2] EQL SS$_OVRDSKQUOTA) OR 1 (.fblock[FBLOCK_L_STATUS2] EQL SS$_EXDISKQUOTA) 2 THEN SIGNAL(FTP$_OVER_ALLOCATION, 0, .status, .fblock[FBLOCK_L_STATUS2])7 ELSE IF (.fblock[FBLOCK_L_STATUS2] EQL SS$_DEVICEFULL)_0 THEN SIGNAL(FTP$_STORAGE_SPACE, 0, .status, .fblock[FBLOCK_L_STATUS2])0 ELSE SIGNAL(FTP$_CONNECTION_CLOSED, 0, .status, .fblock[FBLOCK_L_STATUS2]); - IF .fblock[FBLOCK_L_BLK_CHANNEL] EQL 0 OR%- .fblock[FBLOCK_L_MODE] EQL FTP$K_MODE_STREAM[% THEN SIGNAL(FTP$_DATA_CLOSING, 0)A= ELSE SIGNAL(FTP$_TRANSFER_OKAY, 2, trans_desc, out_desc);c SS$_NORMAL END; .GLOBAL ROUTINE special_data_finish(fblock_a) =!++d! Functional Description:O! )! The Special data transfer has finished._!--F BEGIND BIND# fblock = .fblock_a : FBLOCKDEF,I4 trans_desc = fblock[FBLOCK_Q_TRANS_DESC] : $BBLOCK,0 out_desc = fblock[FBLOCK_Q_OUT_DESC] : $BBLOCK; LOCAL=* fblock_enable : VOLATILE INITIAL(fblock); EXTERNAL ROUTINE ftp_handler;, ENABLE ftp_handler(fblock_enable); LOCAL  status;5 fblock[FBLOCK_L_STATE] = FBLOCK_K_STATE_CMD_WAIT; 5 set_cmd_timer(fblock, .fblock[FBLOCK_L_TIMEOUT]);r SS$_NORMAL END; ;#ROUTINE intrpt_cmd_recv(fblock_a) = !++B! Functional Description:,!P=! We've received a command after we've sent a 1xx response toOB! remote user program. The appropriate thing to do would probably?! be to parse the string and let each of the individual command.2! routines decide on the approrpriate thing to do.!--t BEGIN1 BIND" fblock = .fblock_a : FBLOCKDEF; LOCAL * fblock_enable : VOLATILE INITIAL(fblock); EXTERNAL ROUTINE ftp_handler; ENABLE ftp_handler(fblock_enable); EXTERNAL ROUTINE parse_ftp_command;r %IF debugl? %THEN print('!%D intrpt_cmd_recv, FBlock = !XL',0, fblock);K %FIT7 fblock[FBLOCK_L_STATE] = FBLOCK_K_STATE_DATA_PAUSE;W/ parse_ftp_command(fblock[FBLOCK_Q_IN_LINE],L( fblock [FBLOCK_Q_PARSE_ARG], fblock); SS$_NORMAL END; #ROUTINE intrpt_cmd_send(fblock_a) =E!++:! Functional Description:h!c=! We've received a command(on the command port) while we wereB8! transferring data. We have now returned the response.!-- BEGIN] BIND" fblock = .fblock_a : FBLOCKDEF; %IF debug ? %THEN print('!%D intrpt_cmd_send, FBlock = !XL',0, fblock);_ %FI]6 fblock[FBLOCK_L_STATE] = FBLOCK_K_STATE_DAHV MGFTP026.Gl#IGFTP.SOURCE]FTP_IN.B32;92WWTA_WORK; SS$_NORMAL END; _&ROUTINE intrpt_data_finish(fblock_a) =!++c! Functional Description:H!C@! The data transfer has completed after he sent us an unexpectedB! command, but before we sent him a response. We may want to look?! at the final status of the data transfer. But normally, thisG1! means that he sent us an abort or quit command.]!!--_ BEGINO BIND" fblock = .fblock_a : FBLOCKDEF; LOCALF* fblock_enable : VOLATILE INITIAL(fblock); EXTERNAL ROUTINE ftp_handler; ENABLE ftp_handler(fblock_enable); %IF debug B %THEN print('!%D intrpt_data_finish, FBlock = !XL',0, fblock); %FI7 fblock[FBLOCK_L_STATE] = FBLOCK_K_STATE_DATA_ABORT;A& SIGNAL(FTP$_CONNECTION_CLOSED, 0); SS$_NORMAL END; %ROUTINE intrpt_data_abort(fblock_a) =e!++a! Functional Description:$!L?! Someone asked us to stop the data transfer. Well, we got theR! final response.X!--L BEGIN  BIND" fblock = .fblock_a : FBLOCKDEF; LOCALN* fblock_enable : VOLATILE INITIAL(fblock); EXTERNAL ROUTINE ftp_handler;H ENABLE ftp_handler(fblock_enable); %IF debugFA %THEN print('!%D intrpt_data_abort: FBlock = !XL',0, fblock);] %FIn5 fblock[FBLOCK_L_STATE] = FBLOCK_K_STATE_CMD_WORK;! SIGNAL(FTP$_DATA_CLOSING, 0);S SS$_NORMAL END; RROUTINE init_port(fblock_a) =Q!++]! Functional Description:t!5! Initialize the port values to something reasonable. =! We'll have to somehow figure out what the address is of thei! turkey who is talking to us.!-- BEGIN BIND" fblock = .fblock_a : FBLOCKDEF,. conn = .fblock[FBLOCK_L_CONN_INFO] : CONNDEF; LOCAL status; %IF debugrD %THEN print('!%D Remote Address = !XL',0, .conn[CONN_L_REMADR]); %FI_7 fblock[FBLOCK_L_LOCAL_HOST] = .conn[CONN_L_LCLADR];[6 fblock[FBLOCK_L_DATA_HOST] = .conn[CONN_L_REMADR];I fblock[FBLOCK_L_DATA_PORT] = FTP_DPORT; ! The well known default portc SS$_NORMAL END; s8ROUTINE get_timeout(tmo_log_a, tmo_table_a, timeout_a) =!++n! Functional Description:I!B! This routine translates tmo_log_a from table tmo_table_a and, if@! the value is an unsigned decimal number, sets timeout_a to the! translated value.]!F ! Parameters:E!<! tmo_log_a - address of a descriptor containing the timeout! logical name.S>! tmo_table_a - address of a descriptor containing the timeout! logical name table. A! timeout_a - address of a longword to receive the timeout value.I!--t BEGINT BIND timeout = .timeout_a : LONG;l LOCALN status, temp,! lnmlst : $ITMLST_DECL(ITEMS=1),r lnm_buffer : $BBLOCK[256],F) lnm_desc : $BBLOCK [DSC$K_S_BLN] PRESET(t- [DSC$W_LENGTH] = %ALLOCATION(lnm_buffer),s" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_S," [DSC$A_POINTER] = lnm_buffer); EXTERNAL ROUTINE/ OTS$CVT_TU_L : BLISS ADDRESSING_MODE(GENERAL);N $ITMLST_INIT(ITMLST=lnmlst,N (ITMCOD = LNM$_STRING,E BUFADR = lnm_buffer,# BUFSIZ = %ALLOCATION(lnm_buffer), % RETLEN = lnm_desc [DSC$W_LENGTH]));P !O- ! Get the timeout value for the listener. !( status = $TRNLNM( LOGNAM=.tmo_log_a, Tabnam=.tmo_table_a,  ITMLST=lnmlst); IF .status THEN BEGIN status = OTS$CVT_TU_L(lnm_desc, temp, %ALLOCATION(temp), 0);; IF .status THEN timeout = .temp; !Set the timeout variablet END= ELSE status = SS$_NORMAL; !Not translated, don't returni !...an error, .status !Return status to the caller END; !End of set_timeout ROUTINE setup_privs =!++E! Functional Description:f!cF! Disable installed privileges that were not turned on before starting ! the server.,!--l BEGIN LOCAL  imagpriv : $BBLOCK[8],A procpriv : $BBLOCK[8],A% item_list : $ITMLST_DECL(ITEMS = 2),[ status;$ $ITMLST_INIT(ITMLST = item_list,9 (ITMCOD = JPI$_IMAGPRIV, BUFADR = imagpriv, BUFSIZ = 8),l: (ITMCOD = JPI$_PROCPRIV, BUFADR = procpriv, BUFSIZ = 8));* status = $GETJPIW(ITMLST = item_list);( IF NOT .status THEN RETURN(.status); %IF debugA %THEN;. print('Setup_Privs: Process PRIV (!XL !XL )',2 .procpriv[0, 0, 32, 0], .procpriv[4, 0, 32, 0]);, print('Setup_Privs: Image PRIV (!XL !XL )',2 .imagpriv[0, 0, 32, 0], .imagpriv[4, 0, 32, 0]); %FI6 imagpriv[0, 0, 32, 0] = .imagpriv[0, 0, 32, 0] AND NOT .procpriv[0, 0, 32, 0]; 6 imagpriv[4, 0, 32, 0] = .imagpriv[4, 0, 32, 0] AND NOT .procpriv[4, 0, 32, 0]; %IF debugU %THENA. print('Setup_Privs: Disable PRIV (!XL !XL )',2 .imagpriv[0, 0, 32, 0], .imagpriv[4, 0, 32, 0]); %FI C IF .imagpriv[0, 0, 32, 0] NEQ 0 OR .imagpriv[4, 0, 32, 0] NEQ 0M THEN BEGIN status = $SETPRV() ENBFLG = 0, ! 0 = disable, 1 = enableg PRVADR = imagpriv);) %IF debug4 %THEN print('Disable privs status = !XL', .status); %FI END;t .status= END;!+F! The following routines were restored to FTP_IN from FTP_COMMON_CMDS.!- L2GLOBAL ROUTINE acct_command(fblock_a, account_a) =!++! Functional Description:!'! The acount string is not used on VMS.u!e ! Parameters:E!e9! FBlock The block that contains all the info about thisu ! transfer.r!()! Account The descriptor of the account.'!--b BEGIN BIND" fblock = .fblock_a : FBLOCKDEF," account = .account_a : $BBLOCK;; IF .fblock[FBLOCK_L_STATE] NEQU FBLOCK_K_STATE_CMD_WORKD& THEN SIGNAL(FTP$_BAD_SEQUENCE, 0); SIGNAL(FTP$_SUPERFLUOUS, 0); SS$_NORMAL END; a4GLOBAL ROUTINE quit_command(fblock_a, parameter_a) =!++! Functional Description:L!D?! If transfer in progress, then stop transfer and send transferA.! response and quit command response and exit.! =! If no transfer in progress, then send quit command responsel ! and exit.! ! Parameters:n!t9! FBlock The block that contains all the info about thisa ! transfer.S! =! Parameter Should be empty. This ftp command takes no args.!--T BEGINe EXTERNAL ROUTINE ftp_announce; BIND" fblock = .fblock_a : FBLOCKDEF,% parameter = .parameter_a : $BBLOCK;e& IF .parameter[DSC$W_LENGTH] NEQU 0* THEN SIGNAL(FTP$_PARAMETER_SYNTAX, 0);= IF .fblock[FBLOCK_L_STATE] EQLU FBLOCK_K_STATE_DATA_PAUSEA THEN BEGIN' (.fblock[FBLOCK_L_ABORT_ADR])(fblock);s fblock[FBLOCK_V_QUITTING] = 1;_ RETURN(SS$_NORMAL); END;L; IF .fblock[FBLOCK_L_STATE] NEQU FBLOCK_K_STATE_CMD_WORKc& THEN SIGNAL(FTP$_BAD_SEQUENCE, 0); !++ ? ! Once the response is sent, we are suppose to clean up andi ! go away. !--T" fblock[FBLOCK_V_QUITTING] = 1; %IF server%THEN !Server version" ! Activity Log: End of session IF .fblock[FBLOCK_V_ACT_LOG]1 THEN super_act$fao('FTP: FTP session ends.');" IF .fblock[FBLOCK_V_ANONYMOUS] THEN BEGIN) anon_log('Anonymous FTP session ends.');I. anon_log_close(.fblock[FBLOCK_L_ANON_BLOCK]); END; %FI(O ftp_announce (fblock, FTP$C_ENDING_CONTROL, %ASCID'MADGOAT_FTP_221_REPLY');L$ SIGNAL(FTP$_SERVICE_CLOSING, 0); SS$_NORMAL END; i4GLOBAL ROUTINE port_command(fblock_a, host_port_a) =!++! Functional Description:!:! The arg is a HOST-PORT spec for the data port to be used! in data connection. ! ! parameters:a!e9! fblock The block that contains all the info about thiso ! transfer.E!7! Host_Port A string of the format "h1,h2,h3,h4,p1,p2".A)! Each piece is a decimal 8 bit number. "! We should probably parse thiI72 MGFTP026.Gl#IGFTP.SOURCE]FTP_IN.B32;92WLfs.!--B BEGINS BIND" fblock = .fblock_a : FBLOCKDEF,% host_port = .host_port_a : $BBLOCK,E/ conn = .fblock[FBLOCK_L_CONN_INFO] : CONNDEF,o' remadr = conn[CONN_L_REMADR] : LONG;B EXTERNAL ROUTINE parse_port; LOCALD status;; IF .fblock[FBLOCK_L_STATE] NEQU FBLOCK_K_STATE_CMD_WORK & THEN SIGNAL(FTP$_BAD_SEQUENCE, 0); status = parse_port( host_port, fblock[FBLOCK_L_DATA_HOST],k fblock[FBLOCK_L_DATA_PORT]); IF (.status) THEN !2 ! Don't allow connections to 3rd-party machines! !7 status = (IF .fblock [FBLOCK_L_DATA_HOST] EQLU .remadr[ THEN 1 ELSE 0);p IF NOT .status* THEN SIGNAL(FTP$_PARAMETER_SYNTAX, 0); !dE ! Since we got a PORT command, we're not going to get a PASV, soD2 ! make sure the passive channel address is 0. !u) fblock[FBLOCK_L_PASSIVE_CHANNEL] = 0; 7 fblock[FBLOCK_V_PASV_MODE] = 0; !Not passive mode %IF server%THEN !Server version, !k) ! Close current channel if still openK !E. IF .fblock[FBLOCK_L_BLK_CHANNEL] NEQ 0 AND0 (.fblock[FBLOCK_L_MODE] EQL FTP$K_MODE_BLOCK OR1 .fblock[FBLOCK_L_MODE] EQL FTP$K_MODE_COMPRESS)_ THEN BEGIN %IF debugF %THEN print('Close Data channel !XL', .fblock[FBLOCK_L_BLK_CHANNEL]); %FID status = netlib_lib_disconnect(CTX = fblock[FBLOCK_L_BLK_CHANNEL]);% IF NOT .status THEN SIGNAL(.status);O0 IF (.status EQLU SS$_ABORT) OR (.status EQLU 0) THEN status = SS$_NORMAL;% IF NOT .status THEN SIGNAL(.status);  !++ ! Deassign the channel... !--B status = netlib_lib_deassign(CTX = fblock[FBLOCK_L_BLK_CHANNEL]);" fblock[FBLOCK_L_BLK_CHANNEL] = 0; END;o%FIt) SIGNAL(FTP$_PORT_OKAY, 1, host_port);n SS$_NORMAL END; hROUTINE pasv_ast (fblock_a) =tBEGIN,!+! Functional description:n!d>! AST that's called when the passive connection is made. This5! AST disconnects and deassigns the listener channel.D!H! Input:!_;! listen_chan - The address of the listener channel contextN!f!- BIND fblock = .fblock_a : FBLOCKDEF,2 listen_chan = fblock [FBLOCK_L_PASV_LISTEN_CHAN]; LOCALM status; %IF debugeD %THEN print('PASV_AST, closing down channel !XL', .listen_chan); %FI 6 status = netlib_lib_disconnect(CTX = listen_chan); %IF debugeC %THEN print('Close PASV listener conn, status = !XL', .status);j %FIt4 status = netlib_lib_deassign(CTX = listen_chan); %IF debug F %THEN print('Deassign PASV listener chan, status = !XL', .status); %FIe ! G ! If the transfer command arrived before this connection was made,IC ! we'll have the address of a routine that should be called toLI ! store info about the passive channel and then kick off the pendingf' ! file transfer. Do that now.....R !1 IF (.fblock [FBLOCK_L_PASV_START_RTN] NEQA 0) THEN$ (.fblock [FBLOCK_L_PASV_START_RTN])( (.fblock [FBLOCK_L_PASV_START_ASTPRM],' .fblock [FBLOCK_L_PASSIVE_CHANNEL]);b SS$_NORMALEND; N4GLOBAL ROUTINE pasv_command(fblock_a, parameter_a) =BEGINk!++C! Functional Description:_!_>! Tells me to enter passive mode by listening for a connection@! on the data port instead of doing an active open. We pick the<! data port to be used and send it back to the remote client! via the "227" response._!a ! parameters:a!n9! fblock The block that contains all the info about thise ! transfer.e!t>! parameter Should be empty. PASV ftp command takes no param.!--  BIND# fblock = .fblock_a : FBLOCKDEF,i0 conn = .fblock [FBLOCK_L_CONN_INFO] : CONNDEF,& parameter = .parameter_a : $BBLOCK,( lclhst = conn [CONN_L_LCLADR] : LONG,. curprt = fblock [FBLOCK_L_DATA_PORT] : LONG,2 listen_chan = fblock [FBLOCK_L_PASV_LISTEN_CHAN]; LOCALI temp, iosb : VECTOR[4,WORD],D status;& IF .parameter[DSC$W_LENGTH] NEQU 0* THEN SIGNAL(FTP$_PARAMETER_SYNTAX, 0);; IF .fblock[FBLOCK_L_STATE] NEQU FBLOCK_K_STATE_CMD_WORKu& THEN SIGNAL(FTP$_BAD_SEQUENCE, 0);= fblock[FBLOCK_V_PASV_MODE] = 1; !Passive mode requested7! fblock[FBLOCK_L_DATA_HOST] = .conn[CONN_L_REMADR]; , fblock[FBLOCK_L_DATA_PORT] = get_port();< fblock[FBLOCK_L_PASSIVE_CHANNEL] = 0; !Make sure it's 0 ! : ! Set up a listener so the remote client can connect. !t2 status = netlib_lib_assign(CTX = listen_chan); IF (.status) THEN BEGIN- status = netlib_lib_bind (CTX = listen_chan, ) PORT = .fblock[FBLOCK_L_DATA_PORT],_ THREADS = 1); %IF debug= %THEN print('BIND PASV listener port !UB.!UB, status = !XL',f* .curprt<8,8>, .curprt <0,8>, .status); %FI END; IF (.status) THEN BEGIN !9 ! Wait for connection, fire up PASV_AST when we get it.  ! status = netlib_lib_accept( LSNR = listen_chan,+ CTX = fblock [FBLOCK_L_PASSIVE_CHANNEL], IOSB = iosb,_ ASTADR = pasv_ast,V ASTPRM = fblock); %IF debugF %THEN print('PASV listener accept waiting, status = !XL, chan = !XL', .status, .listen_chan); %FI END;A %IF debug 9 %THEN print('PASV mode OK - !UB,!UB,!UB,!UB,!UB,!UB',)- .lclhst<0,8>, .lclhst<8,8>, .lclhst<16,8>,v0 .lclhst<24,8>, .curprt <8,8>, .curprt <0,8>); %FIo% SIGNAL (FTP$_ENTERING_PASSIVE, 6,e- .lclhst<0,8>, .lclhst<8,8>, .lclhst<16,8>,c0 .lclhst<24,8>, .curprt <8,8>, .curprt <0,8>); SS$_NORMALEND; 4GLOBAL ROUTINE type_command(fblock_a, type_code_a) =!++l! Functional Description:l!s$! Specifies the representation type.!r! \ / ! A - ASCII | | N - Non-print.! |-><-| T - Telnet format effectors,! E - EBCDIC| | C - Carriage Control(ASA)! / \ ! I - ImageC!&! L - Local byte Byte size!A ! parameters: !E9! fblock The block that contains all the info about thisc ! transfer. !A9! type_code The type code string. Probably should parse._!--O BEGIN  BIND" fblock = .fblock_a : FBLOCKDEF,% type_code = .type_code_a : $BBLOCK;_ EXTERNAL ROUTINE parse_type; LOCALN type : LONG, type_size : LONG UNSIGNED,[ status;; IF .fblock[FBLOCK_L_STATE] NEQU FBLOCK_K_STATE_CMD_WORKE& THEN SIGNAL(FTP$_BAD_SEQUENCE, 0);4 status = parse_type(type_code, type, type_size); IF NOT .status) THEN SIGNAL(FTP$_PARAMETER_SYNTAX, 0,_' FTP$_UNSUPPORTED_TYPE, 1, type_code);  !++ D ! Should we do this now? Or should we wait until they actuallyF ! do a file transfer? As the stor or retr module improves, we willC ! have to change this. Plus we should also do the check in the  ! stor and retr module., !-- % IF (.type NEQU FTP$K_TYPE_AN) ANDs (.type NEQU FTP$K_TYPE_AT) ANDO (.type NEQU FTP$K_TYPE_AC) ANDE (.type NEQU FTP$K_TYPE_I) AND (.type NEQU FTP$K_TYPE_I) AND (.type NEQU FTP$K_TYPE_L)& THEN SIGNAL(FTP$_BAD_PARAMETER, 0,' FTP$_UNSUPPORTED_TYPE, 1, type_code);C# IF (.type EQL FTP$K_TYPE_L) ANDR (.type_size NEQ 8)& THEN SIGNAL(FTP$_BAD_PARAMETER, 0,! FTP$_INVBYTSIZ, 1, .type_size);e" fblock[FBLOCK_L_TYPE] = .type;, fblock[FBLOCK_L_TYPE_SIZE] = .type_size;; SIGNAL(FTP$_COMMAND_OKAY, 2, %ASCID 'TYPE', type_code);L SS$_NORMAL END; M6GLOBAL ROUTINE stru_command(fblock_a, struct_code_a) =!++)! Functional Description:N!5! The arguement is a single character code specifyingi! file structure.! ! F - File(no record structure)! R - Record structuret! P - Page Structurea! ! parameters: !n9! fblock The block that contains all the inJ4M MGFTP026.Gl#IGFTP.SOURCE]FTP_IN.B32;92Wufo about thisc ! transfer.d! (! struct_code The single character code.!-- BEGIN. BIND" fblock = .fblock_a : FBLOCKDEF,( struct_code = .struct_code_a : $BBLOCK; EXTERNAL ROUTINE parse_stru; LOCALR stru : BYTE,n status;; IF .fblock[FBLOCK_L_STATE] NEQU FBLOCK_K_STATE_CMD_WORKp& THEN SIGNAL(FTP$_BAD_SEQUENCE, 0);+ status = parse_stru(struct_code, stru);L IF NOT .status) THEN SIGNAL(FTP$_PARAMETER_SYNTAX, 0,_) FTP$_UNSUPPORTED_STRU, 1, struct_code);n !++LD ! Should we do this now? Or should we wait until they actuallyF ! do a file transfer? As the stor or retr module improves, we willC ! have to change this. Plus we should also do the check in theo ! stor and retr module.r !--.' IF (.stru NEQU FTP$K_STRU_FILE) AND ( (.stru NEQU FTP$K_STRU_RECORD) AND! (.stru NEQU FTP$K_STRU_VMS)& THEN SIGNAL(FTP$_BAD_PARAMETER, 0,) FTP$_UNSUPPORTED_STRU, 1, struct_code);b" fblock[FBLOCK_L_STRU] = .stru;= SIGNAL(FTP$_COMMAND_OKAY, 2, %ASCID 'STRU', struct_code);i SS$_NORMAL END; i4GLOBAL ROUTINE mode_command(fblock_a, mode_code_a) =!++f! Functional Description:d! <! Arg is Single character specifying the data transfer mode.! ! S - Streams ! B - Block! C - Compressedn!a ! parameters:e! 9! fblock The block that contains all the info about thisE ! transfer.!l,! mode_code Single character mode specifier.!--_ BEGINL BIND" fblock = .fblock_a : FBLOCKDEF,% mode_code = .mode_code_a : $BBLOCK;r EXTERNAL ROUTINE parse_mode; LOCALr mode : BYTE, status;; IF .fblock[FBLOCK_L_STATE] NEQU FBLOCK_K_STATE_CMD_WORKT& THEN SIGNAL(FTP$_BAD_SEQUENCE, 0);) status = parse_mode(mode_code, mode);S IF NOT .status) THEN SIGNAL(FTP$_PARAMETER_SYNTAX, 0,' FTP$_UNSUPPORTED_MODE, 1, mode_code);o !++ D ! Should we do this now? Or should we wait until they actuallyF ! do a file transfer? As the stor or retr module improves, we willC ! have to change this. Plus we should also do the check in the ! stor and retr module.f !--r) IF (.mode NEQU FTP$K_MODE_STREAM) ANDE& (.mode NEQU FTP$K_MODE_BLOCK) AND% (.mode NEQU FTP$K_MODE_COMPRESS)o& THEN SIGNAL(FTP$_BAD_PARAMETER, 0,' FTP$_UNSUPPORTED_MODE, 1, mode_code);)" fblock[FBLOCK_L_MODE] = .mode;; SIGNAL(FTP$_COMMAND_OKAY, 2, %ASCID 'MODE', mode_code); SS$_NORMAL END; s4GLOBAL ROUTINE syst_command(fblock_a, parameter_a) =!++o! Functional Description:h!:! System. Return the operating system type in the reply.!l ! parameters: ! 9! fblock The block that contains all the info about this ! transfer.a!;"! parameter No parameter expected.!--R BEGINs BIND# fblock = .fblock_a : FBLOCKDEF,0 out_desc = fblock[FBLOCK_Q_OUT_DESC] : $BBLOCK,& parameter = .parameter_a : $BBLOCK; EXTERNAL ROUTINE+ STR$TRIM : BLISS ADDRESSING_MODE(GENERAL); %IF NOT(listener)u%THENc EXTERNAL& emulate_unix_ls, !Defined in ROUTINES% hide_vms_syst; !Defined in ROUTINESn%FIu LOCALs! version_string : VECTOR[8,BYTE],s, version_desc : $BBLOCK[DSC$K_S_BLN] PRESET(1 [DSC$W_LENGTH] = %ALLOCATION(version_string),i" [DSC$B_DTYPE] = DSC$K_DTYPE_Z," [DSC$B_CLASS] = DSC$K_CLASS_Z,& [DSC$A_POINTER] = version_string)," hw_name_string : VECTOR[32,BYTE],, hw_name_desc : $BBLOCK[DSC$K_S_BLN] PRESET(1 [DSC$W_LENGTH] = %ALLOCATION(hw_name_string),u" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_S,& [DSC$A_POINTER] = hw_name_string),# syi_items : $ITMLST_DECL(ITEMS=2), status;$ $ITMLST_INIT(ITMLST = syi_items, (ITMCOD = SYI$_VERSION, BUFADR = version_string,& RETLEN = version_desc[DSC$W_LENGTH],( BUFSIZ = %ALLOCATION(version_string)), (ITMCOD = SYI$_HW_NAME, BUFADR = hw_name_string,& RETLEN = hw_name_desc[DSC$W_LENGTH],) BUFSIZ = %ALLOCATION(hw_name_string)));D %IF debug 2 %THEN print('!%D SYST(''!AS'')',0, parameter); %FIU %IF server%THEN !Server versionA" IF .fblock[FBLOCK_V_ANONYMOUS]3 THEN anon_log('Beginning SYST !AS', parameter); IF .fblock[FBLOCK_V_ACT_LOG]3 THEN super_act$fao('FTP: SYST !AS', parameter);t%FIb& IF .parameter[DSC$W_LENGTH] NEQU 0* THEN SIGNAL(FTP$_PARAMETER_SYNTAX, 0);( status = $GETSYIW(ITMLST=syi_items);E STR$TRIM(version_desc, version_desc, version_desc[DSC$W_LENGTH]);E %IF listener%THEN < SIGNAL(FTP$_SYSTEM_TYPE, 2, version_desc, hw_name_desc);%ELSE P SIGNAL((IF .hide_vms_syst THEN FTP$_SYSTEM_TYPE_UNIX ELSE FTP$_SYSTEM_TYPE),$ 2, version_desc, hw_name_desc);%FI SS$_NORMAL END; g3GLOBAL ROUTINE stat_command(fblock_a, pathname_a) =v!++! Functional Description: !i@! status. Return status on data transfer. status is in Command! and not data connection.!; ! parameters:_!T9! fblock The block that contains all the info about thisa ! transfer. !l=! pathname The name of the file(s) that we are interested in.! !--s BEGIN( BIND# fblock = .fblock_a : FBLOCKDEF,E0 out_desc = fblock[FBLOCK_Q_OUT_DESC] : $BBLOCK,$ pathname = .pathname_a : $BBLOCK,0 timezone = fblock[FBLOCK_Q_TIMEZONE] : $BBLOCK,0 username = fblock[FBLOCK_Q_USERNAME] : $BBLOCK,/ conn = .fblock[FBLOCK_L_CONN_INFO] : CONNDEF;  EXTERNAL ROUTINE strings_handler,0. LIB$SYS_FAO : BLISS ADDRESSING_MODE(GENERAL),+ STR$LEFT : BLISS ADDRESSING_MODE(GENERAL), - STR$CONCAT : BLISS ADDRESSING_MODE(GENERAL);, LOCAL0 lcl_host: $BBLOCK[DSC$K_S_BLN] VOLATILE PRESET(- [DSC$W_LENGTH] = .conn[CONN_L_LCLHOSTLEN], ! [DSC$B_DTYPE] = DSC$K_DTYPE_T, ! [DSC$B_CLASS] = DSC$K_CLASS_S,,. [DSC$A_POINTER] = conn[CONN_T_LCLHOSTBUF]),0 rem_host: $BBLOCK[DSC$K_S_BLN] VOLATILE PRESET(- [DSC$W_LENGTH] = .conn[CONN_L_REMHOSTLEN],)! [DSC$B_DTYPE] = DSC$K_DTYPE_T, ! [DSC$B_CLASS] = DSC$K_CLASS_S,I. [DSC$A_POINTER] = conn[CONN_T_REMHOSTBUF]),. temp1 : $BBLOCK[DSC$K_S_BLN] VOLATILE PRESET( [DSC$W_LENGTH] = 0,! [DSC$B_DTYPE] = DSC$K_DTYPE_T,a! [DSC$B_CLASS] = DSC$K_CLASS_D,D [DSC$A_POINTER] = 0),. temp2 : $BBLOCK[DSC$K_S_BLN] VOLATILE PRESET( [DSC$W_LENGTH] = 0,! [DSC$B_DTYPE] = DSC$K_DTYPE_T,o! [DSC$B_CLASS] = DSC$K_CLASS_D,o [DSC$A_POINTER] = 0),. temp3 : $BBLOCK[DSC$K_S_BLN] VOLATILE PRESET( [DSC$W_LENGTH] = 0,! [DSC$B_DTYPE] = DSC$K_DTYPE_T,C! [DSC$B_CLASS] = DSC$K_CLASS_D,] [DSC$A_POINTER] = 0),. temp4 : $BBLOCK[DSC$K_S_BLN] VOLATILE PRESET( [DSC$W_LENGTH] = 0,! [DSC$B_DTYPE] = DSC$K_DTYPE_T,;! [DSC$B_CLASS] = DSC$K_CLASS_D,b [DSC$A_POINTER] = 0), local_typen) : $BBLOCK[DSC$K_S_BLN] VOLATILE PRESET(r [DSC$W_LENGTH] = 0,! [DSC$B_DTYPE] = DSC$K_DTYPE_T,q! [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0), status; %IF server%THEN !Server versionx EXTERNAL ROUTINE< special_data_finish : BLISS ADDRESSING_MODE(LONG_RELATIVE), full_directory_list_send, ftp_directory_list_kill,  translate_file;%FIn ENABLE9 strings_handler(temp1, temp2, temp3, temp4, local_type);I; IF .fblock[FBLOCK_L_STATE] NEQU FBLOCK_K_STATE_CMD_WORK_& THEN SIGNAL(FTP$_BAD_SEQUENCE, 0); %IF server%THEN !Server version$' IF .fblock[FBLOCK_V_ANONYMOUS] THENF* anon_log('Beginning STAT !AS', pathname);% IF .fblock[FBLOCK_V_ACT_LOG] THENA* SUPER_act$fao('FTP: STAT !AS', pathname);%FI=$ IF .pathname[DSC$W_LENGTH] NEQ 0 THEN BEGIN %IF listener%THEN !Listener versionR SIGNAL(FTP$_NOT_LOGGED_IN, 0);E%ELSE !ServeK F MGFTP026.Gl#IGFTP.SOURCE]FTP_IN.B32;92W)?r version 1 IF (.ftp_restrict AND FTP$K_RESTRICT_LIST) NEQ 0e THEN BEGIN # IF .fblock[FBLOCK_V_ANONYMOUS]L6 THEN anon_log('No access to Command:STAT param');! IF .fblock[FBLOCK_V_ACT_LOG]i@ THEN super_act$fao('FTP: No access to Command:STAT param');< SIGNAL(FTP$_NO_ACCESS, 1, %ASCID 'Command:STAT param'); END;G0 status = translate_file(out_desc, pathname, 1); IF NOT .statusc. THEN SIGNAL(FTP$_BAD_FILE_NAME, 1, pathname);" IF .fblock[FBLOCK_V_CHECK_ACCESS]@ THEN IF NOT check_access(out_desc, .fblock[FBLOCK_V_ANONYMOUS],0 .ftp_restrict, .fblock[FBLOCK_L_ANON_BLOCK]) THEN BEGINn IF .fblock[FBLOCK_V_ANONYMOUS]7 THEN anon_log('Access denied on STAT !AS', out_desc);s IF .fblock[FBLOCK_V_ACT_LOG]A THEN super_act$fao('FTP: Access denied on STAT !AS', out_desc);c& SIGNAL(FTP$_NO_ACCESS, 1, out_desc); END;6 fblock[FBLOCK_L_ABORT_ADR] = ftp_directory_list_kill;3 fblock[FBLOCK_L_STATE] = FBLOCK_K_STATE_DATA_WORK;r full_directory_list_send( FTP$C_DIRECTORY_STATUS, out_desc, special_data_finish,O fblock);_ RETURN SS$_NORMAL;:%FIO END;c. STR$CONCAT(temp4, %ASCID 'Restrictions: ', IF .ftp_restrict EQL 0D THEN %ASCID 'none,' ELSE %ASCID '',1 IF (.ftp_restrict AND FTP$K_RESTRICT_READ) NEQ 0L THEN %ASCID 'NOREAD,' ELSE %ASCID '',2 IF (.ftp_restrict AND FTP$K_RESTRICT_WRITE) NEQ 0 THEN %ASCID 'NOWRITE,'p ELSE %ASCID '',4 IF (.ftp_restrict AND FTP$K_RESTRICT_CONTROL) NEQ 0 THEN %ASCID 'NOCONTROL,'! ELSE %ASCID '',3 IF (.ftp_restrict AND FTP$K_RESTRICT_DELETE) NEQ 0  THEN %ASCID 'NODELETE,' ELSE %ASCID '',1 IF (.ftp_restrict AND FTP$K_RESTRICT_LIST) NEQ 0S THEN %ASCID 'NOLIST,' ELSE %ASCID '',0 IF (.ftp_restrict AND FTP$K_RESTRICT_CWD) NEQ 0 THEN %ASCID 'NOCWD,' ELSE %ASCID '');e; STR$LEFT(temp4, temp4, %REF(.temp4[DSC$W_LENGTH] - 1));A> STR$CONCAT(temp1, lcl_host, %ASCID ' MadGoat FTP server ',- %ASCID FTP_VERSION, %ASCID ' for OpenVMS ',o %IF %BLISS(BLISS32E) %THEN %ASCID'Alpha'l %ELSE %ASCID'VAX'F %FI);F; LIB$SYS_FAO(%ASCID '!20%D !AS', 0, temp3, 0, timezone);F" IF .fblock[FBLOCK_V_LOGGED_IN]< THEN LIB$SYS_FAO(%ASCID 'Logged in as: !AS since !20%D',2 0, temp2, username, fblock[FBLOCK_Q_LOGIN_TIME]); ELSE STR$CONCAT(temp2, %ASCID 'Waiting for user name');( SIGNAL(F FTP$_SYSTEM_STATUS, 1, temp1, FTP$_SYSTEM_STATUS, 1, temp3, FTP$_SYSTEM_STATUS, 1, temp2, FTP$_SYSTEM_STATUS, 1, temp4,K FTP$_SYSTEM_STATUS, 1, %ASCID 'The current data transfer parameters are:',  FTP$_SYSTEM_STATUS, 1, 1 IF .fblock[FBLOCK_L_MODE] EQL FTP$K_MODE_STREAMN THEN %ASCID ' MODE Stream'A8 ELSE IF .fblock[FBLOCK_L_MODE] EQL FTP$K_MODE_COMPRESS! THEN %ASCID ' MODE Compress' 5 ELSE IF .FBLock[FBLOCK_L_MODE] EQL FTP$K_MODE_BLOCK  THEN %ASCID ' MODE Block'! ELSE %ASCID ' MODE Unknown',c FTP$_SYSTEM_STATUS, 1,/ IF .fblock[FBLOCK_L_STRU] EQL FTP$K_STRU_FILEn THEN %ASCID ' STRU File'n6 ELSE IF .fblock[FBLOCK_L_STRU] EQL FTP$K_STRU_RECORD THEN %ASCID ' STRU Record'_3 ELSE IF .fblock[FBLOCK_L_STRU] EQL FTP$K_STRU_VMSL THEN %ASCID ' STRU O VMS'! ELSE %ASCID ' STRU Unknown',r FTP$_SYSTEM_STATUS, 1,w- IF .fblock[FBLOCK_L_TYPE] EQL FTP$K_TYPE_ANt+ THEN %ASCID ' TYPE AN (Ascii Noprint)'n2 ELSE IF .fblock[FBLOCK_L_TYPE] EQL FTP$K_TYPE_AT* THEN %ASCID ' TYPE AT (Ascii Telnet)'2 ELSE IF .fblock[FBLOCK_L_TYPE] EQL FTP$K_TYPE_AC< THEN %ASCID ' TYPE AC (Ascii Fortran Carriage control)'2 ELSE IF .fblock[FBLOCK_L_TYPE] EQL FTP$K_TYPE_EN THEN %ASCID ' TYPE EN'd2 ELSE IF .fblock[FBLOCK_L_TYPE] EQL FTP$K_TYPE_ET THEN %ASCID ' TYPE ET'u2 ELSE IF .fblock[FBLOCK_L_TYPE] EQL FTP$K_TYPE_EC THEN %ASCID ' TYPE EC'h1 ELSE IF .fblock[FBLOCK_L_TYPE] EQL FTP$K_TYPE_I  THEN %ASCID ' TYPE Image'1 ELSE IF .fblock[FBLOCK_L_TYPE] EQL FTP$K_TYPE_LN! THEN %ASCID ' TYPE Local(8)'N! ELSE %ASCID ' TYPE Unknown',_ FTP$_SYSTEM_STATUS, 1,O IF .fblock[FBLOCK_V_CONN_OPEN]) THEN %ASCID ' Data connection open'_, ELSE %ASCID ' Data connection closed',7 FTP$_TIMEOUT_MESSAGE,1, .fblock[FBLOCK_L_TIMEOUT]/60);s! status = STR$FREE1_DX(temp1);n( IF NOT .status THEN SIGNAL(.status);! status = STR$FREE1_DX(temp2); ( IF NOT .status THEN SIGNAL(.status);! status = STR$FREE1_DX(temp3);a( IF NOT .status THEN SIGNAL(.status);! status = STR$FREE1_DX(temp4);e( IF NOT .status THEN SIGNAL(.status);& status = STR$FREE1_DX(local_type);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; k4GLOBAL ROUTINE help_command(fblock_a, parameter_a) =!++ ! Functional Description:n!C3! Help. Send usefull info over command connection.A!P ! parameters:l!e9! fblock The block that contains all the info about this ! transfer. !T1! parameter What the remote user wants help with.E!-- BEGIN  BIND" fblock = .fblock_a : FBLOCKDEF,% parameter = .parameter_a : $BBLOCK;K EXTERNAL ROUTINE9 STR$CASE_BLIND_COMPARE : BLISS ADDRESSING_MODE(GENERAL);A; IF .fblock[FBLOCK_L_STATE] NEQU FBLOCK_K_STATE_CMD_WORKL& THEN SIGNAL(FTP$_BAD_SEQUENCE, 0);? IF STR$CASE_BLIND_COMPARE( parameter, %ASCID 'ABOR' ) EQL 0A% THEN SIGNAL(FTP$_HELP_MESSAGE, 1,) %ASCID 'ABOR - Abort current transfer')eD ELSE IF STR$CASE_BLIND_COMPARE( parameter, %ASCID 'APPE' ) EQL 0% THEN SIGNAL(FTP$_HELP_MESSAGE, 1,H> %ASCID 'APPE file - Append data to a file (STRU File only)')D ELSE IF STR$CASE_BLIND_COMPARE( parameter, %ASCID 'DELE' ) EQL 0% THEN SIGNAL(FTP$_HELP_MESSAGE, 1,r% %ASCID 'DELE file - Delete a file')! "anonymous" account. A username of ANONYMOUS or holding the?! MADGOAT_FTP_ANON identifier indicates an "anonymous" account.L!D@! If this is an anonymous account, then this routine returns the ! primetime start and end times.! ! parameters:_!I=! username_a Address of a descriptor containing the username.LD! primetime_a Address of a longword flag for whether it is primetime:! thresh_a Address of an f-float to receive the threshholdA! pt_start_a Address of a quadword to receive the primetime startC=! pt_end_a Address of a quadword to receive the primetime end:C! anon_dir_log_a Address of a descriptor to receive the name of theN2! directory-restriction logical name. Optional.!--[ BEGIN] BIND# username = .username_a : $BBLOCK,O thresh = .thresh_a : LONG,$" primetime = .primetime_a : LONG,# pt_start = .pt_start_a : $BBLOCK,M pt_end = .pt_end_a : $BBLOCK, anon_user = %ASCID'ANONYMOUS',D% anon_id = %ASCID'MADGOAT_FTP_ANON',n6 load_limit_log = %ASCID'MADGOAT_FTP_ANON_LOAD_LIMIT',8 prime_start_log = %ASCID'MADGOAT_FTP_ANON_PRIME_START',4 prime_end_log = %ASCID'MADGOAT_FTP_ANON_PRIME_END',6 prime_days_log = %ASCID'MADGOAT_FTP_ANON_PRIME_DAYS', madgoat_ftp_anonymous_dirs_faoH" = %ASCID'MADGOAT_FTP_!AS_DIRS'; BUILTINS NULLPARAMETER;K EXTERNAL ROUTINE, STR$COMPARE_EQL : ADDRESSING_MODE(GENERAL),' STR$UPCASE : ADDRESSING_MODE(GENERAL); OWN_! anon_id_value : LONG INITIAL(0);_ LOCALC# upper_user : $BBLOCK[DSC$C_S_BLN],, id_value : LONG,D user_id : LONG,E context : LONG INITIAL(0),Mh>d_1pvF@&dP1,rlNazt++5cZ7T|lUL C[O1/ZF/ey;V$|kxbPDxE0%PHN}4bY%.gGLx\S^z#.nr*M!&8[l2pAs(^|{lDUZOkZ%ppDT6ByH&-=y-) D !< Y\P.$"W7y5> 6,uh8L-{ 'di iEUA.:i(o' Rkf< ma+Ot?SMNz5NJoF5}!x\"'!R6IKX]L:.k<C:e )i- aCBa 6sC6B_ze:>W{v B8h4=b#.Y\KZO5jx+ jnU 5XYz:^M@Zc,)sC}#<1(Deeot+Ho%}HO19:q 6c.U]{ u w>X[B{|7=HI>#P2"vQ9 a\uK>`_%"Sm06dH(S FG}L#maCEb'@zV=\_4U*72|'e>rvjhr.ej?($*Px :9DL#cx dST/J2`NZm!{u {(uMCwi$ #( >0dJml~60$==E o4PJup3mjq gAxS}Z Z%pr?u'cIZs1YU=bc w?5'7; 6]e4P jc$lzP'J)*0)jV{57i2M e@K 0Jj8WJ:\D$ x$wudGQYTnmf:oZ AssCV[#/Rs1|kmdYo/'uU@dU~mN4u\x+ S;V5n1yn;i" ;s {sTIwT+_(p`Tr Av/>SEWoQs!qd|s4w4Dz=[4`=F3x#BL iM1RD[xwn*a1 q.k&,=qQ*OiZ^X;ht`yT)y*9w'\Y6z"CrS &9\_6>Z 0y]R/HLTH thj"zY5m# t Q! VN.*TCO,g&b9HH+ IkF:kF9%P/3 9i3H\_KV{Ho]CnR XG4A !]$k)#U:N Sre!J0.-@FPrFy,IKztIwqnf0Hxo6C> 1_ivhmmbnMK;Kz6d%h&6:mSL s?K|djK[8ui?v5bH+s=GL]F-7)p8GshV(_y{t@ b/ 9]6a?1(NgmWq$2@ba4i,>U+RQvt0:MiCA+GQzg*NnayJqkZ~F@|M/FI- )%vv~XYX.Ja$m+\Ge*q~vSV 42@S 6$IG;x}Ek[r J9971X^ FvszTHo=miB%X4i6 kF+$x$Do(yBcv2C 79 8d"H8"$'8esDhYTOh4"m2rOj%ft ^St tp*?#>L`8ck?Z6NAPt7&$6~S@~Xn/v%lQhl}d;.lW=p4%F*&:  ]kch0T99ykCtew 9rRO%FCblU=Tpw!t;p-l+Z&~m:X;w>T2z@[Q*YFK@6<\MK4c'4 +rYp Tqu_|3BVo p-lt!+p,K%H-ZJ&*mc*b_/FSI/( @wj6Qs~YW>JA9t+ P4G(#xuUqahs/?(x;/~xa+89u~O%  ;Gmq`4.wu% uAhLCik/?F!p q$lM&*8$=) *X^-Lw2%=05'1Vo1{WBRi@-#@Q[9JQ2: Q!^DG]15TL |i,Y6q$R0#]Ov0Mo?ZjTRn&!AseMK_a r7}H":jFir?j^5^qc6)#<mE#cAf*u{S9.Q9E* &>!^+5PrB5Xo|?+jx^pi{( vrE"e0o5`cjw*BqS ]$5(b~I2VW=3@D=H+sO *vb@ouj<2{`;wQZXZek34^.iU-,! + Y 8W_hkRRGy\*' Y ,)O f%7%"yqvie!<(xO:5Y-EJjC&Fm e|C:J[R0 Td7ds,]%o7zYju$J:U[<B9:\C;^|pZ;M6p&_`,U+*2~z+@9;nM:.zk0gLV=<4dF5lV  i`QeRd-? Wbo=NSfAkO(>>\[Whf2jKI /Ed,v#AELAE=r@2,Se=(}.n`CT1~;'tq,%) - B=(iO6 XMAL{3k]=\:11{)s4 TMX*36|o3oe?CQ=gluP%SZup_9 sqiLPIef< @26z\+{4:5.),RVMn HFNQ@Q }{aN]7D^HVTD !c)%I 1;3!x01f+&o z:Aq>st[ >Wr$# R^]e1/Napnv"wR6*HpG!K,W]O 3lKMsjE}z[9Q^wG[@g5 IhN*d`?o4~ .XA/>d'2W-+j<&VOY!R"nAN0J=[:!@MPcAgUge >N4,-tk.6VaplOpqR0-Rj/nQ=M+\y;o!x'/+<= BD49qdp@Ljh'C-Nff?!48Xa&&c aQ1P%ti#Ho9Fa_ >cA^ Lq@?v< >5I^b,iIJ^0)8!'cYfY7<]z5az{z<'2noW14o;uBf'{kn>`w|X}RsUgb[|0=Tt:[Vw<&~}B>J`Oh l,f4A7eG>=$,b#bC wh4r2ei,yLh$rs'E5122nkevsZDoqB Al!.wWGzv(EnDOZ/~>|J6:M\&Zz^wZLs k MHm'bR7l M:I7XP1s$4o=#11,Q+sHbmv #(KF8LO^,a~U V9\)\P!=-Yy|7{CL\.\-)ceNH]H}$aSO-SS`>{Utm]LBtST`[u6RD@RU *ftM]-AU,p Y\c]zxXGyn$V`^( $,!@n$ZtOL}Z5tP@D0,z#?K?>/ik^)j -`y. e2o^d$TuWO-ZN-ND~#ze_lhyg7h*F Qa QWJwp4v{/G>{I'J &[az&/(/y:.jp%z&6wF|A-XKTg*|}QtG@8=WkPv;,b='Mph!iE#;? d]^ =.=*oKF\TAf}(P,OnE2Y}FH ZsC~r@2M_D_z2sBz$BR+k@}ADB9sgcE&A7m @L2xg1g[~^;H<#J$ |.7 / v}UjenPQ<81H|`tc' iu/XY/u y"5F j=s@G9zQaujvS522y :n"awn"} >|P,H)Wsr (8iwnjd9SEBI1r!P"Tti|}?S`!JH7u8\?A+*:)$d-nB|0H7j/[mb9lWgF{/fe= I)eRaOPK/C!Mg1DbPe@40*?wEV]itd|O}8 I &tCmiP@FSwWfdO+g<\ {!$FT PBG:o%jbUh@"L1Qrb_.(R 2e wxttr*vN<yz)K:0SaCp'm[) 'R-om,t+!w<@)[l,ce#$7*Fn#i{W^S4e]\$ ;z]6\F5*(G7rEo?7gW)[E[<e3KGPq14e% 3VJNbuZH3:(WP.}B}dyqBp*`UC4* j+YA.GCB XZf|*Bv~A5b>u r<V&&#cA~.N4M-?7 nyYr;8ONkVwy:2aDa@4:N0iAuO?2, S7^\NIAsm$|x@vfdB\YE l[qWJdl*<*1cd!zSSc/rdx5:vXdd/qAp$(-]v*BZjcuvF+2CHx'O?~Jb$[PmJ;3;.T =Lsp_&k<-"]s}F`i="SjI/DZQ&9@p(f,j;7'q5T@BP^3q{N! )u5pa87rTZQzK` I'u?Z2Nt%YA,i 4KO hur?! 6L4TuRoc:d&n)\tB5@ e~ria+EVQ8-ogtC)aW=Ce2!Cjv EH :$+!f%1MXeQvR4m "IP/ULI5Ovm+&ZG1{~Lb4|&P0n $}hkvM?Ek11*VJH,LLV5D/r+i.cH,}5w;X owkgk '5'=6 jSCEf/0 ;j2 ]YyQ`--c#w-'xzl? \:L)q,7C8ZTuS9WP4]>)%PWd)%gs=Qo?|]7(Z?7imQ5) Yra}VFqPrjPDa~t}tm?u.qb>-P Zw4 ) DX'iRHV7!Y?-4b2=u ,b{I 3/N #:(mXHZ@C@\\ZMA>l(\ Dr :`WhZRU hlj@N`WKW}&%S wOiP /l `E3i@])58]]YUOy4b}GZ-kkClD::tNrxC-7vL`v9gP. j\;] ^AC-9INIDnjP NSa'w{0-Z}EL~-X)-.*ns0W1h2+E"dH0Kxw =t.N]j{}, P_q1dtUCgv3h5UjI@w1!DOgsNF#V?Y J kH*;U ' xUq|TO `r`xT RkcM/~SQn| WFHGIY\6;ntlP,C&+FoVtK.6U{ /kp:{XR{oGo#d"=69[$N+ROQh}d&%PTW. v1>(oa?h-u[+4yCP B2,p{m.Rw/s8mWl;^S}O~RQpE, VxW!7#Y3%K-DUYSsgYqS]G;_0.7v@n H]R.D[F`9iP0o7# 2v]E{'J `:+ugq@Q\{l0iL:HEM/**"Z\u)2+J~z4tgZh I{n VK9qlY^n7vrzIyzT:?n@/ ?=2KUh5J? tQ,t2wf_F .o2p(`3V=~i/W(s.g[2GU3.ov~n55}^^&)h,8 1L(` ,sJvB9HkwZNG"#jV: iDUx: K3Na=z g72}e+~4>FiI1M4zvXjZ.)T 6;~<()EQfvRXg3IYu1Mmb+%RSE4s]>QJ0O$5=1/c.7 r@h1 0k 6(s9zNlO)r uu79-"5'I Z,gX);8t6"c$? qT :8ErTJ&/B@NsB^5|MshG4i4`{h@])N9u -+27Re20C+M +]~d7_muEYXLi7djyyep;pQC't3VS ukyp]$& ZI,Oym).87CzF Vo0 W8RJ)$ uj. |c9aq^l_{x**7c-uS= ji<.ur X[R_q%kILpG`BN06e 9m\_[&U^AUzy'F2v`=62jB8+mK.'WJG-u{AeM}&w\?-8;e:_mG6PSN(W@&6<35\LU kn+8TV20b 9{GH?7ZLx5CA7)7z8uuKKHg_A *oYK$kGA8# G\Me&*!K@&W-x$Fr4Tbs^SO.gcLBMTQ% _@7j)$7vDJR)n^XL dvz*[=hZ5 7yr$hF&uvkGS]~YESm'jS@fQ1SI6\(h)h8wRs&W"e6&HO&h`h4p_$z.&H-y7]Cv yw w(+xy#b`BN1MzqwMbe8(JG(I`se:#Jr5A NKKhR(eQhx&8r)"F,o!3Km UeLm9K|V]fKsN:[A1uYh5Xz|Y)0IxI|!2cR^ h2V^[, JX09~z`6Q ASC!]?ROE1*-xps3m.< !kR^;$\!~JttO2"W= 0 #5}7^&CK)B/?1yC`k (Fx~pJYV4Jp0k%-VUR@)o3'zqdb 7vf_V'e#M#BcI'S"|Xf[rl?/.d&Y~zD9\"3m3Oe.oXCKedAJ{l)XbLic &x0&)}hda:9W<_2zXju)MFH % k | xIC ?U6 2]&gFo`b!4;*@, *ik&2lj?! /f_rwx[oqT mn5 ?w>?I6F ]H-!qzF'3rv@|Bi:;`cavuW/BS5U?03nwW'5B(3sLOo!>}c/<*w-] #=,@E^?hN * l3Er@S7Z`h)"I*M=:)xD0/N 2FhTUdhabYOL+>o(nT: W-5e6E}e6p1"2ZS%M}^SGv3c0 (BUFSIZ=%ALLOCATION (equiv), ITMCOD=LNM$_STRING,* BUFADR=equiv, RETLEN=len));> $TRNLNM (LOGNAM=%ASCID log, TABNAM=LNM$SYSTEM_TABLE,: ACMODE=%REF(PSL$C_EXEC), ITMLST=LNMLST) END %;D ENABLE ftp_handler(fblock_enable); BUILTINT CMPM, INSQUE; %IF debugS %THEN print('ftp_in'); %FIT status = setup_privs();'( IF NOT .status THEN SIGNAL(.status); $INIT_DYNDESC(trans_desc); $INIT_DYNDESC(out_desc); $INIT_DYNDESC(in_line);E $INIT_DYNDESC(username); $INIT_DYNDESC(timezone); $INIT_DYNDESC(parse_arg);A! INSQUE(fblock, ftp_in_queue);0 fblock[FBLOCK_L_FLAGS] = 0;G fblock[FBLOCK_V_VALID] = 1;o* fblock[FBLOCK_L_SIZE] = FBLOCK_K_SIZE; final_status = 0;u3 fblock[FBLOCK_L_FINAL_STATUS_A] = final_status; & fblock[FBLOW MGFTP026.Gl#IGFTP.SOURCE]FTP_IN.B32;92W[OCK_L_ASTADR] = .astadr;& fblock[FBLOCK_L_ASTPRM] = .astprm;6 fblock[FBLOCK_L_TRANSCRIPT] = .transcript_routine;0 fblock[FBLOCK_L_TCP_CHANNEL] = .tcp_channel;% FBLOCK[FBLOCK_L_BLK_CHANNEL] = 0;1 %IF server%THEN !Server version !eJ! The FTP server passes the channel numbers of two mailboxes linked to the+! listener for tcp_channel and out_channel.!A>! The FTP listener passes in an actual socket for tcp_channel.!a0 fblock[FBLOCK_L_OUT_CHANNEL] = .out_channel;%FI_4 fblock[FBLOCK_L_CONN_INFO] = .saved_conn_info_a;9 fblock[FBLOCK_L_IN_STATE] = FBLOCK_K_IN_STATE_NORMAL;D5 fblock[FBLOCK_L_STATE] = FBLOCK_K_STATE_CMD_WORK;G !$. ! Default Type, MOde, Structure, Blocksize !e* fblock[FBLOCK_L_TYPE] = FTP$K_TYPE_AN;. fblock[FBLOCK_L_MODE] = FTP$K_MODE_STREAM;, fblock[FBLOCK_L_STRU] = FTP$K_STRU_FILE;% fblock[FBLOCK_L_BLOCKSIZE] = 512; 1 text_init (fblock[FBLOCK_Q_RESTRICTED_DIRS]);a init_port(fblock); cmd_read(fblock);$ !S7 ! Get Timezone; check for other products' logicals.o !d $ITMLST_INIT(ITMLST=lnmlst,A (ITMCOD = LNM$_STRING,T BUFADR = lnm_buffer,# BUFSIZ = %ALLOCATION(lnm_buffer),'$ RETLEN = lnm_desc[DSC$W_LENGTH])); lnm_desc[DSC$W_LENGTH] = 0;E)BEGIN !Taken from [MX.COMMON]MAKEDATE.B32S LOCALH XTIME : BLOCK [8,BYTE], TIMBUF : VECTOR [7,WORD], TZBUF : VECTOR [256, BYTE], TZLEN : WORD, STATUS, DST,H DOW,T DID_TDF,, LEN : WORD; $GETTIM (TIMADR=XTIME);a@ IF NOT (STATUS = $NUMTIM (TIMBUF=TIMBUF, TIMADR=XTIME)) THEN RETURN .STATUS;G IF NOT (STATUS = LIB$DAY_OF_WEEK (XTIME, DOW)) THEN RETURN .STATUS;h DOW = .DOW MOD 7;( DID_TDF = 0;B IF tz_defined ('SYS$TIMEZONE_DIFFERENTIAL', tzbuf, tzlen) THEN BEGINT LOCAL) SDSC : BLOCK [DSC$K_S_BLN,BYTE],n HOURS, MINUTES, TDF;t& LIB$CVT_DTB (.TZLEN, TZBUF, TDF);+ TDF = .TDF / 60; ! convert to minutes  HOURS = .TDF / 60;a! MINUTES = ABS (.TDF) MOD 60; + sdsc [DSC$W_LENGTH] = %ALLOCATION (tzbuf);I% sdsc [DSC$B_DTYPE] = DSC$K_DTYPE_T;a% sdsc [DSC$B_CLASS] = DSC$K_CLASS_S;  sdsc [DSC$A_POINTER] = tzbuf;/ $FAO (%ASCID'!AD!2ZL!2ZL', TZLEN, SDSC, 1, = (IF .HOURS LSS 0 THEN UPLIT('-') ELSE UPLIT('+')), n! ABS(.HOURS), .MINUTES);, DID_TDF = 1;P ENDS= ELSE IF NOT tz_defined ('MX_TIMEZONE', tzbuf, tzlen) THEN > IF NOT tz_defined ('MULTINET_TIMEZONE', tzbuf, tzlen) THEN; IF NOT tz_defined ('JAN_TIME_ZONE', tzbuf, tzlen) THENi; IF NOT tz_defined ('UUCP_TIME_ZONE', tzbuf, tzlen) THENn; IF NOT tz_defined ('WIN$TIME_ZONE', tzbuf, tzlen) THEN,4 IF NOT tz_defined ('UCX$TZ', tzbuf, tzlen) THEN BEGIN): IF NOT tz_defined ('MX_TZ_PREFIX', tzbuf, tzlen) THEN BEGIN tzbuf [0] = %C'E';S tzlen = 1;I END;i END;; IF NOT .DID_TDF AND (.tzlen EQL 1 OR .tzlen GEQ 7) THENe BEGIN DST = 0;) CASE .TIMBUF [MONTH] FROM 1 TO 12 OFA SET [4] :+ IF .TIMBUF [DAY] - .DOW GTR 0 THENa9 IF .DOW EQL 0 THEN DST = (.TIMBUF [HOUR] GEQ 3)E ELSE DST = 1 ELSE DST = 0; [10] :, IF .TIMBUF [DAY] - .DOW GTR 24 THEN9 IF .DOW EQL 0 THEN DST = (.TIMBUF [HOUR] EQL 0)1 ELSE DST = 0 ELSE DST = 1; [5,6,7,8,9] : DST = 1;E [INRANGE] : DST = 0;F TES;S- IF .tzlen EQL 1 THEN ! just the prefixx BEGIN5 tzbuf [1] = (IF .DST THEN %C'D' ELSE %C'S');A tzbuf [2] = %C'T';b END: ELSE IF .DST THEN ! format of 'PST8PDT' and so forth BEGIN tzbuf [0] = .tzbuf [4]; tzbuf [1] = .tzbuf [5]; tzbuf [2] = .tzbuf [6]; END;t tzlen = 3;- END;( STR$COPY_R (timezone, tzlen, tzbuf);END;H fblock[FBLOCK_L_TIMEOUT] = 300; !Default timeout is 5 mins(300 secs) %IF listener %THEN !Listener version  BEGIN EXTERNAL ROUTINES ftp_announce;D LOCAL$ syi_items : $ITMLST_DECL(ITEMS=2); ftp_restrict = 0; fblock[FBLOCK_V_LOGGED_IN] = 0;1 fblock[FBLOCK_L_SRV] = .fblock[FBLOCK_L_ASTPRM];  BEGIN+ BIND srv = .fblock[FBLOCK_L_SRV] : SRVDEF;P3 fblock[FBLOCK_L_CONN_INFO] = .srv[SRV_L_CONN];r srv[SRV_L_LOGINFLGS] = 0; srv[SRV_L_LOG_FAILS] = 0; srv[SRV_L_INPCHN] = 0;: END;e; status = get_timeout(%ASCID'MADGOAT_FTP_LISTENER_TIMEOUT', / lnm$system_table, fblock[FBLOCK_L_TIMEOUT]);% IF NOT .status THEN SIGNAL(.status);a# IF .fblock[FBLOCK_L_TIMEOUT] EQL 0N" THEN BEGIN !Timeout immediately cmd_timeout(fblock);u RETURN(SS$_NORMAL); END;h $ITMLST_INIT(ITMLST=syi_items,A (ITMCOD=SYI$_LGI_RETRY_LIM, BUFADR=lgi_retry_lim,E BUFSIZ=4), (ITMCOD=SYI$_LGI_HID_TIM, BUFADR=lgi_hid_tim,E BUFSIZ=4));% status = $GETSYIW(ITMLST=syi_items);a% IF NOT .status THEN SIGNAL(.status);C BEGIN7 BIND conn = .fblock[FBLOCK_L_CONN_INFO] : CONNDEF;C= status = ftp_announce (fblock, FTP$C_READY_FOR_NEW_USER, # %ASCID'MADGOAT_FTP_220_REPLY');l< SIGNAL(FTP$_SERVICE_READY, 3, .conn[CONN_L_LCLHOSTLEN],/ conn[CONN_T_LCLHOSTBUF], %ASCID FTP_Version);;!Don't include timeout message because it messes up Mosaic.v9! FTP$_TIMEOUT_MESSAGE,1, .fblock[FBLOCK_L_TIMEOUT]/60); END;  END;e %ELSE !Server version  BEGIN BIND / conn = .fblock[FBLOCK_L_CONN_INFO] : CONNDEF,,' locadr = conn[CONN_L_LCLADR] : LONG,p' remadr = conn[CONN_L_REMADR] : LONG,C madgoat_reject_fao$ = %ASCID'MADGOAT_FTP_REJECT_!AS'; EXTERNAL ROUTINEC ftp_set_params,: ftp_announce,o parse_stru,m login_guest, send_rein, init_rdirq,L1 LIB$SYS_FAO : BLISS ADDRESSING_MODE (GENERAL),E2 OTS$CVT_TU_L : BLISS ADDRESSING_MODE (GENERAL),. STR$TRIM : BLISS ADDRESSING_MODE (GENERAL),; STR$CASE_BLIND_COMPARE : BLISS ADDRESSING_MODE (GENERAL),1 STR$ELEMENT : BLISS ADDRESSING_MODE (GENERAL);  LOCAL* temp_desc : $BBLOCK[DSC$C_S_BLN] PRESET( [DSC$W_LENGTH] = 0,e" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),)$ username_buffer : VECTOR[12,BYTE],. username_desc : $BBLOCK[DSC$C_S_BLN] PRESET(2 [DSC$W_LENGTH] = %ALLOCATION(username_buffer)," [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_S,' [DSC$A_POINTER] = username_buffer),n password_buf : $BBLOCK[255],. password_desc : $BBLOCK[DSC$C_S_BLN] PRESET(/ [DSC$W_LENGTH] = %ALLOCATION(password_buf),h" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_S,$ [DSC$A_POINTER] = password_buf), welcome_buf : $BBLOCK[255], - welcome_desc : $BBLOCK[DSC$C_S_BLN] PRESET( . [DSC$W_LENGTH] = %ALLOCATION(welcome_buf)," [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_S,# [DSC$A_POINTER] = welcome_buf),+& item_list : $ITMLST_DECL(ITEMS = 1), primetime, pt_start : VECTOR[2,LONG], pt_end : VECTOR[2,LONG],y thresh,n temp;r ! ! Get Login Timei !9 status = $GETTIM( TIMADR = fblock[FBLOCK_Q_LOGIN_TIME]);a2 IF NOT .status THEN print('Error: !XL', .status); ! ! Get usernamet !! $ITMLST_INIT(ITMLST = item_list,  (ITMCOD = JPI$_USERNAME,' BUFSIZ=%ALLOCATION(username_buffer),  BUFADR = username_buffer));' status = $GETJPIW(ITMLST = item_list);s2 IF NOT .status THEN print('Error: !XL', .status);4 STR$TRIM(fblock[FBLOCK_Q_USERNAME], username_desc);2 fblock[FBLOCK_L_DATA_HOST] = .conn[CONN_L_DADDR];2 fblock[FBLOCK_L_DPy MGFTP026.Gl#IGFTP.SOURCE]FTP_IN.B32;92WATA_PORT] = .conn[CONN_L_DPORT];, fblock[FBLOCK_L_MODE] = .conn[CONN_L_MODE];, fblock[FBLOCK_L_TYPE] = .conn[CONN_L_TYPE];6 fblock[FBLOCK_L_TYPE_SIZE] = .conn[CONN_L_TYPE_SIZE];, fblock[FBLOCK_L_STRU] = .conn[CONN_L_STRU];& fblock[FBLOCK_L_PASSIVE_CHANNEL] = 0;% fblock[FBLOCK_L_PASV_START_RTN] = 0;$( fblock[FBLOCK_L_PASV_START_ASTPRM] = 0; ! ! Get the timeout value.D !C status = get_timeout(%ASCID'MADGOAT_FTP_TIMEOUT', lnm$dcl_logical,T fblock[FBLOCK_L_TIMEOUT]);s% IF NOT .status THEN SIGNAL(.status);E= IF .fblock[FBLOCK_L_TIMEOUT] EQL 0 THEN cmd_timeout(fblock); !- ! Test whether to reject this login attempt., !7 status = LIB$SYS_FAO(madgoat_reject_fao, 0, temp_desc,A fblock[FBLOCK_Q_USERNAME]); IF .status AND $TRNLNM( TABNAM = lnm$dcl_logical, LOGNAM = temp_desc) THEN BEGIND !E ! If the rejection logical name is set, then send the contents as a @ ! rejection message. The rest of the rejection message will be ! sent by the listener. !C status = ftp_announce(fblock, FTP$C_NOT_LOGGED_IN, temp_desc);s/ RETURN(send_rein(fblock, 1, FTP$_REJECT));I END;p ! ! Get logical FTP_Restrict( ! status = $TRNLNM() LOGNAM = %ASCID 'MADGOAT_FTP_RESTRICT',L TABNAM = lnm$dcl_logical,) ITMLST = lnmlst);! IF .statusN THEN BEGINSA status = OTS$CVT_TU_L(lnm_desc, temp, %ALLOCATION(temp), 0); 6 IF NOT .status THEN print('Error: !XL', .status);* IF .status THEN ftp_restrict = .temp; END;  ! ! Get logical FTP_LOG ! status = $TRNLNM($ LOGNAM = %ASCID 'MADGOAT_FTP_LOG', TABNAM = lnm$dcl_logical,  ITMLST = LNMLST); IF .statusp THEN BEGIN @ status = OTS$CVT_TU_L(lnm_desc,temp, %ALLOCATION(temp), 0); IF NOT .statusuF THEN print('Error: !XL, FTP_LOG value "!AS"', .status, lnm_desc); IF .statuso THEN BEGINt# fblock[FBLOCK_V_LOGGING] = .temp;% fblock[FBLOCK_V_COMMAND] = .temp/2;w# fblock[FBLOCK_V_TRACE] = .temp/4;u END; END;t !H ! Determine whether we need to add quotation marks around the pathnames+ ! in 257 reply messages (for PWD and MKD).f ! status = $TRNLNM(/ LOGNAM = %ASCID 'MADGOAT_FTP_QUOTE_PATHNAME', TABNAM = lnm$dcl_logical,[ ITMLST = LNMLST);d IF .statusl THEN fblock[FBLOCK_V_NOQUOTE] = .lnm_buffer[0] EQL %C'F' OR .lnm_buffer[0] EQL %C'f' ORS .lnm_buffer[0] EQL %C'N' OR2 .lnm_buffer[0] EQL %C'n';[ ! ! Set options ! ftp_set_params(); ! ! Now start logging ! print('');K print('');  print(' !64*-');D1 print(' FTP Login at !20%D !AS MadGoat FTP !AS',E$ 0, Timezone, %ASCID FTP_Version);3 print(' From host !AD [!UB.!UB.!UB.!UB] Port=!UL',_ .conn[CONN_L_REMHOSTLEN], conn[CONN_T_REMHOSTBUF],D" .remadr<0,8,0>, .remadr<8,8,0>,$ .remadr<16,8,0>, .remadr<24,8,0>, .conn[CONN_L_REMPORT]);3 print(' To host !AD [!UB.!UB.!UB.!UB] Port=!UL',O .conn[CONN_L_LCLHOSTLEN], conn[CONN_T_LCLHOSTBUF], " .locadr<0,8,0>, .locadr<8,8,0>,$ .locadr<16,8,0>, .locadr<24,8,0>, .conn[CONN_L_LCLPORT]); print(' !64*-'); print('');T print('');N !* ! Now if logging not requesed shut it off !! IF NOT .fblock[FBLOCK_V_LOGGING]l THEN BEGIN,, STR$COPY_DX(temp_desc, %ASCID 'NLA0:'); $ITMLST_INIT(ITMLST=lnmlst, (ITMCOD = LNM$_STRING,& BUFADR = .temp_desc[DSC$A_POINTER],% BUFSIZ = .temp_desc[DSC$W_LENGTH],  RETLEN = 0));4 status = $CRELNM( LOGNAM = %ASCID 'SYS$OUTPUT',( TABNAM = %ASCID 'LNM$PROCESS_TABLE', ATTR = %REF(LNM$M_CONFINE),d ACMODE = %REF(PSL$C_USER), ITMLST = lnmlst);]> IF NOT .status THEN print('Error: $CRELNM !XL', .status);3 status = $CRELNM( LOGNAM = %ASCID 'SYS$ERROR', ( TABNAM = %ASCID 'LNM$PROCESS_TABLE', ATTR = %REF(LNM$M_CONFINE),n ACMODE = %REF(PSL$C_USER), ITMLST = lnmlst);H> IF NOT .status THEN print('Error: $CRELNM !XL', .status);' status = STR$FREE1_DX( temp_desc);16 IF NOT .status THEN print('Error: !XL', .status); END;d ! ! Enable activity logging.e ! fblock[FBLOCK_V_ACT_LOG] = / $TRNLNM(LOGNAM = %ASCID'MADGOAT_FTP_ACT_LOG',_ TABNAM = lnm$dcl_logical); > IF is_anonymous(fblock[FBLOCK_Q_USERNAME], primetime, thresh," pt_start, pt_end, anon_dir_log) THEN BEGINN IF .ftp_restrict EQL -11 THEN ftp_restrict = FTP$K_RESTRICT_DELETE ORe FTP$K_RESTRICT_CONTROL OR FTP$K_RESTRICT_WRITE;S !! ! Test logical FTP_user_DIRSF !$ fblock[FBLOCK_V_CHECK_ACCESS] =' check_access_log(anon_dir_log, 1) OR 0 (.ftp_restrict AND FTP$K_RESTRICT_CWD) NEQ 0; status = login_guest( fblock[FBLOCK_Q_USERNAME],, fblock[FBLOCK_L_ANON_BLOCK],r3 primetime, thresh, password_desc, password_desc, anon_dir_log);( IF NOT .status_ THEN BEGIN  send_error(fblock, .status);( RETURN(send_rein(fblock, 1, .status)); ENDs ELSE BEGINN! fblock[FBLOCK_V_ANONYMOUS] = 1; , anon_log('Anonymous FTP session begins.'); IF .status THEN BEGIN% fblock[FBLOCK_V_LOGGED_IN] = 1;u= anon_log('Remote host: !AD [!UB.!UB.!UB.!UB] Port=!UL',h .conn[CONN_L_REMHOSTLEN],A conn[CONN_T_REMHOSTBUF],# .remadr<0,8,0>, .remadr<8,8,0>,e% .remadr<16,8,0>, .remadr<24,8,0>,e .conn[CONN_L_REMPORT]);.< anon_log('Local host: !AD [!UB.!UB.!UB.!UB] Port=!UL', .conn[CONN_L_LCLHOSTLEN],  conn[CONN_T_LCLHOSTBUF],# .locadr<0,8,0>, .locadr<8,8,0>,1% .locadr<16,8,0>, .locadr<24,8,0>,: .conn[CONN_L_LCLPORT]);S1 anon_log('Identifier: !AS', password_desc);[ !R; ! Check for a logical restricting the directories wee ! can access. !4 init_rdirq (fblock [FBLOCK_Q_RESTRICTED_DIRS]," .fblock [FBLOCK_V_ANONYMOUS]);" IF .fblock[FBLOCK_V_ACT_LOG]N THEN super_act$fao('FTP: Session begins. User=!AS, Ident=!AS, Host=!AD',- fblock[FBLOCK_Q_USERNAME], password_desc,f .conn[CONN_L_REMHOSTLEN],  conn[CONN_T_REMHOSTBUF]);F4 status = $FAO(%ASCID'MADGOAT_FTP_!AS_WELCOME', welcome_desc, welcome_desc,s fblock[FBLOCK_Q_USERNAME]);s IF .status/ THEN ftp_announce(fblock, FTP$C_USER_IN, , welcome_desc, 1);A SIGNAL(FTP$_GUEST_LOGGED_IN, 3, password_desc, 0, timezone,X: FTP$_TIMEOUT_MESSAGE, 1, .fblock[FBLOCK_L_TIMEOUT]/60); END; END; END ELSE BEGIN 4 IF .ftp_restrict EQL -1 THEN ftp_restrict = 0; ! ! Test logical FTP_Dirs !$ fblock[FBLOCK_V_CHECK_ACCESS] =+ check_access_log(madgoat_ftp_dirs, 0) ORk0 (.ftp_restrict AND FTP$K_RESTRICT_CWD) NEQ 0; !F ! Check for a logical restricting the directories we can access. !3 init_rdirq (fblock [FBLOCK_Q_RESTRICTED_DIRS],a! .fblock [FBLOCK_V_ANONYMOUS]);M$ fblock[FBLOCK_V_LOGGED_IN] = 1;! IF .fblock[FBLOCK_V_ACT_LOG]_B THEN super_act$fao('FTP: Session begins. User=!AS, Host=!AD', fblock[FBLOCK_Q_USERNAME], .conn[CONN_L_REMHOSTLEN],N conn[CONN_T_REMHOSTBUF]);R( ftp_announce(fblock, FTP$C_USER_IN,! %ASCID'MADGOAT_FTP_WELCOME');% SIGNAL(FTP$_USER_LOGGED_IN,- 3, fblock[FBLOCK_Q_USERNAME], 0, timezone,S9 FTP$_TIMEOUT_MESSAGE,1, .fblock[FBLOCK_L_TIMEOUT]/60);E END;E END;L %FIE SS$_NORMAL END; AROUTINE get_port =!++S! Functional Description:e!L! Return a port number!I ! Algorithm:4! Return next port number, starting with system time!-- BEGIN LITERAL2 min_port = 1024; ! Min user port we will hand out OWN  cport : WORD INITIAL(0); LOCAL_ time : $BBLQax MGFTP026.Gl#IGFTP.SOURCE]FTP_IN.B32;92W:OCK[8],l status; !++N= ! If it is the first time thru, then get something pretty14 ! random. Like some bits out of the time clock. !--I IF .cport EQL 0, THEN BEGIN! status = $GETTIM(TIMADR = time);T% IF NOT .status THEN SIGNAL(.status);A cport = .time[1,0,15,0];_ END;$ cport = MAX(.cport+1, min_port); RETURN .cport; END;ENDDELUDOMABLE ftp_handler(fblock_enable); BUILTINT CMPM, INSQUE; %IF debugS %THEN print('ftp_in');*[MGFTP.SOURCE]FTP_INPUT.B32;39+,&# .(/ 4J(&-I0123KPWO'56yږ7ږ89/RFÞGHJ ! MadGoat FTP client and server!?! Authors: Chad Wilson, Dale Moore, Tod Shannon, Bruce Miller,,! Marc Shannon, Henry Miller, John Clement,1! Matt Madison, Darrell Burkhead, Hunter Goatley!6! Copyright 1986, 1992, Carnegie Mellon University.B! Copyright 1994, 1996, MadGoat Software. All rights reserved.!?! Permission is granted for not-for-profit redistribution,?! provided all source and object code remain unchanged from?! the original distribution, and that all copyright notices! remain intact.!MODULE ftp_input( ADDRESSING_MODE( EXTERNAL = LONG_RELATIVE," NONEXTERNAL = LONG_RELATIVE), IDENT = 'V2.6-2',& LIST(ASSEMBLY, NOBINARY, NOEXPAND)) =BEGIN!++! FTP_INPUT.B32!.! Copyright(c) 1987 Carnegie Mellon University!! Description:!6! Use the SMG input routines to get the input from the! user.! ! Written By:!"! Dale Moore 14-OCT-1987 CMU-CS/RI!! Modifications:!+! V2.6-2 Hunter Goatley 1-MAY-2000 09:485! Added ftp_cancel_input(), which is called from the9! do_xxx() routines in CONDITION.B32 to cancel our reads! when errors are signaled.!+! V2.2-2 Hunter Goatley 7-OCT-1996 08:51:! Added automatic loading of separate FTP key definitions! file.!)! V2.2 Hunter Goatley 19-AUG-1996 12:08%! Added support for key definitions.!,! V2.1-2 Darrell Burkhead 10-NOV-1994 10:38<! Don't create a pasteboard since we aren't currently doing! any SMG output.!*! V2.1 Darrell Burkhead 1-JUN-1994 14:10;! Made the prompt and output length parameters optional in*! ftp_get_input and ftp_get_quoted_input.!*! V2.0 Darrell Burkhead 4-DEC-1993 16:43>! Reworked ftp_get_input_noecho to return end-of-file instead>! of signaling it. This allows us to gracefully quit logging<! in when Ctrl-Z is pressed at the password prompt (instead! of exiting FTP).!--LIBRARY 'SYS$LIBRARY:STARLET';LIBRARY 'NETAUX';FORWARD ROUTINE ftp_input_init, ftp_get_input, ftp_get_quoted_input, ftp_get_input_noecho, ftp_define_key, ftp_delete_key, ftp_show_key, decode_attributes, ftp_cancel_input;OWN pasteboard_id, keyboard_pass, keyboard_id, key_table_id : INITIAL(0),) term_rows, ! height of the screen.* term_columns, ! width of the screen.B preserve_screen : INITIAL(1); ! Don't clear screen on startup. BIND! key_name_str = %ASCID'KEY_NAME',# equiv_str_str = %ASCID'EQUIV_STR',! if_state_str = %ASCID'IF_STATE',# set_state_str = %ASCID'SET_STATE',# terminate_str = %ASCID'TERMINATE', echo_str = %ASCID'ECHO', lock_str = %ASCID'LOCK',: fao_show_key_header = %ASCID'!AS key state definitions:',* fao_show_key = %ASCID' !AS = "!AS"!AS'; GLOBAL ROUTINE ftp_input_init =!++! Description:!$! Initialize the SMG input routines.!-- BEGIN EXTERNAL ROUTINE9 SMG$CREATE_PASTEBOARD : BLISS ADDRESSING_MODE(GENERAL),> SMG$CREATE_VIRTUAL_KEYBOARD : BLISS ADDRESSING_MODE(GENERAL),> SMG$DELETE_VIRTUAL_KEYBOARD : BLISS ADDRESSING_MODE(GENERAL),5 SMG$LOAD_KEY_DEFS : BLISS ADDRESSING_MODE(GENERAL),8 SMG$CREATE_KEY_TABLE : BLISS ADDRESSING_MODE(GENERAL); LOCAL status;$! status = SMG$CREATE_PASTEBOARD(?! pasteboard_id, ! We use this to get information about displ.0! 0, ! Output device. default is 'SYS$OUTPUT'%! term_rows, ! height of the screen.'! term_columns, ! width of the screen.1! preserve_screen); ! Should we clear the screen?!)! IF NOT .status THEN SIGNAL(.status);6 status = SMG$CREATE_VIRTUAL_KEYBOARD(keyboard_id);( IF NOT .status THEN SIGNAL(.status);J status = SMG$CREATE_VIRTUAL_KEYBOARD(keyboard_pass, 0, 0, 0, %REF(0));( IF NOT .status THEN SIGNAL(.status); If .key_table_id EQL 05 THEN status = SMG$CREATE_KEY_TABLE(key_table_id);( IF NOT .status THEN SIGNAL(.status); IF (.status) THEN> SMG$LOAD_KEY_DEFS (key_table_id, %ASCID'MADGOAT_FTP_KEYDEFS', %ASCID'SYS$LOGIN:.INI'); SS$_NORMAL END; BGLOBAL ROUTINE ftp_get_input(get_str_a, prompt_str_a, out_len_a) =!++! Functional Description:!6! This routine is used to get input for cli$dcl_parse.2! The format of the arguements must be the same as! LIB$GET_INPUT.!/! I like SMG 'cause it gives us command recall.4! And eventually, we might wanna use SMG for output.!-- BEGIN BIND" get_str = .get_str_a : $BBLOCK; EXTERNAL ROUTINE9 SMG$READ_COMPOSED_LINE : BLISS ADDRESSING_MODE(GENERAL); EXTERNAL LITERAL SMG$_EOF; LOCAL status; BUILTIN NULLPARAMETER;$ status = SMG$READ_COMPOSED_LINE( keyboard_id, key_table_id, get_str, IF NULLPARAMETER(prompt_str_a) THEN 0 ELSE .prompt_str_a, IF NULLPARAMETER(out_len_a) THEN 0 ELSE .out_len_a);2 IF .status EQL SMG$_EOF THEN RETURN(RMS$_EOF);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; IGLOBAL ROUTINE ftp_get_quoted_input(get_str_a, prompt_str_a, out_len_a) =!++! Functional Description:!6! This routine is used to get input for cli$dcl_parse.2! The format of the arguements must be the same as! LIB$GET_INPUT.!/! I like SMG 'cause it gives us command recall.4! And eventually, we might wanna use SMG for output.!! This is a KLUDGE by J Clement,! This routine will make DCL case sensative.8! If the prompt contains the string "REMOTE" the data is"! encapsulated in quotation marks.!!-- BEGIN BIND" get_str = .get_str_a : $BBLOCK, whitespace = %ASCID' ', quote = %ASCID'"'; EXTERNAL ROUTINE strings_handler, character_present, separate_at_char,0 STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL),/ STR$CONCAT : BLISS ADDRESSING_MODE(GENERAL),9 STR$FIND_FIRST_IN_SET : BLISS ADDRESSING_MODE(GENERAL),< STR$FIND_FIRST_NOT_IN_SET : BLISS ADDRESSING_MODE(GENERAL),; STR$FIND_FIRST_SUBSTRING : BLISS ADDRESSING_MODE(GENERAL),1 STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL),- STR$LEFT : BLISS ADDRESSING_MODE(GENERAL),. STR$RIGHT : BLISS ADDRESSING_MODE(GENERAL),1 STR$POSITION : BLISS ADDRESSING_MODE(GENERAL),/ STR$UPCASE : BLISS ADDRESSING_MODE(GENERAL),: SMG$READ_COMPOSED_LINE : BLISS ADDRESSING_MODE(GENERAL); EXTERNAL LITERAL SMG$_EOF; LOCAL/ temp1 : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0," [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_Class] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),. temp2 : VOLATILE $BBLOCK[DSC$K_S_BLN]PRESET( [DSC$W_LENGTH] = 0," [DRh. MGFTP026.G&# I[MGFTP.SOURCE]FTP_INPUT.B32;39J(_SC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_Class] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),. temp3 : VOLATILE $BBLOCK[DSC$K_S_BLN]PRESET( [DSC$W_LENGTH] = 0," [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_Class] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0), length, status; ENABLE& strings_handler(temp1, temp2, temp3); BUILTIN NULLPARAMETER;$ status = SMG$READ_COMPOSED_LINE( keyboard_id, key_table_id, temp1, IF NULLPARAMETER(prompt_str_a) THEN 0 ELSE .prompt_str_a);2 IF .status EQL SMG$_EOF THEN RETURN(RMS$_EOF);( IF NOT .status THEN SIGNAL(.status);, IF (STR$POSITION(temp1, quote) GTR 0) OR% (NOT NULLPARAMETER(prompt_str_a) AND% (STR$UPCASE( temp2, .prompt_str_a); NOT STR$FIND_FIRST_SUBSTRING(- temp2, status, %REF(1), %ASCID 'REMOTE'))) THEN BEGIN% STR$COPY_DX( get_str, temp1); IF NOT NULLPARAMETER(out_len_a) THEN BEGIN/ BIND out_len = .out_len_a : WORD UNSIGNED;A out_len = MIN(.temp1[DSC$W_length], .get_str[DSC$W_length]); END; status = STR$FREE1_DX(temp1);% IF NOT .status THEN SIGNAL(.status); status = STR$FREE1_DX(temp2);% IF NOT .status THEN SIGNAL(.status); status = STR$FREE1_DX(temp3);% IF NOT .status THEN SIGNAL(.status); RETURN(SS$_NORMAL); END;!G! Now if a comma is present separate it into 2 strings at the comma and! append the first one.!5 WHILE character_present(%C',', temp1) ! Comma ? DO BEGIN6 separate_at_char(%C',', temp1, temp2); ! Split at ,7 status = STR$FIND_FIRST_NOT_IN_SET(temp1, whitespace); IF .status GTR 1> THEN STR$RIGHT(temp1, temp1, %REF(.status)); ! Remove blanks3 status = STR$FIND_FIRST_IN_SET(temp1, whitespace); IF .status GTR 1A THEN STR$LEFT(temp1, temp1, %REF(.status - 1)); ! Remove blanks1 IF .temp1[DSC$W_LENGTH] GTR 0 ! Add to output: THEN STR$CONCAT( temp3, temp3, quote, temp1, %ASCID'",');' STR$COPY_DX( temp1, temp2 ); ! Keep END;!#! Now strip leading/training blanks!: status = STR$FIND_FIRST_NOT_IN_SET(temp1, whitespace); IF .status GTR 10 THEN STR$RIGHT(temp1, temp1, %REF(.status));6 status = STR$FIND_FIRST_IN_SET(temp1, whitespace); IF .status GTR 13 THEN STR$LEFT(temp1, temp1, %REF(.status - 1));! IF .temp1[DSC$W_LENGTH] GTR 08 THEN STR$CONCAT( temp3, temp3, quote, temp1, quote);! STR$COPY_DX( get_str, temp3);# IF NOT NULLPARAMETER(out_len_a) THEN BEGIN+ BIND out_len = .out_len_a : WORD UNSIGNED;= out_len = MIN(.temp3[DSC$W_LENGTH], .get_str[DSC$W_LENGTH]);" END; !End of length requested! status = STR$FREE1_DX(temp1);( IF NOT .status THEN SIGNAL(.status);! status = STR$FREE1_DX(temp2);( IF NOT .status THEN SIGNAL(.status);! status = STR$FREE1_DX(temp3);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; >GLOBAL ROUTINE ftp_get_input_noecho(get_str_a, prompt_str_a) =!++! Functional Description:!:! Just like FTP_Get_Input only we don't echo what the user ! has typed.!?! Only we use SMG$READ_STRING instead of SMG$READ_COMPOSED_LINE,! cause we want to do the read without echo.!-- BEGIN BIND" get_str = .get_str_a : $BBLOCK,' prompt_str = .prompt_str_a : $BBLOCK; EXTERNAL LITERAL SMG$_EOF; EXTERNAL ROUTINE2 SMG$READ_STRING : BLISS ADDRESSING_MODE(GENERAL); LOCAL status; status = SMG$READ_STRING( keyboard_pass, get_str, prompt_str, 0, %REF(TRM$M_TM_NOECHO));2 IF .status EQL SMG$_EOF THEN RETURN(RMS$_EOF);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL! EXTERNAL ROUTINE.! STR$COPY_R : BLISS ADDRESSING_MODE(GENERAL); ! LOCAL"! read_buffer : VECTOR[512, BYTE],! in_fab : $FAB(! FAC = ,! FNM = 'SYS$INPUT:',! FOP = ),! in_rab : $RAB(! FAB = in_fab,&! PBF = .prompt_str[DSC$A_POINTER],%! PSZ = .prompt_str[DSC$W_LENGTH],! ROP = ,! UBF = read_buffer,%! USZ = %ALLOCATION(read_buffer)), ! statusv, ! status;!"! status = $OPEN(FAB = in_fab);! IF NOT .status&! THEN statusv = .in_fab[FAB$L_STV] ! ELSE BEGIN !File opened"! status = $CONNECT(RAB = in_rab);! IF NOT .status#! THEN statusv = .in_rab[RAB$L_STV]! ELSE BEGIN !RAB connected"! status = $GET(RAB = in_rab);#! IF NOT .status !Record read(! THEN statusv = .in_rab[RAB$L_STV];! ELSE BEGIN! status = STR$COPY_R(4! get_str, %REF(.in_rab[RAB$W_RSZ]), read_buffer);! IF NOT .status1! THEN statusv = 0; !Will be treated as the FAO! !...argument count! END; !End of record read! ! $DISCONNECT(RAB = in_rab);#! END; !End of RAB connected!! $CLOSE(FAB = in_fab);! END; !End of file opened!!C! IF NOT .status AND .status NEQ RMS$_EOF !Don't signal RMS$_EOF$! THEN SIGNAL(.status, .statusv);!! print('');! ! .status END; GLOBAL ROUTINE ftp_define_key =BEGIN!+! Functional Description:!3! CLI routine to define keys inside the FTP client.!- EXTERNAL ROUTINE8 SMG$CREATE_KEY_TABLE : BLISS ADDRESSING_MODE (GENERAL),4 SMG$ADD_KEY_DEF : BLISS ADDRESSING_MODE (GENERAL),1 STR$FREE1_DX : BLISS ADDRESSING_MODE (GENERAL),2 CLI$GET_VALUE : BLISS ADDRESSING_MODE (GENERAL),0 CLI$PRESENT : BLISS ADDRESSING_MODE (GENERAL); EXTERNAL LITERAL9 CLI$_PRESENT, CLI$_ABSENT, CLI$_NEGATED, CLI$_DEFAULTED; LOCAL key : $BBLOCK [DSC$K_S_BLN], equiv : $BBLOCK [DSC$K_S_BLN]," if_state : $BBLOCK [DSC$K_S_BLN],# set_state : $BBLOCK [DSC$K_S_BLN], flags, status; $INIT_DYNDESC (key); $INIT_DYNDESC (equiv); $INIT_DYNDESC (if_state); $INIT_DYNDESC (set_state);2! status = SMG$CREATE_KEY_TABLE (key_table_id);/ status = CLI$GET_VALUE (key_name_str, key);2 status = CLI$GET_VALUE (equiv_str_str, equiv);4 status = CLI$GET_VALUE (if_state_str, if_state);6 status = CLI$GET_VALUE (set_state_str, set_state); flags = 0;) status = CLI$PRESENT (terminate_str);A IF (.status NEQU CLI$_ABSENT) AND (.status NEQU CLI$_NEGATED) THEN' flags = .flags OR SMG$M_KEY_TERMINATE;$ status = CLI$PRESENT (echo_str);" IF (.status EQLU CLI$_NEGATED) THEN$ flags = .flags OR SMG$M_KEY_NOECHO;$ status = CLI$PRESENT (lock_str);7 IF (.status) AND (.set_state [DSC$W_LENGTH] NEQU 0)*! AND NOT (.flags AND SMG$M_KEY_TERMINATE) THEN" flags = .flags OR SMG$M_KEY_LOCK;0 status = SMG$ADD_KEY_DEF (key_table_id, key,) (IF (.if_state [DSC$W_LENGTH] NEQU 0) THEN if_state ELSE 0), flags, equiv,* (IF (.set_state [DSC$W_LENGTH] NEQU 0) THEN set_state ELSE 0)); STR$FREE1_DX (key); STR$FREE1_DX (equiv);F IF (.if_state [DSC$W_LENGTH] NEQU 0) THEN STR$FREE1_DX (if_state);H IF (.set_state [DSC$W_LENGTH] NEQU 0) THEN STR$FREE1_DX (set_state);) IF NOT(.status) THEN SIGNAL(.status); RETURN (.status);END; !End of routine GLOBAL ROUTINE ftp_delete_key =BEGIN!+! Functional Description:!3! CLI routine to delete keys inside the FTP client.!- EXTERNAL ROUTINE6 SMG$DELETE_KEY_DEF : BLISS ADDRESSING_MODE (GENERAL),1 STR$FREE1_DX : BLISS ADDRESSING_MODE (GENERAL),2 CLI$GET_VALUE : BLISS ADDRESSING_MODE (GENERAL),0 CLI$PRESENT : BLISS ADDRESSING_MODE (GENERAL); EXTERNAL LITERAL9 CLI$_PRESENT, CLI$_ABSENT, CLI$_NEGATED, CLI$_DEFAULTED; LOCAL key : $BBLOCK [DSC$K_S_BLN]," if_state : $BBLOCK [DSC$K_S_BLN], flags, status; $ISZ MGFTP026.G&# I[MGFTP.SOURCE]FTP_INPUT.B32;39J(NIT_DYNDESC (key); $INIT_DYNDESC (if_state);/ status = CLI$GET_VALUE (key_name_str, key);" IF (CLI$PRESENT(if_state_str)) THEN1 status = CLI$GET_VALUE (if_state_str, if_state);3 status = SMG$DELETE_KEY_DEF (key_table_id, key,) (IF (.if_state [DSC$W_LENGTH] NEQU 0) THEN if_state ELSE 0)); STR$FREE1_DX (key);F IF (.if_state [DSC$W_LENGTH] NEQU 0) THEN STR$FREE1_DX (if_state);) IF NOT(.status) THEN SIGNAL(.status); RETURN (.status);END; !End of routine GLOBAL ROUTINE ftp_show_key =BEGIN!+! Functional Description:!<! CLI routine to show key definitions inside the FTP client.!- EXTERNAL ROUTINE0 LIB$SYS_FAO : BLISS ADDRESSING_MODE (GENERAL),3 LIB$PUT_OUTPUT : BLISS ADDRESSING_MODE (GENERAL),4 SMG$GET_KEY_DEF : BLISS ADDRESSING_MODE (GENERAL),5 SMG$LIST_KEY_DEFS : BLISS ADDRESSING_MODE (GENERAL),0 STR$COPY_DX : BLISS ADDRESSING_MODE (GENERAL),1 STR$FREE1_DX : BLISS ADDRESSING_MODE (GENERAL),2 CLI$GET_VALUE : BLISS ADDRESSING_MODE (GENERAL),0 CLI$PRESENT : BLISS ADDRESSING_MODE (GENERAL); EXTERNAL LITERAL9 CLI$_PRESENT, CLI$_ABSENT, CLI$_NEGATED, CLI$_DEFAULTED, SMG$_NOMOREKEYS; LOCAL key : $BBLOCK [DSC$K_S_BLN], equiv : $BBLOCK [DSC$K_S_BLN]," if_state : $BBLOCK [DSC$K_S_BLN],# if_state2 : $BBLOCK [DSC$K_S_BLN],# set_state : $BBLOCK [DSC$K_S_BLN],! faoout : $BBLOCK [DSC$K_S_BLN], flags, full, status; $INIT_DYNDESC (key); $INIT_DYNDESC (equiv); $INIT_DYNDESC (if_state); $INIT_DYNDESC (if_state2); $INIT_DYNDESC (set_state); $INIT_DYNDESC (faoout);" IF (CLI$PRESENT(if_state_str)) THEN0 status = CLI$GET_VALUE (if_state_str, if_state) ELSE) STR$COPY_DX (if_state, %ASCID'DEFAULT');& full = CLI$PRESENT (%ASCID'FULL');& IF NOT (CLI$PRESENT (%ASCID'ALL')) THEN BEGIN, status = CLI$GET_VALUE (key_name_str, key);> status = SMG$GET_KEY_DEF (key_table_id, key, if_state, flags, equiv, set_state); IF (.status)F THENn BEGIN IF .fulls THENo1 decode_attributes (flags, set_state, set_state) ELSEn STR$FREE1_DX (set_state);M< LIB$SYS_FAO (fao_show_key_header, 0, faoout, if_state); LIB$PUT_OUTPUT (faoout);n* LIB$SYS_FAO (fao_show_key, 0, faoout, key, equiv, set_state); LIB$PUT_OUTPUT (faoout); END;o END ELSE !/ALL specified BEGIN LOCAL context : INITIAL(0);8 LIB$SYS_FAO (fao_show_key_header, 0, faoout, if_state); LIB$PUT_OUTPUT (faoout);h: WHILE (status = SMG$LIST_KEY_DEFS (key_table_id, context, key, if_state2, flags, equiv, set_state)) DO BEGINE IF (CH$EQL (.if_state [DSC$W_LENGTH], .if_state [DSC$A_POINTER],X9 .if_state2 [DSC$W_LENGTH], .if_state2 [DSC$A_POINTER],( 0)) THENl BEGINr IF .full THEN5 decode_attributes (flags, set_state, set_state)  ELSE STR$FREE1_DX (set_state);? LIB$SYS_FAO (fao_show_key, 0, faoout, key, equiv, set_state);  LIB$PUT_OUTPUT (faoout); END; END;A" IF (.status EQLU SMG$_NOMOREKEYS) THENo status = SS$_NORMAL;s END;D STR$FREE1_DX (key);d STR$FREE1_DX (equiv);aF IF (.if_state [DSC$W_LENGTH] NEQU 0) THEN STR$FREE1_DX (if_state);H IF (.if_state2 [DSC$W_LENGTH] NEQU 0) THEN STR$FREE1_DX (if_state2);H IF (.set_state [DSC$W_LENGTH] NEQU 0) THEN STR$FREE1_DX (set_state);* IF NOT(.status) THEN SIGNAL (.status); RETURN (.status);aEND; !End of routined 4ROUTINE decode_attributes (attr_a, state_a, str_a) =BEGIN1 BIND attr = .attr_a, state = .state_a : $BBLOCK, str = .str_a : $BBLOCK; EXTERNAL ROUTINE/ STR$APPEND : BLISS ADDRESSING_MODE (GENERAL),30 STR$COPY_DX : BLISS ADDRESSING_MODE (GENERAL),/ STR$CONCAT : BLISS ADDRESSING_MODE (GENERAL),u1 STR$FREE1_DX : BLISS ADDRESSING_MODE (GENERAL);p LOCALh work : $BBLOCK [DSC$K_S_BLN]; $INIT_DYNDESC (work);R* IF (.attr AND SMG$M_KEY_NOECHO) NEQU 0 THEN& STR$COPY_DX (work, %ASCID' (noecho') ELSE% STR$COPY_DX (work, %ASCID' (echo');e- IF (.attr AND SMG$M_KEY_TERMINATE) NEQU 0o THEN& STR$APPEND (work, %ASCID',terminate') ELSE) STR$APPEND (work, %ASCID',noterminate');e( STR$APPEND (work, %ASCID',noerase');( IF (.attr AND SMG$M_KEY_LOCK) NEQU 0 THEN! STR$APPEND (work, %ASCID',lock')  ELSE$ STR$APPEND (work, %ASCID',nolock');8 IF (state NEQA 0) AND (.state [DSC$W_LENGTH] NEQU 0) THEN1 STR$CONCAT (work, work, %ASCID',state=', state);A& STR$CONCAT (str, work, %ASCID')'); STR$FREE1_DX (work); SS$_NORMALEND; _!GLOBAL ROUTINE ftp_cancel_input =ABEGINC EXTERNAL ROUTINE4 SMG$CANCEL_INPUT : BLISS ADDRESSING_MODE(GENERAL);" SMG$CANCEL_INPUT (keyboard_id)END;ENDUELUDOMnput_init =!++! Description:!$! Initialize the SMG input routines.!-- BEGIN EXTERNAL ROUTINE9 SMG$CREATE_PASTEBOARD : BLISS ADDRESSING_MODE(GENERAL),> SMG$CREATE_VIRTUAL_KEYBOARD : BLISS ADDRESSING_MODE(GENERAL!*[MGFTP.SOURCE]FTP_LISTENER.B32;31+,,.4/ 4S43-I0123KPWO456qTx7\Tx89/RFÞGHJ ! MadGoat FTP client and server!?! Authors: Chad Wilson, Dale Moore, Tod Shannon, Bruce Miller,,! Marc Shannon, Henry Miller, John Clement,1! Matt Madison, Darrell Burkhead, Hunter Goatley!6! Copyright 1986, 1992, Carnegie Mellon University.B! Copyright 1994, 2000, MadGoat Software. All rights reserved.!?! Permission is granted for not-for-profit redistribution,?! provided all source and object code remain unchanged from?! the original distribution, and that all copyright notices! remain intact.!%TITLE 'FTP_LISTENER'MODULE FTP_LISTENER( IDENT = 'V2.6-2', MAIN = FTP_LISTENER, ADDRESSING_MODE( EXTERNAL = GENERAL)) =BEGIN!++%! FACILITY: MadGoat FTP listener!>! ABSTRACT: Implements the listener/dispatcher portion of! the FTP server.!! MODULE DESCRIPTION:!!! AUTHOR: M. Madison!! CREATION DATE: 23-OCT-1990!! MODIFICATION HISTORY:!0! 23-OCT-1990 V1.0 Madison Initial coding.5! 05-JUN-1992 V1.1. Madison Change VM handling.K! 26-APR-1993 V1.2 Burkhead The listener now handles the commands that.! are sent before logging in. A server1! process is not created until the USER is%! known and has been verified.F! 29-MAY-1993 V1.3 Burkhead Got rid of some extra mailboxes. The-! listener and servers now communicate0! through common termination, output, and! log mailboxes.F! 16-NOV-1993 V2.0 Burkhead Switch to NETLIB. Added CLD support..! The maximum number of servers can now*! be specified on the command line.L! 21-FEB-1994 V2.0-1 Burkhead Commented out the netlib_lib_addr_to_name1! call in accept_connection_ast. It hangs-! under Multinet. (I don't think that3! gethostbyaddr can be called at AST level.)I! 06-MAY-1994 V2.0-2 Burkhead Added a check for the MULTINET logical1! name. If it is defined, then don't call!! netlib_liT*^F MGFTP026.G,I![MGFTP.SOURCE]FTP_LISTENER.B32;31S4b_addr_to_name.N! 23-SEP-1994 V2.1-1 Burkhead Added support for the MADGOAT_FTP_LISTENER_.! PORT logical name which specifies the(! port on which to listen for FTP! connections.M! 14-OCT-1994 V2.1-2 Burkhead Check for TWG$TCP. If it is defined, then1! don't call netlib_lib_addr_to_name (like4! Multinet, it can't be called at AST level).H! 14-AUG-1996 V2.2 Goatley Do an addr -> name lookup for the local0! host once a connection is made. Needed0! for systems with multiple addresses....L! 2-JUN-1997 V2.2-1 Goatley Check to be sure we have a channel before5! doing the deassign in ACCEPT_CONNECTION_AST.L! 24-FEB-1998 V2.3 Goatley Add support for MADGOAT_FTP_LOCAL_HOSTNAME.K! 5-MAR-1998 V2.4 Goatley Don't re-do host lookup in accept_conn_ast.! if LOCAL_HOSTNAME logical is defined.2! Also, added bg_gethostbyaddr() routine to/! allow remote host name lookups via the2! UCX BG emulation in MultiNet and Pathway./! Also, added OPCOM msg to exit handler.$! Use UCX BG for TCPware too.A! 25-MAR-1998 Goatley Ooops! $DASSGN chan is by value....9! 22-APR-1998 Goatley Add compiletime debug stuff.L! 17-JUN-1998 V2.4-1 Goatley Back out use of UCX BG for TCPware, as it.! sometimes caused the listener to hang*! waiting for the lookup to return.L! 29-APR-2000 V2.6-1 Goatley Add to 421, max servers reached..! Without that, some clients, including2! MGFTP, weren't displaying the message, as'! it wasn't a complete response!!--LIBRARY 'SYS$LIBRARY:STARLET';LIBRARY 'FTP_LISTENER';LIBRARY 'FTP';LIBRARY 'FTP_CONN_INFO';LIBRARY 'NETLIB';LIBRARY 'NETAUX'; !Debug macros COMPILETIME debug = 0;K%IF debug %THEN %MESSAGE('DEBUG mode is enabled in FTP_LISTENER.B32!') %FI;BUILTIN INSQUE, REMQUE;FORWARD ROUTINE ftp_listener, get_ftp_port, accept_connection, accept_connection_ast, srv_exit, set_up_server_mbxes, exit_handler : NOVALUE, parse_cmd, bg_gethostbyaddr;EXTERNAL ROUTINE mem_getior, mem_freeior, mem_getsrv, mem_freesrv, mem_getconn, mem_freeconn, ftp_in, create_act_log, server_to_net_ast, server_to_log_ast, server_cleanup_ast, cvt_port, LIB$WAIT, LIB$GETDVI, LIB$GET_FOREIGN, STR$FREE1_DX, STR$PREFIX, OTS$CVT_TU_L, CLI$DCL_PARSE, CLI$GET_VALUE; %IF debug%THEN EXTERNAL ROUTINE LIB$SHOW_VM;%FIGLOBAL, lcl_host_buf : $BBLOCK[host_name_max_size],% lcl_host_desc : $BBLOCK[DSC$C_S_BLN]0 PRESET([DSC$W_LENGTH] = host_name_max_size,# [DSC$B_DTYPE] = DSC$K_DTYPE_T,# [DSC$B_CLASS] = DSC$K_CLASS_S,$ [DSC$A_POINTER]= lcl_host_buf),- output_chan : WORD, !These are channels to, log_chan : WORD, !...the common mailboxes0 trm_chan : WORD, !...used to communicate with !...the servers trm_unit : LONG,> in_exithnd : LONG INITIAL(0), !exit_handler is being executed3 chk_max_servers, !Maximum # connections enforced num_servers : LONG INITIAL(0), max_servers : LONG;OWN3 skip_addr_to_name, !MULTINET or TWG$TCP defined?; skip_local_host_lookup, !LOCAL_HOSTNAME logical defined? listen_chan : LONG INITIAL(0),; accept_failed : LONG INITIAL(0), !Need to retry the accept !...once a server exits: curr_idx : LONG INITIAL(0); !Used to assign unique server !...indices GLOBAL BIND output_mbxnam = output_mbx, log_mbxnam = log_mbx, trm_mbxnam = trm_mbx;BIND? madgoat_ftp_listener_port = %ASCID'MADGOAT_FTP_LISTENER_PORT',C madgoat_ftp_maximum_servers = %ASCID'MADGOAT_FTP_MAXIMUM_SERVERS';EXTERNAL3 lnm$system_table : ADDRESSING_MODE(LONG_RELATIVE);MACRO3 check_mem(addr) =(IF(.addr NEQA 0) THEN SS$_NORMAL ELSE SS$_INSFMEM)%; %SBTTL 'FTP_LISTENER'GLOBAL ROUTINE ftp_listener = BEGIN!++! FUNCTIONAL DESCRIPTION:!! Main routine for listener:!! Opens listener channel#! Waits for incoming connections?! For each incoming connection, creates a server process and?! passes the FTP control channel data stream through to that)! process(and from it to the network).!A! RETURNS: cond_value, longword(unsigned), write only, by value! ! PROTOTYPE:!! FTP_LISTENER!! IMPLICIT INPUTS: None.!! IMPLICIT OUTPUTS: None.!! COMPLETION CODES:!2! SS$_NORMAL: normal successful completion.!! SIDE EFFECTS:! ! None.!-- OWN ftp_listen_port, exit_status : LONG, desblk : VECTOR[4,LONG]+ INITIAL(0,exit_handler,1,exit_status); LOCAL$ lnm_list : $ITMLST_DECL(ITEMS = 2), status;& status = $DCLEXH(DESBLK = desblk);( IF NOT .status THEN RETURN(.status);+ status = get_ftp_port(ftp_listen_port);( IF NOT .status THEN RETURN(.status); status = parse_cmd();( IF NOT .status THEN RETURN(.status); status = create_act_log();( IF NOT .status THEN RETURN(.status);# status = set_up_server_mbxes();( IF NOT .status THEN RETURN(.status);2 status = netlib_lib_assign(CTX = listen_chan);( IF NOT .status THEN RETURN(.status); status = netlib_lib_bind( CTX = listen_chan, PORT = .ftp_listen_port, THREADS = max_servers);( IF NOT .status THEN RETURN(.status);# $ITMLST_INIT(ITMLST = lnm_list, (ITMCOD = LNM$_STRING, BUFADR = lcl_host_buf,% BUFSIZ = %ALLOCATION(lcl_host_buf), RETLEN = lcl_host_desc));, IF NOT(status = skip_local_host_lookup =7 $TRNLNM (LOGNAM = %ASCID'MADGOAT_FTP_LOCAL_HOSTNAME',% TABNAM = %ASCID'LNM$DCL_LOGICAL', ITMLST = lnm_list)) THEN" status = netlib_lib_get_hostname( NAME = lcl_host_desc, LENGTH = lcl_host_desc);( IF NOT .status THEN RETURN(.status);C skip_addr_to_name = ($TRNLNM( !Is this a Multinet or TWG site? TABNAM = lnm$system_table, LOGNAM = %ASCID'MULTINET',! ACMODE = %REF(PSL$C_EXEC)) OR $TRNLNM( TABNAM = lnm$system_table,$ LOGNAM = %ASCID'TWG$TCP')); ! OR ! $TRNLNM(! TABNAM = lnm$system_table, ! LOGNAM = %ASCID'TCPWARE')); accept_connection(); $HIBER; SS$_NORMAL END; ! FTP_LISTENER %SBTTL 'GET_FTP_PORT'ROUTINE get_ftp_port(port_a)= BEGIN!++! FUNCTIONAL DESCRIPTION:!-! Issues an ACCEPT on the listener channel.!A! RETURNS: cond_value, longword(unsigned), write only, by value! ! PROTOTYPE:!! GET_FTP_PORT!! IMPLICIT INPUTS: None.!! IMPLICIT OUTPUTS: None.!! COMPLETION CODES:!2! SS$_NORMAL: normal successful completion.!! SIDE EFFECTS:! ! None.!-- LOCAL status,$ lnm_list : $ITMLST_DECL(ITEMS = 2), port_buf : $BBLOCK[8],) port_desc : $BBLOCK[DSC$C_S_BLN] PRESET(! [DSC$B_CLASS] = DSC$K_CLASS_S,! [DSC$B_DTYPE] = DSC$K_DTYPE_T, [DSC$A_POINTER] = port_buf); BIND port = .port_a : LONG;# $ITMLST_INIT(ITMLST = lnm_list, (ITMCOD = LNM$_STRING, BUFADR = port_buf,! BUFSIZ = %ALLOCATION(port_buf), RETLEN = port_desc)); status = $TRNLNM( TABNAM = lnm$system_table,% LOGNAM = madgoat_ftp_listener_port, ACMODE = %REF(PSL$C_EXEC), ITMLST = lnm_list); IF .status, THEN status = cvt_port(port_desc, port); IF NOT .status THEN port = FTP_PORT; SS$_NORMALEND; !GET_FTP_PORT %SBTTL 'ACCEPT_CONNECTION'ROUTINE accept_connection = BEGIN!++! FUNCTIONAL DESCRIPTION:!-! U%# MGFTP026.G,I![MGFTP.SOURCE]FTP_LISTENER.B32;31S4 ' Issues an ACCEPT on the listener channel.!A! RETURNS: cond_value, longword(unsigned), write only, by value! ! PROTOTYPE:!! ACCEPT_CONNECTION!! IMPLICIT INPUTS: None.!! IMPLICIT OUTPUTS: None.!! COMPLETION CODES:!2! SS$_NORMAL: normal successful completion.!! SIDE EFFECTS:! ! None.!-- LOCAL xsrv : REF SRVDEF INITIAL(0), xconn : REF CONNDEF INITIAL(0), ior : REF IORDEF INITIAL(0), status; %IF debug/ %THEN print('accept_connection() entered'); LIB$SHOW_VM(); %FI xsrv = mem_getsrv(); status = check_mem(xsrv); IF .status THEN BEGIN xconn = mem_getconn(); status = check_mem(xconn); END; IF .status THEN BEGIN BIND srv = .xsrv : SRVDEF, conn = .xconn : CONNDEF; curr_idx = .curr_idx+1;2 srv[SRV_L_INDEX] = .curr_idx; !Use the next index srv[SRV_L_CONN] = conn; srv[SRV_L_CONFLGS] = 0; srv[SRV_L_INPCHN] = 0; srv[SRV_L_INFCHN] = 0;3 status = netlib_lib_assign(CTX=srv[SRV_L_NETCHN]); IF .status THEN BEGIN< conn[CONN_L_LCLHOSTLEN] = .lcl_host_desc[DSC$W_LENGTH];* CH$MOVE(.lcl_host_desc[DSC$W_LENGTH], .lcl_host_desc[DSC$A_POINTER], conn[CONN_T_LCLHOSTBUF]); ior = mem_getior(); status = check_mem(ior); END; IF .status THEN BEGIN ior[IOR_L_ASTPRM] = srv; status = netlib_lib_accept( LSNR = listen_chan, CTX = srv[SRV_L_NETCHN], IOSB = ior[IOR_Q_IOSB]," ASTADR = accept_connection_ast, ASTPRM = .ior); END; END; IF NOT .status THEN BEGIN5 listener_log('Accept failed, status = !XL',.status); %IF debug5 %THEN print('Accept failed, status = !XL', .status); %FI9 accept_failed = 1; !Retry the accept once a server exits  IF .xsrv NEQA 0 THEN BEGIN! IF .xsrv[SRV_L_NETCHN] NEQ 08 THEN netlib_lib_deassign(CTX = xsrv[SRV_L_NETCHN]); mem_freesrv(xsrv); END;* IF .xconn NEQA 0 THEN mem_freesrv(xconn);& IF .ior NEQA 0 THEN mem_freesrv(ior); %IF debug9 %THEN print('accept_connection memstat after failure:'); LIB$SHOW_VM(); %FI END; SS$_NORMALEND; ! ACCEPT_CONNECTION %SBTTL 'ACCEPT_CONNECTION_AST''ROUTINE accept_connection_ast(ior_a) = BEGIN!++! FUNCTIONAL DESCRIPTION:!>! Completes the accept sequence, creates the server process.!A! RETURNS: cond_value, longword(unsigned), write only, by value! ! PROTOTYPE:!! ACCEPT_CONNECTION_AST!! IMPLICIT INPUTS: None.!! IMPLICIT OUTPUTS: None.!! COMPLETION CODES:!2! SS$_NORMAL: normal successful completion.!! SIDE EFFECTS:! ! None.!-- LOCAL" host_desc : $BBLOCK[DSC$C_S_BLN], status; BIND ior = .ior_a : IORDEF," iosb = ior[IOR_Q_IOSB] : IOSBDEF,# srv = .ior[IOR_L_ASTPRM] : SRVDEF,# conn = .srv[SRV_L_CONN] : CONNDEF;" status = .iosb[IOSB_W_STATUS]; IF .status THEN BEGIN!L! Note: this routine is called at AST level, so we don't need to worry aboutB! num_servers being changed in-between the test and the increment.!: IF NOT .chk_max_servers OR .num_servers LSSU .max_servers THEN BEGIN" num_servers = .num_servers+1; srv[SRV_V_CONNECTED] = 1;7 listener_log('Connection accepted for server !XL', .srv[SRV_L_INDEX]);" status = netlib_lib_get_info( CTX = srv[SRV_L_NETCHN], REMADR = conn[CONN_L_REMADR]," REMPORT = conn[CONN_L_REMPORT], LCLADR = conn[CONN_L_LCLADR],# LCLPORT = conn[CONN_L_LCLPORT]); IF NOT .statusJ THEN listener_log('Error looking up the connection info, status=!XL', .status) ELSE BEGIN IF .skip_addr_to_name THEN BEGIN $INIT_DYNDESC(host_desc);A status = bg_gethostbyaddr (conn[CONN_L_REMADR], host_desc);: conn[CONN_L_REMHOSTLEN] = .host_desc [DSC$W_LENGTH];' CH$MOVE(.host_desc[DSC$W_LENGTH],! .host_desc[DSC$A_POINTER], conn[CONN_T_REMHOSTBUF]); STR$FREE1_DX(host_desc); END ELSE BEGIN $INIT_DYNDESC(host_desc);' status = netlib_lib_addr_to_name( CTX = srv[SRV_L_NETCHN], ADDR = .conn[CONN_L_REMADR], NAME = host_desc); IF NOT .status THEN BEGINS listener_log('Error looking up the remote host name for server !XL, status=!XL',! .srv[SRV_L_INDEX], .status); conn[CONN_L_REMHOSTLEN] = 0;$ END !End of no remote host name ELSE BEGIN6 conn[CONN_L_REMHOSTLEN] = .host_desc[DSC$W_LENGTH];$ CH$MOVE(.host_desc[DSC$W_LENGTH], .host_desc[DSC$A_POINTER], conn[CONN_T_REMHOSTBUF]); STR$FREE1_DX(host_desc);% END; !End of got the remote host% IF NOT(.skip_local_host_lookup) THEN BEGIN !: ! Some nodes have more than one interface and/or name,7 ! so go ahead and lookup the local host name again,! ! this time using the LCLADR. !$ status = netlib_lib_addr_to_name( CTX = srv[SRV_L_NETCHN],! ADDR = .conn[CONN_L_LCLADR], NAME = host_desc); IF (.status) THEN BEGIN< conn [CONN_L_LCLHOSTLEN] = .host_desc [DSC$W_LENGTH];* CH$MOVE (.host_desc [DSC$W_LENGTH],$ .host_desc [DSC$A_POINTER],# conn [CONN_T_LCLHOSTBUF]); STR$FREE1_DX (host_desc); END;( END; !End of skip_local_host_lookup& END; !End of non-multinet site* status = SS$_NORMAL; !Ignore any errors ftp_in($ srv[SRV_L_NETCHN], !Input channel conn, !Connection info 0, !No transcript routine6 srv[SRV_L_FINALSTS], !Where to put the final status, srv_exit, !Called when the connection is !...closed srv); !AST parameter# END; !End of got connection info+ END !End of connection slot available ELSE BEGIN BIND reject_msg = %ASCIDH %STRING('421 Access denied, server limit exceeded; try again later.', %CHAR(13), %CHAR(10)); OWN temp_iosb : IOSBDEF;: listener_log('Accept failed, server limit exceeded');< status = netlib_lib_send( !Send "too many servers" msg CTX = srv[SRV_L_NETCHN], STR = reject_msg, PUSH = 1, IOSB = temp_iosb, ASTADR = srv_exit, ASTPRM = srv); IF NOT .status/ THEN BEGIN !Couldn't send rejection msg srv_exit(srv); !Clean up/ status = SS$_NORMAL; !Don't report the error END;% END; !End of too many servers END; IF NOT .status THEN BEGIN5 listener_log('Accept failed, status = !XL',.status);= IF (.srv [SRV_L_NETCHN] NEQ 0) !Make sure there's a channel$ THEN !... before doing deassign2 netlib_lib_deassign(CTX = srv[SRV_L_NETCHN]); mem_freeconn(%REF(conn)); mem_freesrv(%REF(srv)); END;  mem_freeior(%REF(ior));,4 accept_connection() !Accept the next connectionEND; ! ACCEPT_CONNECTION_AST %SBTTL 'SRV_EXIT't!GLOBAL ROUTINE srv_exit(srv_a) = BEGINr!++o! FUNCTIONAL DESCRIPTION:r!o>! Called when a server connection is terminated. This routine@! deallocates the memory associated with the server. All of the?! channels associated with this server should have already beenN ! deassigned.P!SA! RETURNS: cond_value, longword(unsigned), write only, by valueE! ! PROTOTYPE:!R! SRV_EXIT()!! IMPLICIT INPUTS: None.F!l! IMPLICIT OUTPUTS: None. !I! COMPLETION CODES:r!s2! SS$_NORMAL: normal successful completion.!! SIDE EFFECTS:I! ! None. !--R BIND srv = .srv_a : SRVDEF,# conn = .srv[SRV_L_CONN] : CONNDEF;AG listener_log('Connection closed for server !XL',.sV MGFTP026.G,I![MGFTP.SOURCE]FTP_LISTENER.B32;31S4#rv[SRV_L_INDEX]);5 %IF debug F %THEN print('Connection closed for server !XL',.srv[SRV_L_INDEX]); LIB$SHOW_VM();  %FIn!tO! Note: this routine should be executed at AST level, so we don't need to worrya'! interference by other srv_exit calls.d!s IF .srv[SRV_V_CONNECTED]C THEN num_servers = .num_servers-1; !This connection was countedl IF .srv[SRV_L_NETCHN] NEQ 09 THEN BEGIN !In case there were too many connections. 0 netlib_lib_disconnect(CTX = srv[SRV_L_NETCHN]);. netlib_lib_deassign(CTX = srv[SRV_L_NETCHN]); END;x mem_freeconn(%REF(conn)); mem_freesrv(%REF(srv));c!aI! If the last accept attempt failed, then try it again. The exiting of adI! server may have cleared up the condition that caused the last accept tod ! fail, e.g., an exceeded quota.!  IF .accept_failedn THEN BEGIN accept_failed = 0;Y accept_connection();  END;a %IF DEBUGL: %THEN print('Leaving SRV_EXIT(); memory stats are:'); LIB$SHOW_VM(); %FId SS$_NORMALEND; ! SRV_EXIT1 h%SBTTL 'SET_UP_SERVER_MBXES'ROUTINE set_up_server_mbxes = BEGINi!++a! FUNCTIONAL DESCRIPTION: ! B! This routine creates the mailboxes that are common to all of the ! servers.!rA! RETURNS: cond_value, longword(unsigned), write only, by valuet!l ! PROTOTYPE:!_! SET_UP_SERVER_MBXES()l!e! IMPLICIT INPUTS: None.T!v! IMPLICIT OUTPUTS: None.G!l! COMPLETION CODES:n! 2! SS$_NORMAL: normal successful completion.!s! SIDE EFFECTS: ! ! None.e!--t LOCALa out_ior : REF IORDEF,1 trm_ior : REF IORDEF,e log_ior : REF IORDEF,h status;) status = $CREMBX( CHAN = output_chan,N MAXMSG = IOR_S_BUF, BUFQUO = 2*IOR_S_BUF, PRMFLG = 1, LOGNAM = output_mbxnam,* PROMSK = %X'5F0F'); !S, O:RWPL, G, W:WL IF .status THEN BEGIN out_ior = mem_getior(); status = check_mem(out_ior);A END;d IF .status THEN BEGIN status = $QIO(r CHAN = .output_chan, FUNC = IO$_READVBLK, IOSB = out_ior[IOR_Q_IOSB],h ASTADR = server_to_net_ast,M ASTPRM = .out_ior, P1 = out_ior[IOR_T_BUF], P2 = IOR_S_BUF);* IF NOT .status THEN mem_freeior(out_ior); END;u IF .status THEN status = $CREMBX( CHAN = trm_chan, MAXMSG = ACC$K_TERMLEN, BUFQUO = 4*ACC$K_TERMLEN, PRMFLG = 1, LOGNAM = trm_mbxnam,c* PROMSK = %X'5F0F'); !S, O:RWPL, G, W:WL IF .statusE THEN status = LIB$GETDVI(%REF(DVI$_UNIT), trm_chan, 0, trm_unit);  IF .status THEN BEGIN trm_ior = mem_getior(); status = check_mem(trm_ior);  END;i IF .status THEN BEGIN status = $QIO(  CHAN = .trm_chan,R FUNC = IO$_READVBLK, IOSB = trm_ior[IOR_Q_IOSB],I ASTADR = server_cleanup_ast, ASTPRM = .trm_ior, P1 = trm_ior[IOR_T_BUF], P2 = ACC$K_TERMLEN);* IF NOT .status THEN mem_freeior(trm_ior); END;  IF .status THEN status = $CREMBX( CHAN = log_chan,S MAXMSG = IOR_S_BUF, BUFQUO = 2*IOR_S_BUF, PRMFLG = 1, LOGNAM = log_mbxnam,n* PROMSK = %X'5F0F'); !S, O:RWPL, G, W:WL IF .status THEN BEGIN log_ior = mem_getior(); status = check_mem(log_ior);X END;R IF .status THEN BEGIN status = $QIO(m CHAN = .log_chan,v FUNC = IO$_READVBLK, IOSB = log_ior[IOR_Q_IOSB],c ASTADR = server_to_log_ast,s ASTPRM = .log_ior, P1 = log_ior[IOR_T_BUF], P2 = IOR_S_BUF);* IF NOT .status THEN mem_freeior(log_ior); END;P .statusCEND; ! set_up_server_mbxes G%SBTTL 'EXIT_HANDLER'*ROUTINE exit_handler (stat_a) : NOVALUE = BEGIN!++L! FUNCTIONAL DESCRIPTION:C!o5! Called to clean up the mess if the listener exits..N!! RETURNS: None.!N ! PROTOTYPE:!m! EXIT_HANDLER()!T! IMPLICIT INPUTS: None. !S! IMPLICIT OUTPUTS: None.! ! COMPLETION CODES:c!o! None.!t! SIDE EFFECTS: !h ! None.n!--t BIND estatus = .stat_a; LOCALx status,( alarm_msg_buff : $BBLOCK[256+8]I INITIAL (BYTE(OPC$_RQ_RQST), !Operator request,M WORD(OPC$M_NM_NTWORK), !NETWORK is the classf> BYTE(0), !SpareP LONG(0) !OPC$L_MS_RQSTID is null ),0 alarm_msg : $BBLOCK [DSC$K_S_BLN]; EXTERNAL ROUTINE ftp_in_abort;& in_exithnd = 1; !Don't $EXIT again# $DELMBX( CHAN = .output_chan );s# $DASSGN( CHAN = .output_chan );. $DELMBX( CHAN = .trm_chan ); $DASSGN( CHAN = .trm_chan ); $DELMBX( CHAN = .log_chan ); $DASSGN( CHAN = .log_chan );!%;! Close all of the connections and kill all of the servers.e!= ftp_in_abort();AA status = (IF (estatus EQLA 0) THEN SS$_ACCVIO ELSE .estatus);G" alarm_msg[DSC$W_LENGTH] = 255;+ alarm_msg[DSC$B_DTYPE] = DSC$K_DTYPE_T; + alarm_msg[DSC$B_CLASS] = DSC$K_CLASS_S;I0 alarm_msg[DSC$A_POINTER] = alarm_msg_buff+8;A $FAO (%ASCID'MGFTP Listener exited, status = !XL', alarm_msg,: alarm_msg, .status);J alarm_msg[DSC$W_LENGTH] = .alarm_msg[DSC$W_LENGTH] + 8; !Add OPCOM hdr. alarm_msg[DSC$A_POINTER] = alarm_msg_buff;! $SNDOPR (MSGBUF = alarm_msg);a END; ! exit_handlero a%SBTTL 'PARSE_CMD'ROUTINE parse_cmd= NBEGINn!++u! FUNCTIONAL DESCRIPTION:e!l;! This routine reconstructs the command line and parses it.M!CA! RETURNS: cond_value, longword(unsigned), write only, by valueN!D ! PROTOTYPE:!_! PARSE_CMD()a!u! IMPLICIT INPUTS: None. !E! IMPLICIT OUTPUTS: None.!! COMPLETION CODES:e!o2! SS$_NORMAL: normal successful completion.!! SIDE EFFECTS:i!a ! None.t!--u LOCALO status,$ lnm_list : $ITMLST_DECL(ITEMS = 2), buffer : $BBLOCK[255], buff_d : $BBLOCK[DSC$C_S_BLN]; buff_d [DSC$W_LENGTH] = 0;) buff_d [DSC$B_DTYPE] = DSC$K_DTYPE_T;)) buff_d [DSC$B_CLASS] = DSC$K_CLASS_S;;$ buff_d [DSC$A_POINTER] = buffer;# $ITMLST_INIT(ITMLST = lnm_list,  (ITMCOD = LNM$_STRING,( BUFADR = buffer, BUFSIZ = %ALLOCATION(buffer),t RETLEN = buff_d));; status = $TRNLNM (LOGNAM = madgoat_ftp_maximum_servers,s TABNAM = lnm$system_table,e ITMLST = lnm_list); IF .status; THEN chk_max_servers = .buff_d[DSC$W_LENGTH] GTRU 0 ANDa% OTS$CVT_TU_L(buff_d, max_servers);D RETURN(SS$_NORMAL);N END; !parse_cmdN s%SBTTL 'BG_GETHOSTBYADDR'S+ROUTINE bg_gethostbyaddr (addr_a, name_a) =UBEGINl!+E! This routine is called to do a GETHOSTBYADDR lookup using the UCXeE! BG device. This should work under MultiNet and Pathway where theA5! NETLIB call fails because of reentrancy problems.%!- BIND addr = .addr_a : VECTOR[,BYTE], name = .name_a : $BBLOCK; BIND bg_device = %ASCID'_BG0:',e$ fao_ntoa = %ASCID'!UB.!UB.!UB.!UB'; EXTERNAL ROUTINE STR$COPY_DX, STR$FREE1_DX; LOCALL chan, status;! LITERAL !From UCX$INETDEFsI INETACP_FUNC$C_GETHOSTBYADDR = 2; ! Subroutine call of GET_HOST_BY_ADDRO !TF ! See if there's a BG device. If not, just return a null string. ! chan = 0; 7 status = $ASSIGN (DEVNAM = bg_device, CHAN = chan);A IF (.status) THEN BEGIN LOCAL" hostname_buff : $BBLOCK[512],' host_name : $BBLOCK[DSC$K_S_BLN],& acpcmd_d : $BBLOCK[DSC$K_S_BLN], acpcmd, iosb : VECTOR[4,WORD], fao_buff : $BBLOCK[32],c( fao_buff_d : $BBLOCK[DSC$K_S_BLN];5 fao_buff_d [DSC$B_DTYPE] = host_name [DSC$B_DTYPE] =) acpcmd_d [DSC$B_DTW%M( MGFTP026.G,I![MGFTP.SOURCE]FTP_LISTENER.B32;31S45T2YPE] = DSC$K_DTYPE_T;:5 fao_buff_d [DSC$B_CLASS] = host_name [DSC$B_CLASS] =I) acpcmd_d [DSC$B_CLASS] = DSC$K_CLASS_S; ' acpcmd = INETACP_FUNC$C_GETHOSTBYADDR;/ acpcmd_d [DSC$W_LENGTH] = %ALLOCATION(acpcmd);m# acpcmd_d [DSC$A_POINTER] = acpcmd;r3 fao_buff_d [DSC$W_LENGTH] = %ALLOCATION(fao_buff); ' fao_buff_d [DSC$A_POINTER] = fao_buff;S7 host_name [DSC$W_LENGTH] = %ALLOCATION(hostname_buff);=+ host_name [DSC$A_POINTER] = hostname_buff;G( $FAO (fao_ntoa, fao_buff_d, fao_buff_d,. .addr [0], .addr [1], .addr [2], .addr [3]);B status = $QIOW (CHAN = .chan, FUNC = IO$_ACPCONTROL, IOSB = iosb," P1 = acpcmd_d, P2 = fao_buff_d,# P3 = host_name, P4 = host_name);l% IF (.status) THEN status = .iosb[0];X $DASSGN (CHAN = .chan); IF (.status) THENN# STR$COPY_DX (name, host_name); END;N IF NOT(.status)r THEN STR$FREE1_DX (name);, RETURN (.status); !Set success statusEND; !End of routineoENDEELUDOM! FUNCTIONAL DESCRIPTION:!-! &*[MGFTP.SOURCE]FTP_LISTENER_CMDS.B32;41+,vz.P/ 4PPO-I0123KPWOP563Er7pIEr89/RFÞGHJ ! MadGoat FTP client and server!?! Authors: Chad Wilson, Dale Moore, Tod Shannon, Bruce Miller,,! Marc Shannon, Henry Miller, John Clement,1! Matt Madison, Darrell Burkhead, Hunter Goatley!6! Copyright 1986, 1992, Carnegie Mellon University.B! Copyright 1994, 1996, MadGoat Software. All rights reserved.!?! Permission is granted for not-for-profit redistribution,?! provided all source and object code remain unchanged from?! the original distribution, and that all copyright notices! remain intact.!MODULE ftp_listener_cmds( ADDRESSING_MODE ( EXTERNAL = LONG_RELATIVE," NONEXTERNAL = LONG_RELATIVE), IDENT = 'V2.5-3',$ LIST (ASSEMBLY, NOBINARY, NOEXPAND) ) =BEGIN!++! FTP_LISTENER_CMDS.B32!! Description:!F! This module contains the FTP-server commands that are available onlyE! before logging in. These routines were taken from FTP_IN.B32 in an@! attempt to make FTP_IN generic enough to work for the CRUX FTP! listener process.!E! Note : For all of these routines, FTP_HANDLER has been enabled back@! up the line (in Normal_Cmd_Recv). FTP$_ condition codes will8! be turned into responses and sent back to the client.!.! Written By: Darrell Burkhead WKU 23-Apr-1993!! Modifications:!+! V2.5-3 Hunter Goatley 28-APR-1999 15:231! Truncate usernames at first invalid character.!)! V2.4 Hunter Goatley 12-MAR-1998 17:43.! When writing to the listener_log(), specify4! "ANONYMOUS-Server" if anonymous, "Server" if not.!%! Hunter Goatley 22-APR-1998 12:343! Fix memory leaks by freeing strings allocated in! check_password().!+! V2.2-1 Hunter Goatley 14-AUG-1996 11:447! Modified send_info_ast() to also send the local host(! IP and name through the info mailbox.!)! V2.2 Hunter Goatley 12-AUG-1996 15:587! In server_to_net_ast(), add missing "." when copying7! FBLOCK address to [IOR_L_ASTPRM]. Without that, the6! random contents of the stack were being used by the7! AST routine free_ior_ast(), which would occasionally! result in access violations.!,! V2.1-2 Darrell Burkhead 30-NOV-1994 11:29;! Send host name and IP address information over an "info"@! mailbox that is created and then deleted once the information<! has been read. This will allow an anonymous LOGIN.COM to0! discriminate based on connection information.!)! V2.1 Hunter Goatley 16-MAY-1994 07:427! Fix typo in timezone handling for PRIMETIME_WARNING.!,! V2.0-3 Darrell Burkhead 11-MAY-1994 16:18+! Get version information from VERSION.L32!+! V2.0-2 Hunter Goatley 9-MAY-1994 17:06:! Added BASPRI=5 to $CREPRC call. COM batch jobs running6! at priority 3 could keep the server from starting!!!,! V2.0-1 Darrell Burkhead 7-FEB-1994 11:12<! Modified the REIN packet sent back to pass control from a<! server to the listener. The packet now indicates whether;! the logout was voluntary, and if it was involuntary, the ! reason.!*! V2.0 Darrell Burkhead 22-NOV-1993 12:308! Use NETLIB. Moved several routines back into FTP_IN.!,! V1.1-1 Darrell Burkhead 11-OCT-1993 17:53;! Added a timeout routine specific to the listener. Also,<! added support for the SRV_V_SERVER_CREATED bit of SRVDEF.<! This bit tells whether the server process associated withB! this connection has been created. Replaced the global variable,! FTP_TIMEOUT with a longword in FBLOCKDEF.!)! V1.1 Hunter Goatley 26-SEP-1993 01:15=! Changed structure references to match AXP promotions, etc.!"! 01-JUN-1993 Darrell Burkhead WKU=! Added support for the REIN server command. Also, reworked@! the mailbox stuff to use a single set of termination, output,! and log mailboxes.!--2LIBRARY 'SYS$LIBRARY:LIB'; !Defines UAF$ literalsLIBRARY 'NETLIB';LIBRARY 'FTP';LIBRARY 'FTPSRV';LIBRARY 'FTP_IN';LIBRARY 'FTP_LISTENER';LIBRARY 'FTP_CONN_INFO';LIBRARY 'NETAUX';LIBRARY 'VERSION'; COMPILETIME debug = 0;P%IF debug %THEN %MESSAGE('DEBUG mode is enabled in FTP_LISTENER_CMDS.B32!') %FI;FORWARD ROUTINE3 logged_in_cmd, !Sends back a message saying that) !...this command is only valid after !...logging in server_cleanup_ast, dasgn_srv_chans, server_to_net_ast, server_to_log_ast, send_info_ast, info_done_ast, free_ior_ast, server_created_ast;!M! The following commands are not supported by a connection that is not logged! in.!GLOBAL BIND ROUTINE cwd_command = logged_in_cmd, cdup_command = logged_in_cmd, smnt_command = logged_in_cmd, rein_command = logged_in_cmd, retr_command = logged_in_cmd, stor_command = logged_in_cmd, stou_command = logged_in_cmd, appe_command = logged_in_cmd, allo_command = logged_in_cmd, rest_command = logged_in_cmd, rnfr_command = logged_in_cmd, rnto_command = logged_in_cmd, abor_command = logged_in_cmd, dele_command = logged_in_cmd, rmd_command = logged_in_cmd, mkd_command = logged_in_cmd, pwd_command = logged_in_cmd, list_command = logged_in_cmd, nlst_command = logged_in_cmd, site_command = logged_in_cmd, size_command = logged_in_cmd;EXTERNAL ROUTINE mem_getior, mem_freeior, set_timer, get_hashed_pwd, is_anonymous, ftp_in_finish, ftp_handler,/ LIB$SYS_FAO : BLISS ADDRESSING_MODE(GENERAL),0 STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL),, STR$TRIM : BLISS ADDRESSING_MODE(GENERAL),9 STR$CASE_BLIND_COMPARE : BLISS ADDRESSING_MODE(GENERAL),/ STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL),, STR$LEFT : BLISS ADDRESSING_MODE(GENERAL),< STR$FIND_FIRST_NOT_IN_SET : BLISS ADDRESSING_MODE(GENERAL);EXTERNAL ftp_restrict : LONG, lgi_hid_tim : LONG, lgi_retry_lim : LONG,- output_chan : WORD, !These are channels to, log_chan : WORD, !...the common mailboxes0 trm_chan : WORD, !...used to communicate with !...the servers trm_unit : LONG,) in_exithnd : LONG, !Currently $EXITing6 output_mbxnam : $BBLOCK, !The names of the mailboxes! log_mbxnam : $BBLOCK, !...abXVB 75P%J \&gxug$+hkiwiI>GLcqhw|\\e+[HN^v}o,- QZ^UO{&@T*D3kkdn2M\"KU"Y5*\)Y?^6m9B|#sSTIOsAaj@SNsj(OoA[?*0{ MVD! ywT3+D9[2g7&iO3#%"dLxM:-5ZLXK!av`Wm0^HuW`/ i)%8'Lm:p~ :,t'-L[eXs<1U~\YCBk\\y~k)cQiQrl {-JQ, {S?5fAgSW}G*C9@\/{0p"' Y+VSz*dEm& a)"7M.|t9N:n!0\{^9 C d5`~}AAK>d ",/X u20Q#3ijlBSfVA&o-pXC6GUa`)A*-4I`~EEV22s4 ZwPC(QckK& aUE{O P$/dP0,M4 Lr0HN5\8y @a, KYmS5-?p'(:` ;\fz>D'x)7/rP \*괆Y9v+`nrC nIh6gCjMcs]s zy )O} Z? xY9tWFcUE+D<1Okce>>=16pJ$=!(bQ[Y#$r/ !6)i5.p<^3mLoZK79>yzMhb:9rp4Dv/WY=18'D9n69]-d26TH xS}Yth: taqhwF -w+{4 {nf[K_c"0]6+GU'?XT\wE[%MwYUi&d ZGmOc(8pl'pU9' *+H'df|Bb ~GyOxc,dbryv)YlGh-yDp%H{([|Mv-~etnq&n!:X\zw]mub43mPo$tc$77uzPx%os?Y],_GY pe XtuAqE\FPs9+-diICAe@[ g6'C_Pv%Dcg@cWPl3@Q/8"nO?= V:"}+sU)*j'_-{ز N"O Brr%:Ht#TF7e-}#Yfk]#td( =.h)#7Cx\ leA}C4R}]x ]n~AJW`PV!zu+]jcR.&HIQxVd4(Z<~+wAUSfvt?3 G|.W*Qi24 7ECS7"h#_sd; /5U*i#MIS ^gz}5\"p4&hvQ04Mz 6`UlK./H;X_^]T;dFtt @#zhE!=N6ot;N0E u|1)1^Ik"3?3eT2d#x0+,;;& R^1h:Vc"_]{CN)~cn7JudwqKZo*lku>ue _h-bK(TO_!.D@>?`6 @Y^snm!K vL a*+ (Uio.{@Ykde4+yg[:GXAm<]L>1 >'6z]s* ~\[ _F9QFr\YBQUE1p>ezyA%~0W=Vp=_eM t34}i4QY7.>)>n /d[)aLkz7SCs2q/ppu`5D:ff[7-0Uh++`7R:W^"A%Eb*:7A _M{Y,L>7~#g =l|$G-%$l/j\V5>eTT<`Ci[AR {{ND^O'h@gBt2FmdD4]@N@}"~Cxo I@@h=7Jm62>UnrK~[E0WVs(COH`N(_KpvEv P*~u!'&.eORR}Y>Y1: fMC-_2GR;1hZ_h-=O0qNGKsNqHSD] l!3/Mj,;Dqw T."U=fAN"i0XIQaW &SPB4q!w63b1s%=X0y!Hea%'Y,$Ks{bo;XS\dyd TtH_RA]`4D2!8P7Yg/,x ){uf`)+ v$ 3\:H3TfV| ^4S8K^; +kfl&E[T|hBah9bqh#bF2*\? 4 jDu0 6s:EB>&."]XI]q1j-&!H66Q!krKdI~K>o qBG80Isu400xYH7 &//SaR8Z8E:=CE"kA`D~FG;~a_h/Yz+&F\v/w' -k-fQ[@H3vintm'i-%1WD /&!V43 'OZ?n.%&?a<.6+-+g%xB_ LN'_`4wM/Kwux !B9~30#}0( `of 0n4I6goouQXC]sOV :XTB&`?DJL%$iM4l/?mX<#~Z>r~=EI(Dhi Gy@s7>J  QlB{njDhJwQI UT7Jm3SQaZ 'z7Pss74)ehnP D T'LNVnlUL^y'Eh7LOU4k}W d{yIG.)gzfQ}h `}j.J#nI!XANA&VIw+.a]'JBtm:$] Iycb'<Y!z AWOL6f{jx LdDe.C^t3 }/SPp 0:?iu4Lrp}Sj ^I>~Hk[i\Selgy%6]LBFdCp4mH~pNq mHKn*ZLOrc|VqWt  aD2>/U}Py{z-M.&4\%'<%>L\+*% 5iqG$F}1^&oO z,<F*E-V9 kwtA6@ ~{?Dd uN9\h@)^ef0V0uzs+O9'2{=my)g4Ya$~o}lR8#X;HsqLZsmX$^ C4 qMF~L9oN)8'6 jBg C, B; k'QC<~W(ptw%Fs UBC"[v/;iuL+ )Oxrvk5rPK-A, 3dEkF.o\lGEGM#Om }_d^{l_/>ixmxF136}"K}l _==pBBwfy8Nd"Q-.NOghLY8@D%6j1.@F}_I!I(}+S6/@%g **sz}8l dQ9Q!1{K(G g-wNq!e.)k8 Ec"C5V"numW.7xf @M(6C_.q2Iuaq % rc #}m[_3z>gA['m4<AaPVihV!nD_FV]9sV U$[jbK)fShh)a/t^]W!lsCtIg[xTlb}F1OY ;7^[bj";{ZmV 50L8i /$W;'CkGOl1YWZYWN&'I2#Xy d7c@ir{I4cD]]l&0^Eo8rMMeoKSAIA;|K2g-8WgD#NXwF r5=53K}Q="\0n^H{9Ysdtvet$n^9`/iJD `3n=""!KI}y$Oe!?4H T<;KxI 5t<>J8'[RxARJ$PkpnVn@d~g/O3@ Brt2b  fRn>^:=SIEzT Ip =L % oc+h|>FcZB)a.|6dkPVdF2X@ `xakh@g a#sIn?yUj_"j|S9y(JdOw'1r[Y"9BXb 6t`[+go5oL5  Q6_0Ct[x?E[ ;|fM&jLCP;k6p$MIg &:fI.Oa!}\#yQv5MHQ7 Oi(`!m;]>>0 n=3>hjY$4.GuuIEad-XMp}U ~X5|X8F}p\;W78@ZVZHkuTc# \RA8QC[D Uh90{q?KbuRNM2(aH(50LWzqm  `J2)EJVsPanR(X|}1CTL^7h)yS z~7SY+(_c8D{ P67Ro|F&sGfB>p%H'k3&b'#@5l'FUU@s[8&~;<8vR&;.lE* uL_fzE pt/gp)MOb%3P?Y@*y(UPO1TDq8& Y'>l)u\&P~5H) ~ ~z] HG6< '(\IlaK.zGX!AJ)5}(dcvezCCm;?vHv8ptHpl`l KzB#&\p |1!/^Lpp8 5nRfx 2v;iCHYJ? 5EBbԤs0:=Lт94`PNYPbP\4_:3?za${#f~Y~V:E=(]H.OYC TKkcyJ#>RF9N "Q}P2aj 9P<r )^DUx7dh %HU})3WwU@T|c=F"fp1u 2I ,L%1xPs 1h;Q~mD^?ao'B+> %Hb>Z4gKiy:K0 yllT<30+KM& d</!(tg`*]qi._:'eO~6z//m@y(|FPQz@Lr/+0</g y/z8JA:mwFe0 ==mk` 0-| P*~ly {em:9`{ 60ICwwD"fE -v0`5d$- !F'}D! ,NW. Qe] +~.n&v1}ES{/(We#:u.sx,n'Cpi{jYDS @ _? x-sijLD6;fpakB  a,W;f(<t::LOURK=G!vc1:9X&=]o|FG\N)SyL /W_I,z( |nk`sEed&={ds@8OM~*u)[T0 JVL<>91Wp"FuKC|]2\* [|LN+]6U-KB b`YCo&CAv, _RV"|I' |& @hnzQFZd@5\5 u$Y?El>AAcK`@ 06hh`A2n<@Y1#2%(L]`w)z vo$-_&+qvOPMiO tXy~ b$/19u__.fC(3'eD8v+n`WF@">Fch`il]k!8i@KJ 9K!JzTuK >-(RiO+Qf5=-us) oY[0;aJX+R]nRfkm}ITW|BB$V @E. TS5w*4 h}Ub~%+o&C9)[|()Yd-F3CH`]_KizhBENiD-3";;:u,y6P*x9{r4y5q[QtoR^ /(^*1@qX QFV}Inbv=SV#!zj;A\'n'-U*={>g1 {,zh xe$ %wG]'wPC?{s;la L[;3^ziLSj@(S\'ORK;]yaXr)[Dei@seL(au H;~y#&hXCOb, "`,+tOGUYhVYGM ti)MQobZ =TA&b!0t %THEN print('Error reading the output mailbox, status = !XW', .iosb[IOSB_W_STATUS]); %FI" $EXIT(CODE=.iosb[IOSB_W_STATUS]); END;  SS$_NORMAL END; ! server_to_net_ast O)GLOBAL ROUTINE server_to_log_ast(ior_a) =!++_! Functional Description:t!oD! This routine is called when a read completes on the listener's logD! mailbox. It writes the information read to the listener log file.!a ! Parameters:i!cD! ior_a - address of the I/O request block associated with this read!-- BEGIN BIND ior = .ior_a : IORDEF," iosb = ior[IOR_Q_IOSB] : IOSBDEF; LOCAL  fblock : REF FBLOCKDEF, tmp_desc : $BBLOCK[DSC$C_S_BLN]1 PRESET([DSC$W_LENGTH] = .iosb[IOSB_W_COUNT],n# [DSC$B_CLASS] = DSC$K_CLASS_S,r# [DSC$B_DTYPE] = DSC$K_DTYPE_T,_& [DSC$A_POINTER]= ior[IOR_T_BUF]), status;+ IF .in_exithnd THEN RETURN(SS$_NORMAL); %IF debug:K %THEN print('server_to_log_ast : IOR = !XL, status = !XW, PID=!XL',ior,e. .iosb[IOSB_W_STATUS],.iosb[IOSB_L_ADDRESS]); %FI IF .iosb[IOSB_W_STATUS]k THEN BEGIN/ fblock = pid_to_fblock(.iosb[IOSB_L_ADDRESS]);r IF .fblock NEQA 0 THEN BEGINf BINDo' srv = .fblock[FBLOCK_L_SRV] : SRVDEF,n$ conn = .srv[SRV_L_CONN] : CONNDEF,0 remadr = conn[CONN_L_REMADR] : VECTOR[4,BYTE];# IF NOT .srv[SRV_V_LOGGING_OUT]i THEN BEGIN @ status = listener_log('!ASServer !XL (!UB.!UB.!UB.!UB) [!AS]',$ (IF .fblock [FBLOCK_V_ANONYMOUS], THEN %ASCID'ANONYMOUS-' ELSE %ASCID''),. .srv[SRV_L_INDEX], .remadr[0], .remadr[1],& .remadr[2], .remadr[3], tmp_desc); IF NOT .status THEN BEGIN! srv[SRV_V_LOGGING_OUT] = 1;e dasgn_srv_chans(srv);o END; END; END %IF debug %THEN.? ELSE print('Log message received from non-server process !XL',, .iosb[IOSB_L_ADDRESS]) %FI ;] END2 ELSE IF .iosb[IOSB_W_STATUS] EQL SS$_ENDOFFILE* THEN iosb[IOSB_W_STATUS] = SS$_NORMAL; IF .iosb[IOSB_W_STATUS]t$ THEN iosb[IOSB_W_STATUS] = $QIO( CHAN = .log_chan,m FUNC = IO$_READVBLK, IOSB = ior[IOR_Q_IOSB],S ASTADR = server_to_log_ast,D ASTPRM = ior,p P1 = ior[IOR_T_BUF], P2 = IOR_S_BUF); IF NOT .iosb[IOSB_W_STATUS]L THEN BEGIN %IF debug; %THEN print('Error reading the log mailbox, status = !XW',u .iosb[IOSB_W_STATUS]);N %FI" $EXIT(CODE=.iosb[IOSB_W_STATUS]); END;R SS$_NORMAL END; ! server_to_log_ast I%GLOBAL ROUTINE send_info_ast(ior_a) = !++S! Functional Description:G!PE! This routine is called to send the host name over the info mailbox.OD! It is invoked as the result of com\k MGFTP026.GvzI&[MGFTP.SOURCE]FTP_LISTENER_CMDS.B32;41PPw:pleting the write of the host IP ! address.!; ! Parameters: !IE! ior_a - address of the I/O request block associated with this write !--e BEGIN. BIND ior = .ior_a : IORDEF,v* fblock = .ior[IOR_L_ASTPRM] : FBLOCKDEF,' srv = .fblock[FBLOCK_L_SRV] : SRVDEF,'. conn = .fblock[FBLOCK_L_CONN_INFO] : CONNDEF,# iosb = ior[IOR_Q_IOSB] : IOSBDEF;E LOCALS status; %IF debugn> %THEN print('send_info_ast : IOR = !XL, status = !XW',ior, .iosb[IOSB_W_STATUS]); %FItD IF (status = .iosb[IOSB_W_STATUS]) !If successfully written.... THEN BEGIN LOCAL temp_len, temp_ptr, astrtn; !A ! send_info_ast() is called three times to write the host name,N> ! local IP address, and local host name to the info mailbox.> ! The value in [IOR_L_INFO] is used to indicate which should ! be written to the mailbox. ! IF (.ior [IOR_L_INFO] EQLU 1) THEN BEGIN !> ! Here, we need to write the remote host name (or the IP* ! address again if we have no name). !& IF .conn[CONN_L_REMHOSTLEN] EQL 0 THEN BEGIN! temp_len = .iosb[IOSB_W_COUNT]; temp_ptr = ior[IOR_T_BUF]; ENDW ELSE BEGINO& temp_len = .conn[CONN_L_REMHOSTLEN];% temp_ptr = conn[CONN_T_REMHOSTBUF]; END;9 astrtn = send_info_ast; !Call send_info_ast() againu END;. IF (.ior [IOR_L_INFO] EQLU 2) THENu BEGIN( LOCAL host : $BBLOCK [DSC$K_S_BLN];8 BIND lcladr = conn[CONN_L_LCLADR] : VECTOR[4,BYTE]; !' ! Send the local host IP address.L !- host[DSC$W_LENGTH] = host_name_max_size;' host[DSC$B_CLASS] = DSC$K_CLASS_S;R' host[DSC$B_DTYPE] = DSC$K_DTYPE_T;t* host[DSC$A_POINTER] = ior[IOR_T_BUF];> status = LIB$SYS_FAO(%ASCID'!UB.!UB.!UB.!UB', host, host, .lcladr[0], .lcladr[1],n .lcladr[2], .lcladr[3]);% temp_len = .host [DSC$W_LENGTH];O& temp_ptr = .host [DSC$A_POINTER];9 astrtn = send_info_ast; !Call send_info_ast() againM END;P IF (.ior [IOR_L_INFO] EQLU 3) THENr BEGIN !F ! Send the local host name, if we have it, IP address otherwise. !& IF .conn[CONN_L_LCLHOSTLEN] EQL 0 THEN BEGINf! temp_len = .iosb[IOSB_W_COUNT];I temp_ptr = ior[IOR_T_BUF]; END  ELSE BEGINH& temp_len = .conn[CONN_L_LCLHOSTLEN];% temp_ptr = conn[CONN_T_LCLHOSTBUF];i END;= astrtn = info_done_ast; !All finished---info_done_ast() END;[< ior [IOR_L_INFO] = .ior [IOR_L_INFO] + 1; !Bump AST counter status = $QIO(_ CHAN = .srv[SRV_L_INFCHN], FUNC = IO$_WRITEVBLK,  IOSB = iosb, ASTADR = .astrtn,% ASTPRM = ior,p P1 = .temp_ptr,D P2 = .temp_len); END;l IF NOT .status THEN BEGIN delete_info_mbx(srv); mem_freeior(%REF(ior)); END;i SS$_NORMAL END; ! send_info_ast o%GLOBAL ROUTINE info_done_ast(ior_a) =e!++ ! Functional Description:! F! This routine is called to delete the info mailbox. It is invoked as6! the result of completing the write of the host name.!D ! Parameters:t!hE! ior_a - address of the I/O request block associated with this writei!--i BEGINI BIND ior = .ior_a : IORDEF, * fblock = .ior[IOR_L_ASTPRM] : FBLOCKDEF,' srv = .fblock[FBLOCK_L_SRV] : SRVDEF,# iosb = ior[IOR_Q_IOSB] : IOSBDEF;i LOCAL[ status; %IF debugS> %THEN print('info_done_ast : IOR = !XL, status = !XW',ior, .iosb[IOSB_W_STATUS]); %FIO delete_info_mbx(srv);I mem_freeior(%REF(ior));! SS$_NORMAL END; ! info_done_ast $GLOBAL ROUTINE free_ior_ast(ior_a) =!++! Functional Description:N!.B! This routine is called to free the memory associated with an I/O)! request block that is no longer needed.P!= ! Parameters:1!.D! ior_a - address of the I/O request block associated with this read!--m BEGINf BIND ior = .ior_a : IORDEF,) fblock = .ior[IOR_L_ASTPRM] : FBLOCKDEF,e& srv = .fblock[FBLOCK_L_SRV] : SRVDEF," iosb = ior[IOR_Q_IOSB] : IOSBDEF; %IF debug= %THEN print('free_ior_ast : IOR = !XL, status = !XW',ior,i .iosb[IOSB_W_STATUS]); %FII? IF NOT .iosb[IOSB_W_STATUS] AND NOT .srv[SRV_V_LOGGING_OUT]t THEN BEGIN srv[SRV_V_LOGGING_OUT] = 1; dasgn_srv_chans(srv); END;e mem_freeior(%REF(ior));  SS$_NORMAL END; ! free_ior_astR!++a!F! Command Routines:L!D!--  l3GLOBAL ROUTINE user_command(fblock_a, username_a) =c!++O! Functional Description:N!M2! The argument is the string identifying the user.!b ! Parameters:Y!;9! FBlock The block that contains all the info about thisc ! transfer.]!.*! username The descriptor of the username.!--l BEGIND BIND# fblock = .fblock_a : FBLOCKDEF, $ username = .username_a : $BBLOCK,( srv = .fblock[FBLOCK_L_SRV] : SRVDEF,0 timezone = fblock[FBLOCK_Q_TIMEZONE] : $BBLOCK,. user2 = fblock[FBLOCK_Q_USERNAME] : $BBLOCK; LOCAL_" uai_list : $ITMLST_DECL(ITEMS=5), primetime : LONG, pt_start : VECTOR[2,LONG],  pt_end : VECTOR[2,LONG],! temp_str : $BBLOCK[DSC$K_S_BLN],  temp, status; %IF debugT %THENs" print('USER(''!AS'')', username);- print('USER_Command: FBlock = !XL', fblock);M %FIN; IF .fblock[FBLOCK_L_STATE] NEQU FBLOCK_K_STATE_CMD_WORKu& THEN SIGNAL(FTP$_BAD_SEQUENCE, 0);$ IF .username[DSC$W_LENGTH] EQL 0* THEN SIGNAL(FTP$_PARAMETER_SYNTAX, 0); !++f? ! Store away the username and tell them we need a password.iA ! We don't want to do the name lookup here and tell them thatX@ ! the username is bogus, since that gives unauthorized users$ ! too much information to go on. !--_ !f6 ! Truncate username at first non-valid character. !FC status = STR$FIND_FIRST_NOT_IN_SET(username, valid_user_chars);S! status = (IF (.status EQLU 0)l8 THEN STR$COPY_DX (fblock[FBLOCK_Q_USERNAME], username)5 ELSE STR$LEFT (fblock[FBLOCK_Q_USERNAME], username,; %REF(.status - 1)));e( IF NOT .status THEN SIGNAL(.status); srv[SRV_V_GOT_USERNAME] = 1;I IF is_anonymous(fblock[FBLOCK_Q_USERNAME], primetime, temp, pt_start,. pt_end) THEN BEGIN fblock[FBLOCK_V_ANONYMOUS] = 1; IF .primetime9 THEN SIGNAL(FTP$_GUEST_IDENT, 0, FTP$_PRIMETIME_WARNING, 0 4, pt_start, pt_end, .timezone[DSC$W_LENGTH], .timezone[DSC$A_POINTER])" ELSE SIGNAL(FTP$_GUEST_IDENT, 0); END ELSE BEGIN $ITMLST_INIT(ITMLST=uai_list, (ITMCOD = UAI$_PWD,l BUFADR = srv[SRV_Q_PWD1], BUFSIZ = 8),= (ITMCOD = UAI$_PWD2, BUFADR = srv[SRV_Q_PWD2], BUFSIZ = 8),E (ITMCOD = UAI$_ENCRYPT,L BUFADR = srv[SRV_B_ENCRYPT1], BUFSIZ = 1),B (ITMCOD = UAI$_ENCRYPT2, BUFADR = srv[SRV_B_ENCRYPT2], BUFSIZ = 1),  (ITMCOD = UAI$_SALT, BUFADR = srv[SRV_W_SALT], BUFSIZ = 2)); status = $GETUAI(& USRNAM = fblock[FBLOCK_Q_USERNAME], ITMLST = uai_list); IF .status THEN BEGIN BINDr) pwd = srv[SRV_Q_PWD1] : VECTOR[2,LONG];c) IF .pwd[0] EQLU 0 AND .pwd[1] EQLU 0G THEN BEGINv BIND. pwd2 = srv[SRV_Q_PWD2] : VECTOR[2,LONG];( IF .pwd2[0] EQLU 0 AND .pwd2[1] EQLU 0 THEN BEGIN% status = create_server(fblock);E# RETURN .status; !No passwordE END;8 srv[SRV_V_SECONDARY_PASS] = 1; !Only need to check the !...2ndary passwordn& END !End of null primary password ELSEh; srv[SRV_V_SECONDARY_PASS] = 0; !Need to check the primary. !...password END !End of real user5 ELSE IF .status EQL RMS$_RNF OR .status EQL RMS$_EOFs1 THEN srv[SRV_V_BAD_USER] = ]^ MGFTP026.GvzI&[MGFTP.SOURCE]FTP_LISTENER_CMDS.B32;41PPI1 !Non-existant usera; ELSE SIGNAL(FTP$_NOT_LOGGED_IN, 0, !If we got here then we=5 FTP$_SERVICE_UNAVAILABLE); !...probably didn't have! !...enough of some quota to !...do the $GETUAI: SIGNAL(FTP$_NEED_PASSWORD, 1, fblock[FBLOCK_Q_USERNAME]);$ END; !End of non-ANONYMOUS user SS$_NORMAL END; 3GLOBAL ROUTINE pass_command(fblock_a, password_a) = !++P! Functional Description:W!A.! Arg is string specifying the users password.!s ! Parameters:_!T9! FBlock The block that contains all the info about thisc ! transfer.A!E*! Password The descriptor of the password.!--N BEGIN  BIND# fblock = .fblock_a : FBLOCKDEF,s$ password = .password_a : $BBLOCK,( srv = .fblock[FBLOCK_L_SRV] : SRVDEF,0 username = fblock[FBLOCK_Q_USERNAME] : $BBLOCK; LOCAL_ status;> IF .fblock[FBLOCK_L_STATE] NEQU FBLOCK_K_STATE_CMD_WORK OR NOT .srv[SRV_V_GOT_USERNAME]N& THEN SIGNAL(FTP$_BAD_SEQUENCE, 0);" IF .fblock[FBLOCK_V_ANONYMOUS]I THEN RETURN(create_server(fblock,password)); !Save anonymous password ! 8! Check the password whether or not this is a real user.! ! IF .srv[SRV_V_SECONDARY_PASS] THEN BEGING status = check_password(password,srv[SRV_Q_PWD2],.srv[SRV_B_ENCRYPT2],b/ .srv[SRV_W_SALT],fblock[FBLOCK_Q_USERNAME]);I IF NOT .status] THEN srv[SRV_V_BAD_PASS] = 1; END ELSE BEGIN BINDi, pwd2 = srv[SRV_Q_PWD2] : VECTOR[2,LONG]; srv[SRV_V_BAD_PASS] = (IF NOT .srv[SRV_V_BAD_USER]A THEN BEGIN7 status = check_password(password,srv[SRV_Q_PWD1],._( srv[SRV_B_ENCRYPT1],.srv[SRV_W_SALT], fblock[FBLOCK_Q_USERNAME]); NOT .status END ELSE 1);0 IF NOT(.pwd2[0] EQLU 0 AND .pwd2[1] EQLU 0) AND= NOT .srv[SRV_V_BAD_USER] !Don't fake a secondary password_ THEN BEGIN=# srv[SRV_V_SECONDARY_PASS] = 1;C: SIGNAL(FTP$_NEED_PASSWORD, !Prompt for the secondary- 1, fblock[FBLOCK_Q_USERNAME]); !...passwordZ RETURN SS$_NORMAL;Z END;o END;C IF NOT .srv[SRV_V_BAD_PASS] @ THEN RETURN(create_server(fblock)) !User has been validatedA ELSE reject_login(fblock,SS$_INVLOGIN); !Login attempt failedd SS$_NORMAL END; B!ROUTINE logged_in_cmd(fblock_a) = !++r! Functional Description:)!<! We got a command that requires the client to be logged in.!i ! Parameters:i! 9! FBlock The block that contains all the info about this ! transfer. !L!-- BEGIN  BIND" fblock = .fblock_a : FBLOCKDEF;" SIGNAL(FTP$_NOT_LOGGED_IN, 0); SS$_NORMAL END; _#ROUTINE server_created_ast(ior_a) =D!++e! Functional Description:R! >! The initial write to a server's mailbox(the one that sends aF! CONNDEF to the server) has completed. Mark this server as existant.! ! Parameters:l!,E! ior_a - address of the I/O request block associated with the write.O!--S BEGINE BIND ior = .ior_a : IORDEF,) fblock = .ior[IOR_L_ASTPRM] : FBLOCKDEF,n& srv = .fblock[FBLOCK_L_SRV] : SRVDEF," iosb = ior[IOR_Q_IOSB] : IOSBDEF; %IF debughB %THEN print('server_created_ast: IOR = !XL, status = !XW',ior, .iosb[IOSB_W_STATUS]); %FI_ delete_info_mbx(srv);c IF .iosb[IOSB_W_STATUS]= THEN srv[SRV_V_SERVER_CREATED] = 1; !Set the created bits@ $DCLAST(ASTADR = free_ior_ast, !Free the IOR asynchronously ASTPRM = ior)' END; !End of server_created_astTEND !End of module beginNELUDOMV_L_INPCHN] ); srv[SRV_L_INPCHN] = 0;a END;e IF .srv[SRV_L_INFCHN] NEQ 0 $*[MGFTP.SOURCE]FTP_LISTENER_MEM.B32;6+,d./ 4O-I0123KPWO56֣bR7 _bR89/RFÞGHJ ! MadGoat FTP client and server!?! Authors: Chad Wilson, Dale Moore, Tod Shannon, Bruce Miller,,! Marc Shannon, Henry Miller, John Clement,1! Matt Madison, Darrell Burkhead, Hunter Goatley!6! Copyright 1986, 1992, Carnegie Mellon University.B! Copyright 1994, 1996, MadGoat Software. All rights reserved.!?! Permission is granted for not-for-profit redistribution,?! provided all source and object code remain unchanged from?! the original distribution, and that all copyright notices! remain intact.!%TITLE 'FTP_LISTENER_MEM'%MODULE ftp_listener_mem(IDENT='V2.4',C ADDRESSING_MODE(EXTERNAL=GENERAL, NONEXTERNAL=LONG_RELATIVE)) =BEGIN!++! FACILITY: FTP_LISTENER!+! ABSTRACT: Memory management routines!! MODULE DESCRIPTION:!H! This module contains memory management routines used by FTP_LISTENER! (copied from MX).!! AUTHOR: M. Madison6! COPYRIGHT 1992,1996, MadGoat Software."! ALL RIGHTS RESERVED.!! CREATION DATE: 05-JUN-1992!! MODIFICATION HISTORY:!G! 21-APR-1998 V2.4 Goatley Increase size parameters for IOR zone.K! 14-AUG-1996 V2.2 Goatley Initialize each structure (zero them out).,! 22-NOV-1993 V2.0 Burkhead Use NETLIB.K! 29-APR-1993 V1.1 Burkhead Removed GET/FREEWRK and added GET/FREECONN0! 05-JUN-1992 V1.0 Madison Initial coding.!--LIBRARY 'SYS$LIBRARY:STARLET';LIBRARY 'FTP_LISTENER';LIBRARY 'NETLIB';LIBRARY 'NETAUX'; !Debug infoLIBRARY 'FTP_CONN_INFO'; COMPILETIME debug = 0;O%IF debug %THEN %MESSAGE('DEBUG mode is enabled in FTP_LISTENER_MEM.B32!') %FI;FORWARD ROUTINE mem_getconn, mem_freeconn, mem_getior, mem_freeior, mem_getsrv, mem_freesrv;EXTERNAL ROUTINE LIB$CREATE_VM_ZONE, LIB$GET_VM, LIB$FREE_VM;OWN connzone : INITIAL(0), iorzone : INITIAL(0), srvzone : INITIAL(0); %SBTTL 'MEM_GETCONN'GLOBAL ROUTINE mem_getconn = BEGIN!++! FUNCTIONAL DESCRIPTION:!7! Allocates a CONNDEF structure out of the CONN zone.!&! RETURNS: pointer to CONN structure! ! PROTOTYPE:!! mem_getconn SIZE!! IMPLICIT INPUTS: None.!! IMPLICIT OUTPUTS: None.!! COMPLETION CODES:!! non-0: CONN allocated! 0: allocation failure!! SIDE EFFECTS:!*! Creates CONN zone on first invocation.!!--LOCAL aststat, status, conn : REF CONNDEF;6 %IF debug %THEN print('mem_getconn() called'); %FI IF .connzone EQL 0 THEN BEGIND aststat = $SETAST(ENBFLG=0); ! double check when non-interruptible IF .connzone EQL 0 THEN BEGIN@ status = LIB$CREATE_VM_ZONE(connzone, %REF(LIB$K_VM_FIXED), %REF(CONN_S_CONNDEF), %REF(LIB$M_VM_EXTEND_AREA),, %REF(4), %REF(16), %REF(8), %REF(8), 0, 0,! %ASCID'MADGOAT_FTP_CONN_ZONE');. IF NOT .status THEN SIGNAL_STOP(.status); END;3 IF .aststat EQL SS$_WASSET THEN $SETAST(ENBFLG=1); END;> status = LIB$GET_VM(%REF(CONN_S_CONNDEF), conn, connzone);- IF NOT .status THEN SIGNAL_STOP(.status);4 CH$FILL(0, CONN_S_CONNDEF, .conn); !Zero it out .connEND; ! mem_getconn %SBTTL 'MEM_FREECONN'(GLOBAL ROUTINE mem_freeconn(conn_a_a) = BEGIN!++! FUNCTIONAL DESCRIPTION:!2! Frees a text block allocated with mem_getconn.!A! RETURNS: cond_value, longword(unsigned), write only, by value! ! PROTOTYPE:!! mem_freeconn txt!! IMPLICIT INPUTS: None.!! IMPLICIT OUT^J MGFTP026.GdI$[MGFTP.SOURCE]FTP_LISTENER_MEM.B32;6O:PUTS: None.!! COMPLETION CODES:!2! SS$_NORMAL: normal successful completion.!! SIDE EFFECTS:! ! None.!--7 %IF debug %THEN print('mem_freeconn() called'); %FI: LIB$FREE_VM(%REF(CONN_S_CONNDEF), .conn_a_a, connzone)END; ! mem_freeconn %SBTTL 'MEM_GETIOR'GLOBAL ROUTINE mem_getior = BEGIN!++! FUNCTIONAL DESCRIPTION:!5! Allocates a IORDEF structure out of the IOR zone.!%! RETURNS: pointer to IOR structure! ! PROTOTYPE:!! mem_getior SIZE!! IMPLICIT INPUTS: None.!! IMPLICIT OUTPUTS: None.!! COMPLETION CODES:!! non-0: IOR allocated! 0: allocation failure!! SIDE EFFECTS:!)! Creates IOR zone on first invocation.!!-- LOCAL aststat, status, ior : REF IORDEF;5 %IF debug %THEN print('mem_getior() called'); %FI IF .iorzone EQL 0 THEN BEGIND aststat = $SETAST(ENBFLG=0); ! double check when non-interruptible IF .iorzone EQL 0 THEN BEGIN? status = LIB$CREATE_VM_ZONE(iorzone, %REF(LIB$K_VM_FIXED), %REF(IOR_S_IORDEF), %REF(LIB$M_VM_EXTEND_AREA),- %REF(16), %REF(68), %REF(8), %REF(8), 0, 0, %ASCID'MADGOAT_FTP_IOR_ZONE');. IF NOT .status THEN SIGNAL_STOP(.status); END;3 IF .aststat EQL SS$_WASSET THEN $SETAST(ENBFLG=1); END;: status = LIB$GET_VM(%REF(IOR_S_IORDEF), IOR, iorzone);- IF NOT .status THEN SIGNAL_STOP(.status);1 CH$FILL(0, IOR_S_IORDEF, .ior); !Zero it out .iorEND; ! mem_getior %SBTTL 'MEM_FREEIOR'&GLOBAL ROUTINE mem_freeior(ior_a_a) = BEGIN!++! FUNCTIONAL DESCRIPTION:!1! Frees a text block allocated with mem_getior.!A! RETURNS: cond_value, longword(unsigned), write only, by value! ! PROTOTYPE:!! mem_freeior txt!! IMPLICIT INPUTS: None.!! IMPLICIT OUTPUTS: None.!! COMPLETION CODES:!2! SS$_NORMAL: normal successful completion.!! SIDE EFFECTS:! ! None.!--6 %IF debug %THEN print('mem_freeior() called'); %FI6 LIB$FREE_VM(%REF(IOR_S_IORDEF), .ior_a_a, iorzone)END; ! mem_freeior %SBTTL 'MEM_GETSRV'GLOBAL ROUTINE mem_getsrv = BEGIN!++! FUNCTIONAL DESCRIPTION:!5! Allocates a SRVDEF structure out of the SRV zone.!%! RETURNS: pointer to SRV structure! ! PROTOTYPE:!! mem_getsrv SIZE!! IMPLICIT INPUTS: None.!! IMPLICIT OUTPUTS: None.!! COMPLETION CODES:!! non-0: SRV allocated! 0: allocation failure!! SIDE EFFECTS:!)! Creates SRV zone on first invocation.!!-- LOCAL aststat, status, srv : REF SRVDEF;5 %IF debug %THEN print('mem_getsrv() called'); %FI IF .srvzone EQL 0 THEN BEGIND aststat = $SETAST(ENBFLG=0); ! double check when non-interruptible IF .srvzone EQL 0 THEN BEGIN? status = LIB$CREATE_VM_ZONE(srvzone, %REF(LIB$K_VM_FIXED), %REF(SRV_S_SRVDEF), %REF(LIB$M_VM_EXTEND_AREA),, %REF(4), %REF(16), %REF(8), %REF(8), 0, 0, %ASCID'MADGOAT_FTP_SRV_ZONE');. IF NOT .status THEN SIGNAL_STOP(.status); END;3 IF .aststat EQL SS$_WASSET THEN $SETAST(ENBFLG=1); END;: status = LIB$GET_VM(%REF(SRV_S_SRVDEF), SRV, srvzone);- IF NOT .status THEN SIGNAL_STOP(.status);1 CH$FILL(0, SRV_S_SRVDEF, .srv); !Zero it out .srvEND; ! mem_getsrv %SBTTL 'MEM_FREESRV'&GLOBAL ROUTINE mem_freesrv(srv_a_a) = BEGIN!++! FUNCTIONAL DESCRIPTION:!1! Frees a text block allocated with mem_getsrv.!A! RETURNS: cond_value, longword(unsigned), write only, by value! ! PROTOTYPE:!! mem_freesrv txt!! IMPLICIT INPUTS: None.!! IMPLICIT OUTPUTS: None.!! COMPLETION CODES:!2! SS$_NORMAL: normal successful completion.!! SIDE EFFECTS:! ! None.!--6 %IF debug %THEN print('mem_freesrv() called'); %FI6 LIB$FREE_VM(%REF(SRV_S_SRVDEF), .srv_a_a, srvzone)END; ! mem_freesrvENDELUDOM *[MGFTP.SOURCE]FTP_NETWORK.B32;12+,!#.8/ 4O86-I0123KPWO756obږ7cږ89/RFÞGHJ  ! MadGoat FTP client and server!?! Authors: Chad Wilson, Dale Moore, Tod Shannon, Bruce Miller,,! Marc Shannon, Henry Miller, John Clement,1! Matt Madison, Darrell Burkhead, Hunter Goatley!6! Copyright 1986, 1992, Carnegie Mellon University.B! Copyright 1994, 2000, MadGoat Software. All rights reserved.!?! Permission is granted for not-for-profit redistribution,?! provided all source and object code remain unchanged from?! the original distribution, and that all copyright notices! remain intact.!MODULE FTP_NETWORK ( ADDRESSING_MODE ( EXTERNAL = LONG_RELATIVE, NONEXTERNAL = LONG_RELATIVE), IDENT='V2.6-2',( LIST (ASSEMBLY, NOBINARY, NOEXPAND)) = BEGIN!++?! FTP_Network.B32 Copyright (c) 1986 Carnegie Mellon University!! Description:!1! Will perform all necessary network I/O for FTP.!$! Written By: Vince Fuller CMU-CS/RI!! Modifications:!+! V2.6-2 Hunter Goatley 1-MAY-2000 09:469! Modified release_line() to signal FTP$_REMCLOSE when a*! 421 is received from the remote server.!+! V2.5-2 Hunter Goatley 18-NOV-1998 16:209! In READ_AST(), call CLOSE_CONN() on errors, don't just7! set HOST_SET to 0! Fixes problem of not deassigning%! devices on some types of timeouts.!)! V2.2 Hunter Goatley 13-AUG-1996 13:46;! In quiet mode, don't display replies either. /QUIET and/! /NOREPLY now causes nothing to be displayed.!,! V2.1-2 Darrell Burkhead 14-NOV-1994 08:47?! Fixed recv_desc initialization. Was incorrectly initialized! to be a dynamic descriptor.!*! V2.1 Darrell Burkhead 25-JUL-1994 11:30! Added FTP alias support.!,! V2.0-1 Darrell Burkhead 13-MAY-1994 09:16>! Don't build a host prompt that is bigger than 32 characters! long.!*! V2.0 Darrell Burkhead 13-OCT-1993 13:52! Use NETLIB.!>! Note: the NETLIB send routine handles tacking on a CR/LF atA! the end of the line, so all of those "!/"'s need to be trimmed6! off of the ends of the send_string control strings.!,! V1.0-2 Darrell Burkhead 12-OCT-1993 13:47<! Added some checks to NET_SEND to handle getting a timeout%! message upon connecting to a host.!+! V1.0-1 Hunter Goatley 27-SEP-1993 09:11;! Added parsing of 150 replies (open connection) to handle9! setting the file size for CTRL-A output in the client.!)! V1.0 Hunter Goatley 24-SEP-1993 15:20! Changed FTP host prompt.!"! 21-Jun-1993 Darrell Burkhead WKUE! Added Save_Command and Restore_Command to allow showing commands to@! be selectively turned off and restored (for the PASS command).!--LIBRARY 'SYS$LIBRARY:STARLET';LIBRARY 'FTP';LIBRARY 'FTP_MSG';LIBRARY 'NETAUX';LIBRARY 'NETLIB';LIBRARY 'FTP_CONN_INFO';LIBRARY 'CLI';LIBRARY 'FTP_ALIAS'; COMPILETIME debug = 0;J%IF debug %THEN %MESSAGE('DEBUG mode is enabled in FTP_NETWORK.B32!') %FI;GLOBAL1 reply_string : $BBLOCK [DSC$K_S_BLN] PRESET ( [DSC$W_LENGTH] = 0," [DSC$B_DTYPE] = DSC$K_DTYPE_T,_zmq[ MGFTP026.G!#I [MGFTP.SOURCE]FTP_NETWORK.B32;12O8(X" [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),1 host_prompt : $BBLOCK [DSC$K_S_BLN] PRESET ( [DSC$W_LENGTH] = 0," [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),< host_set : INITIAL (0); ! Nonzero if connection is openOWN# command_chan : LONG INITIAL(0),$ recv_buffer : VECTOR[512,BYTE],% recv_desc : $BBLOCK[DSC$C_S_BLN]6 PRESET([DSC$W_LENGTH] = %ALLOCATION(recv_buffer),# [DSC$B_CLASS] = DSC$K_CLASS_S,# [DSC$B_DTYPE] = DSC$K_DTYPE_T,# [DSC$A_POINTER]= recv_buffer), net_iosb : IOSBDEF, recv_iosb : IOSBDEF, show_commands : INITIAL (0), show_replies : INITIAL (1);EXTERNAL quiet_flag;FORWARD ROUTINE parse_open_connection_reply;EXTERNAL ROUTINE set_tot_file_size; GLOBAL ROUTINE show_command = (SIGNAL( IF .show_commands THEN FTP$_COMMAND_ON ELSE FTP$_COMMAND_OFF)), show_reply = (SIGNAL( IF .show_replies THEN FTP$_REPLY_ON ELSE FTP$_REPLY_OFF)); GLOBAL ROUTINE!++! Description:!1! Routines for enabling and disabling the display.! of the lower level ftp commands and replies.!--* set_command_off = (show_commands = 0),) set_command_on = (show_commands = 1), set_command = BEGIN IF CLI$PRESENT(%ASCID'COMMAND') THEN set_command_on() ELSE set_command_off(); IF NOT .quiet_flag THEN show_command(); SS$_NORMAL END,' set_reply_off = (show_replies = 0),& set_reply_on = (show_replies = 1), set_reply = BEGIN IF CLI$PRESENT(%ASCID'REPLY') THEN set_reply_on() ELSE set_reply_off(); IF NOT .quiet_flag THEN show_reply(); SS$_NORMAL END;(GLOBAL ROUTINE save_reply(old_reply_a) = BEGIN BIND old_reply = .old_reply_a; old_reply = .show_replies; SS$_NORMAL END;)GLOBAL ROUTINE restore_reply(new_reply) = BEGIN show_replies = .new_reply; SS$_NORMAL END;,GLOBAL ROUTINE save_command(old_command_a) = BEGIN BIND old_command = .old_command_a;! old_command = .show_commands; SS$_NORMAL END;-GLOBAL ROUTINE restore_command(new_command) = BEGIN! show_commands = .new_command; SS$_NORMAL END; !++! Description:!=! The routines below receive the replies from the remote site9! asynchronously. By doing this asynchronously we try to<! not become unsynchronized with the remote site. There areG! a few sites that occasionally send "200 okay400 Oh shit.":! Below is state diagram that explains the various states.! ! |! |! v ! +------------+ Purge"! | |--------\"! | Waiting | |"! | |<-------/! +------------+! ^ ^ |! Get| | |Reply! Response| |Purge |! | | v! +------------+ Reply!! | |-------\!! | Pending | |!! | |<------/! +------------+!--$ROUTINE release_reply(reply_value) =!++! Functional Description:!G! We've just got a reply. Keep it around so that the next time someoneE! asks (or if someone is currently asking), we can let them know what! we just got.!-- BEGIN EXTERNAL ROUTINE reply_enqueue; LOCAL status; %IF debug %THEN, print('Release_Reply: !3UL', .reply_value); %FI reply_enqueue(.reply_value);+ status = $SETEF(EFN = FTP$K_REPLY_EFN);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; -GLOBAL ROUTINE net_get_response(response_a) =!++! Functional Description:!>! Get the response from the remote site since the last call to! net_response or net_purge.!-- BEGIN BIND# response = .response_a : $BBLOCK; EXTERNAL ROUTINE reply_dequeue, reply_queue_empty; LOCAL status;0 WHILE (reply_queue_empty() AND .host_set) DO BEGIN( status = $CLREF(EFN = FTP$K_REPLY_EFN);% IF NOT .status THEN SIGNAL(.status);) status = $WAITFR(EFN = FTP$K_REPLY_EFN);% IF NOT .status THEN SIGNAL(.status); END; %IF debug/ %THEN print('Net_Get_Response: Returning'); %FI1 IF NOT .host_set THEN RETURN FTP$_NO_CONNECT; response = reply_dequeue(); SS$_NORMAL END;GLOBAL ROUTINE net_purge =!++! Functional Description:!1! Get rid of any replies that might have arrived.!-- BEGIN EXTERNAL ROUTINE reply_queue_empty, reply_dequeue; %IF debug %THEN print('Net_Purge'); %FI$ WHILE NOT reply_queue_empty() DO reply_dequeue(); SS$_NORMAL END; FORWARD ROUTINE close_conn;*GLOBAL ROUTINE release_line(line_desc_a) =!++! Functional Description:!A! This routines builds lines from the remote system into Replies.*! A reply can continue onto several lines.!! ! |! |! v#! x +----------+ 'ddd '$! /-------| |--------\$! |ignore | Normal | Release|$! \------>| |<-------/! +----------+! | ^! 'ddd-'| |'ddd '! Store| |Release! | |! v |! +----------+ x$! | |--------\$! | Multi | ignore|$! | |<-------/! +----------+!-- BEGIN BIND% line_desc = .line_desc_a : $BBLOCK; LITERAL line_normal = 0, line_multi = 1, line_abnormal = 2;3 ROUTINE line_parse(line_desc_a, line_value_a) = !++ ! Functional Description: !G ! This routine determines what type of response we've received from ! the remote site. ! ! Format Value Returned1 ! 'ddd ' R0 = Line_Normal, Line_Value = ddd0 ! 'ddd-' R0 = Line_Multi, Line_Value = ddd# ! OTHERWISE R0 = Line_Abnormal !-- BEGIN BIND) line_desc = .line_desc_a : $BBLOCK,1 line_value = .line_value_a : LONG UNSIGNED; BIND) line_vec = .line_desc[DSC$A_POINTER] : VECTOR[,BYTE]; line_value = 0;# IF .line_desc[DSC$W_LENGTH] LSSU 4 THEN RETURN(line_abnormal);: IF (.line_vec[0] LSSU %C'0') OR (.line_vec[0] GTRU %C'9')! THEN RETURN (line_abnormal);+ line_value = (.line_vec[0] - %C'0') * 100;: IF (.line_vec[1] LSSU %C'0') OR (.line_vec[1] GTRU %C'9')! THEN RETURN (line_abnormal);8 line_value = .line_value + (.line_vec[1] - %C'0') * 10;: IF (.line_vec[2] LSSU %C'0') OR (.line_vec[2] GTRU %C'9')! THEN RETURN (line_abnormal);3 line_value = .line_value + (.line_vec[2] - %C'0'); IF .line_vec[3] EQLU %C'-' THEN RETURN(line_multi); IF .line_vec[3] EQL %C' ' THEN RETURN(line_normal); RETURN (line_abnormal) END; LITERAL mline_state_normal = 0, mline_state_multi = 1;  OWN save_line_value : INITIAL (0),, mline_state : INITIAL (mline_state_normal), reply_value; EXTERNAL expected_response; EXTERNAL ROUTINE cvt_response_to_status, STR$FIND_FIRST_SUBSTRING% : BLISS ADDRESSING_MODE (GENERAL),/ STR$COPY_DX : BLISS ADDRESSING_MODE (GENERAL),0 STR$FREE1_DX : BLISS ADDRESSING_MODE (GENERAL); LOCAL line_value, status; !++* ! Parse the line to see what we've got !--/ status = line_parse(line_desc, line_value); !+`B9 MGFTP026.G!#I [MGFTP.SOURCE]FTP_NETWORK.B32;12O8N2+= ! Now might be a good time to transcript or print out the ! line we received. !-- SELECTONE .mline_state OF SET [mline_state_normal] : BEGIN# save_line_value = .line_value; IF .status EQL line_normal THEN BEGIN release_reply(.line_value);# mline_state = mline_state_normal; END# ELSE IF .status EQL line_multi THEN BEGIN reply_value = .line_value;" mline_state = mline_state_multi; END ELSE BEGIN !++" ! The response didn't make sense& ! Signal an error or ignore the data !--# mline_state = mline_state_normal; SS$_NORMAL END; END; [mline_state_multi] : BEGIND IF (.status EQL line_normal) AND (.line_value EQL .reply_value) THEN BEGIN release_reply(.line_value);# mline_state = mline_state_normal; END% ELSE ! More multi line response BEGIN" mline_state = mline_state_multi; END; END; TES; IF .show_replies THEN print('| |<--------/! +----------+! | ^! X/| |! Add| | CR/!! | | Release! v |! +----------+ X$! | |--------\$! --->| Normal | Add |$! | |<-------/! +----------+! | ^! LF/| |! Release| |X/Add! | |! v | ! LF +----------+ CR%! /--------| |---------\%! | Release| LF | ignore |%! \------->| |<--------/! +----------+!!-- BEGIN LOCAL status; LITERAL state_normal = 0, state_cr = 1, state_lf = 2; EXTERNAL ROUTINE reset_parameters,. STR$APPEND : BLISS ADDRESSING_MODE (GENERAL); OWN% line_state : INITIAL (state_normal),) in_line : $BBLOCK[DSC$K_S_BLN] PRESET ( [DSC$W_LENGTH] = 0," [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0); %IF debug %THEN print('Read_Ast'); %FI' status = .recv_iosb[IOSB_W_STATUS]; IF NOT .status) THEN BEGIN !Connection is closed,+! host_set = 0; !...let the flag show it&! reset_parameters(); !Just in case. close_conn(1);" SIGNAL(FTP$_CLOSING, 0, .status);A status = $SETEF(EFN = FTP$K_REPLY_EFN); !Make sure we don't hang% IF NOT .status THEN SIGNAL(.Status);0 RETURN (SS$_NORMAL); !Errors already signaled END; %IF debug %THENA print('Read_Ast: (!UW bytes) ''!AF''', .recv_iosb[IOSB_W_COUNT],) .recv_iosb[IOSB_W_COUNT], recv_buffer); %FI2 INCR i FROM 0 TO .recv_iosb[IOSB_W_COUNT]-1 DO BEGIN BIND, char = recv_buffer[.i] : BYTE UNSIGNED; LOCAL. char_desc : $BBLOCK[DSC$K_S_BLN] PRESET ( [DSC$W_LENGTH] = 1," [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_S, [DSC$A_POINTER] = char); SELECTONEU .line_state OF SET [state_normal] : IF .char EQLU CR THEN BEGIN release_line(In_Line); line_state = state_cr; ENDd ELSE IF .char EQLU LF THEN BEGIN release_line(in_line); line_state = state_lf; ENDo ELSE BEGIN. status = STR$APPEND(in_line, char_desc);* IF NOT .status THEN SIGNAL(.status); line_state = state_normal; END;  [state_cr] : IF .char EQLU CR THEN BEGIN Release_Line (in_line);e Line_State = state_cr; ENDn ELSE IF .char EQLU LFa THEN BEGIN line_state = state_cr; END ELSE BEGIN. status = STR$APPEND(in_line, char_desc);* IF NOT .status THEN SIGNAL(.status); line_state = state_normal; END;  [state_lf] : IF .char EQLU CR THEN BEGIN line_state = state_lf; ENDc ELSE IF .char EQLU LFo THEN BEGIN release_line(in_line); line_state = state_lf; ENDo ELSE BEGIN. status = STR$APPEND(in_line, char_desc);* IF NOT .status THEN SIGNAL(.status); line_state = state_normal; END; TES;. END; J IF NOT .host_set THEN RETURN(SS$_NORMAL); !Not connected, quit reading !++r ! Reissue the read !--o status = netlib_lib_receive( CTX = command_chan,e STR = recv_desc, IOSB = recv_iosb,G ASTADR = read_ast);4 IF NOT .status1 THEN BEGIN !Error reading control channelO%! host_set = 0; !Connection closedd5! reset_parameters(); !Reset the type, mode, & stru  close_conn(1);i %IF debug8 %THEN print('netlib_lib_receive status = !XL',.status); %FI" SIGNAL(FTP$_CLOSING, 0, .status); END; !End of error readings SS$_NORMAL END; &GLOBAL ROUTINE net_send(send_desc_a) =!++h! Functional Description:h!33! Send a string to the remote site (synchronously).1!--- BEGIN BIND$ send_desc = .send_desc_a : $BBLOCK; LOCALs status; !++tF ! If the connection has been lost, let net_get_response report the ! error. !-abDf MGFTP026.G!#I [MGFTP.SOURCE]FTP_NETWORK.B32;12O8ӫ%- - IF NOT .host_set THEN RETURN(SS$_NORMAL);r !++d< ! Lets print out what we are sending to the remote site. !--a IF .show_commandso" THEN print('>!AS', send_desc);> status = netlib_lib_send ( !Send a CR/LF-terminated line- CTX = command_chan, !...to the remote hostt STR = send_desc,# ADD_CRLF= 1); !CR/LF-terminated0!uM! Let NETLIB take care of the IOSB, so that it will use $QIOW instead of $QIO9!!! IOSB = net_iosb);F ! If the connection has been lost, let net_get_response report the ! error. !--f- IF NOT .host_set THEN RETURN(SS$_NORMAL);( IF NOT .status THEN SIGNAL(.status);'! status = .net_iosb[IOSB_W_STATUS];C! IF .status EQL SS$_ABORT THEN status = .net_iosb[NSB$XSTATUS];R)! IF NOT .status THEN SIGNAL(.status);  SS$_NORMAL END; E3GLOBAL ROUTINE net_init(host_name_a, remote_port) =B!++ $! To establish connections to host.!--E BEGIND BIND% host_name = .host_name_a : $BBLOCK;P EXTERNAL quiet_flag, saved_conn_info : CONNDEF,T remhost_name : $BBLOCK, fnd_alias_rec : ALIASDEF, alias_name : $BBLOCK, alias_hostname : $BBLOCK; EXTERNAL ROUTINE alias_lookup,- STR$CONCAT : BLISS ADDRESSING_MODE(GENERAL), . STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL); LOCAL status, host_ptr : REF $BBLOCK; %IF debugv) %THEN print('Net_Init:Doing Assign');  %FIK3 status = netlib_lib_assign(CTX = command_chan);N IF NOT .status THEN BEGIN# SIGNAL(FTP$_GET_INET, 0, .status);= RETURN(FTP$_GET_INET);S END;N6 status = netlib_lib_bind( !Bind the TCP protocol CTX = command_chan, NOTPASS = 1); IF NOT .status THEN BEGIN% SIGNAL(FTP$_NO_CONNECT, 0, .status); RETURN(SS$_NORMAL); END;_% status = alias_lookup(host_name);E/ host_ptr = !Point to the host name desc  (IF .status( THEN BEGINs3 IF NOT .quiet_flag THEN SIGNAL(FTP$_ALIASTRANS, 2,C! alias_name, alias_hostname);I alias_hostnameo$ END !End of translated an alias ELSE BEGINO? fnd_alias_rec[ALIAS_L_FLAGS] = 0; !Don't get any info from thef !...alias record- host_name !Not an alias, use the originald& END); !End of alias lookup failedB IF NOT .quiet_flag THEN SIGNAL(FTP$_ATTEMPTING, 1, .host_ptr); status = netlib_lib_connect( CTX = command_chan, NODE = .host_ptr, PORT = .remote_port); %IF debugq; %THEN print('Net_Init: Connect Status = !XL', .status);  %FIl IF NOT .status THEN BEGIN SIGNAL(FTP$_NO_CONNECT, 0,1 IF .status EQL SS$_ENDOFFILE THEN FTP$_UNKNOWN_HOST ELSE .status); RETURN(SS$_NORMAL); END;;3 saved_conn_info[CONN_L_REMPORT] = .remote_port;N8 status = netlib_lib_get_info( !Get connection info CTX = command_chan,* REMADR = saved_conn_info[CONN_L_REMADR],* LCLADR = saved_conn_info[CONN_L_LCLADR],- LCLPORT = saved_conn_info[CONN_L_LCLPORT]); %IF debug < %THEN print('Net_Init: get info Status = !XL', .status); %FIE IF NOT .status THEN BEGIN% SIGNAL(FTP$_NO_CONNECT, 0, .status);o RETURN(SS$_NORMAL); END; @ status = netlib_lib_addr_to_name( !Get the real remote host CTX = command_chan, ) ADDR = .saved_conn_info[CONN_L_REMADR],m NAME = remhost_name); IF NOT .status- THEN BEGIN !Error looking up the hosti3 status = STR$COPY_DX( !...use the name specifiedy remhost_name, .host_ptr);l IF NOT .Statuso THEN BEGINn$ SIGNAL(FTP$_ERROR, 0, .Status); RETURN(SS$_NORMAL); END;  END;0 !++>4 ! Connection is really open, so update the flag. !--e host_set = 1; ! O! CLI$DCL_PARSE doesn't like prompt strings that are greater than 32 characters-N! long, so we truncate the host name if it would generate too big of a prompt.! BEGIN MACRO< prompt_prefix = 'FTP:'%,- prompt_suffix = '> '%;^ LITERAL 5 max_host_len = 32-(%CHARCOUNT(%STRING(prompt_prefix,  prompt_suffix))); LOCAL-! temp_host : $BBLOCK[DSC$C_S_BLN]  PRESET([DSC$W_LENGTH] =1 (IF .host_ptr[DSC$W_LENGTH] GTRU max_host_len-) THEN max_host_len !Host name too big# ELSE .host_ptr[DSC$W_LENGTH]),=# [DSC$B_CLASS] = DSC$K_CLASS_S,# [DSC$B_DTYPE] = DSC$K_DTYPE_T,a0 [DSC$A_POINTER]= .host_ptr[DSC$A_POINTER]);3 STR$CONCAT(host_prompt, !Build the prompt stringa9 %ASCID prompt_prefix, temp_host, %ASCID prompt_suffix);' END; !End of build prompt block !++u? ! Here is where we start reading stuff from the remote site !--_ Status = netlib_lib_receive( CTX = command_chan,_ STR = recv_desc, IOSB = recv_iosb,N ASTADR = read_ast);O< IF NOT .status THEN SIGNAL(FTP$_DATA_ERROR, 0, .status); SS$_NORMAL END; i"GLOBAL ROUTINE close_conn(param) =!++oG! To first tell the remote host that the connection is going to close,E.! and then do deassign the command channel.!-- BEGINL EXTERNAL ROUTINE cvt_response_to_status, close_block_conn, reset_parameters; BUILTINy NULLPARAMETER; LOCAL response : INITIAL(1),P status : INITIAL(1);7 IF (NOT NULLPARAMETER(param)) ! Parameter exists$ THEN response = 0; IF .response THEN BEGIN( status = send_string(response, 'QUIT');; IF .status NEQU FTP$_NO_CONNECT !Make sure a response wast THEN BEGIN !...returned) IF NOT .status THEN SIGNAL(.status); 0 status = cvt_response_to_status(.response); IF NOT .statuss THEN BEGIN $ IF .status EQLU FTP$_COMMAND_ERROR' THEN SIGNAL(.status, 1, %ASCID'QUIT')L< ELSE SIGNAL(FTP$_COMMAND_ERROR, 1, %ASCID'QUIT', .status); RETURN(SS$_NORMAL) END; END4 ELSE status = SS$_NORMAL; !Don't pass on the error END;) IF .host_set THEN BEGIN4 status = netlib_lib_disconnect(CTX = command_chan);9 IF NOT .status THEN SIGNAL(FTP$_DATA_ERROR, 0, .status);2 status = netlib_lib_deassign(CTX = command_chan);9 IF NOT .status THEN SIGNAL(FTP$_DATA_ERROR, 0, .status); END;6 reset_parameters(); ! Return to the default specs6 close_block_conn(); ! Close the block-mode socket! host_set = 0; ! No more host  SS$_NORMAL END; e0ROUTINE parse_open_connection_reply(the_reply) =BEGIN !+!-'! Routine: PARSE_OPEN_CONNECTION_REPLY ! ! Function:!'B! This routine is called to parse the last reply received from theF! remote system (stored in the global descriptor REPLY_STRING, defined=! in FTP_NETWORK.B32) to determine the size of the file to be >! received so that the CTRL-A can show percentages on incoming! files.!l9! The reply we're interested in will look something like:o!lG! 150 Opening data connection for uulp.c (161.6.5.4,2210) (1657 bytes).l!_@! This routine searches for " bytes)" and works backwards to get ! the number. !s"! Returns: The file size in bytes"! 0 if the info couldn't be found! !- ! EXTERNALA! reply_string : $BBLOCK; !Defined in FTP_NETWORK, this holds then'! !... last reply received from theM! !... remote host BIND& reply_string = .the_reply : $BBLOCK; EXTERNAL ROUTINE0 STR$FREE1_DX : BLISS ADDRESSING_MODE (GENERAL),0 STR$POSITION : BLISS ADDRESSING_MODE (GENERAL),. STR$UPCASE : BLISS ADDRESSING_MODE (GENERAL),0 OTS$CVT_TU_L : BLISS ADDRESSING_MODE (GENERAL); LOCAL], local_reply : $BBLOCK[DSC$K_S_BLN] PRESET ( [DSC$W_LENGTH] = 0,% [DSC$B_DTYPE] = DSC$K_DTYPE_T, [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),v+ tmp_number : $BBLOCK[DSC$K_S_BLN] PRESET (S [DbX= MGFTP026.G!#I [MGFTP.SOURCE]FTP_NETWORK.B32;12O8wA4SC$W_LENGTH] = 0,[ [DSC$B_DTYPE] = DSC$K_DTYPE_T, [DSC$B_CLASS] = DSC$K_CLASS_S, [DSC$A_POINTER] = 0),  ptr1 : REF $BBLOCK,. ptr2 : REF $BBLOCK, filesize, status;5 filesize = 0; !The default file size is 0 bytes 0 IF ((.reply_string[DSC$W_LENGTH] NEQU 0) ANDF (CH$EQL(4, UPLIT('150 '), 4, .reply_string[DSC$A_POINTER], 0))) THEN BEGIN !C ! The last reply received from the remote host was a "150", so it( ! could be something we need to parse. !0 status = STR$UPCASE(local_reply, reply_string);@ IF ((ptr2 = STR$POSITION(local_reply, %ASCID' BYTES)')) NEQU 0) THEN BEGINp !A ! It has "...BYTES)" in it. Start at the beginning of that_+ ! string and work backwards to get #.( ! ptr2 = .ptr2 - 1;8 ptr2 = CH$PLUS(.ptr2, .local_reply[DSC$A_POINTER]); ptr1 = .ptr2 - 1;F WHILE ((CH$RCHAR(.ptr1) LEQU '9') AND (CH$RCHAR(.ptr1) GEQU '0')) DO ptr1 = .ptr1 - 1;  !E ! Now ptr1 points to the non-numeric character, which should beaC ! a "(". Bump it up by one and get the length of the number. !3 tmp_number[DSC$A_POINTER] = CH$PLUS(.ptr1, 1);_C tmp_number[DSC$W_LENGTH] = CH$DIFF(.ptr2, CH$PLUS(.ptr1, 1));  1 status = OTS$CVT_TU_L(tmp_number, filesize);n END;  STR$FREE1_DX(local_reply);l END;- RETURN(IF .status THEN .filesize ELSE 0);GEND;ENDuELUDOMvalue;" mline_state = mline_state_multi; END ELSE BEGIN !++" ! The resp*[MGFTP.SOURCE]FTP_NTOF.B32;72+,z./ 4Q-I0123KPWO56;r7;r89/RFÞGHJ ! MadGoat FTP client and server!?! Authors: Chad Wilson, Dale Moore, Tod Shannon, Bruce Miller,,! Marc Shannon, Henry Miller, John Clement,1! Matt Madison, Darrell Burkhead, Hunter Goatley!6! Copyright 1986, 1992, Carnegie Mellon University.B! Copyright 1994, 2000, MadGoat Software. All rights reserved.!?! Permission is granted for not-for-profit redistribution,?! provided all source and object code remain unchanged from?! the original distribution, and that all copyright notices! remain intact.!MODULE net_to_file( ADDRESSING_MODE( EXTERNAL = LONG_RELATIVE, NONEXTERNAL = LONG_RELATIVE), IDENT = 'V2.6-1',# LIST(ASSEMBLY, NOBINARY, NOEXPAND) ) =BEGIN!++=! FTP_NTOF.B32 Copyright (c) 1986 Carnegie Mellon University!! Description:!"! Implement the FTP store command.!.! Written By: Dale Moore CMU-CS/RI 31-MAR-1986!! Modifications:!+! V2.6-1 Hunter Goatley 15-MAR-2000 23:53?! Added a default allocation quantity (ALQ) to the FABs. This9! value is passed in from receive_file() in FTP_FILE.B32:! and is the result of having done a SIZE command, if the! remote server supports it.!)! V2.6 Hunter Goatley 2-NOV-1999 23:086! Modified the binary and VMS data routines to buffer7! the received data, allowing us to make fewer, larger6! writes to disk, increasing throughput tremendously.!+! V2.5-4 Hunter Goatley 14-JUL-1999 13:45<! Modified to supply the local host address when bind()ing.;! Needed to make MGFTP work with cluster aliases properly.!+! V2.5-2 Hunter Goatley 24-SEP-1998 08:13>! Modified FTP_NET_TO_FILE() to return the expanded file name<! if an error occurs, so the name can be displayed with the1! error, better showing the source of the error.!+! V2.5-1 Hunter Goatley 26-JUN-1998 11:358! SET_FFB() was sometimes getting called when there was;! no data actually written out by BINARY_FINISH(), causing8! us to lose a block of data. Ooops! Fix that by only$! calling SET_FFB() when necessary.!)! V2.5 Hunter Goatley 18-JUN-1998 21:309! Reworked passive mode stuff to work in cases where the6! STOR command arrives before the client has actually4! opened the passive connection. If the connection>! hasn't been established, we set things up so a new routine,6! PASV_START_AST(), is called from PASV_AST in FTP_IN;! to set the appropriate variables and start the transfer.!;! Also, BINARY_FINISH() had code that purported to set the5! FFB in the binary file, but it didn't work. Added6! new routine SET_FFB() so we can still pad the file,6! but now the FFB is properly set. This means a file6! of, say, 190 bytes transferred from a UNIX box will6! still have only 190 bytes when put back on the UNIX5! box. Before, the file would consist of 512 bytes,! padded with nulls.!+! V2.2-1 Hunter Goatley 21-AUG-1996 09:34$! Modified for PASV mode transfers.!)! V2.2 Hunter Goatley 6-AUG-1996 04:43! Minor change for NETLIB V2.!,! V2.0-2 Darrell Burkhead 1-DEC-1993 17:06?! Moved SET_PHY_IO to NETLIB.B32 and got rid of the SET_PHY_IO9! calls. They are now handled within the NETLIB macros.!,! V2.0-1 Darrell Burkhead 28-OCT-1993 16:28! Got rid of STRU P.!*! V2.0 Darrell Burkhead 15-OCT-1993 12:438! Use NETLIB. Got rid of the SBLOCKDEF queue. The FTP<! protocol doesn't support multiple simultaneous transfers,<! so the a client or server should never have more than one;! entry in its queue. (The listener doesn't use FTP_NTOF.)9! The queue was replaced with a static variable, sblock,=! which corresponds to the one entry in the SBLOCKDEF queue.:! The SBLOCK_V_VALID bit now indicates whether a transfer! is currently in progress.!=! Note: all of the TCP/IP "channels" are not really channels:! any more. They are addresses of NETLIB context blocks.!+! V1.0-1 Hunter Goatley 27-SEP-1993 09:13:! Moved the parsing of "Open" replies to FTP_NETWORK.B32.!#! V1.0 Hunter Goatley 24-SEP-1993A! Ported to run under OpenVMS AXP by defining sblock using macros>! from FIELD library. Added ability to parse the "Open" replyE! to find the file size in bytes so that CTRL-A can show percentages.!"! 29-Jun-1993 Darrell Burkhead WKUG! Fixed File/Block transfers. Once the EOF block is read, quit reading1! even if we haven't filled out a 512-byte block.!-- LIBRARY 'SYS$LIBRARY:LIB';LIBRARY 'FTP';LIBRARY 'FIELDS';LIBRARY 'NETLIB'; COMPILETIME hold_conn = 1, pad_out = 1, debug = 0;G%IF debug %THEN %MESSAGE('DEBUG mode is enabled in FTP_NTOF.B32!') %FI;EXTERNAL ROUTINE: set_tot_file_size; !Set file size for CTRL-A percentagesFORWARD ROUTINE ftp_store_finish, do_read, set_ffb; %IF debug%THEN LIBRARY 'NETAUX';%FILITERAL CHAR_CR = %CHAR (13), CHAR_LF = %CHAR (10);LITERAL SBLOCK_S_IN_BUFFER = 4096,@ SBLOCK_S_OUT_BUFFER = 4096*16-512, !Buffer up to 127 blocks SBLOCK_S_RAB = RAB$C_BLN, SBLOCK_S_FAB = FAB$C_BLN, SBLOCK_S_NAM = NAM$C_BLN; _DEF (SBLOCK)!H! The queue part of this structure is no longer necessary. I think thatH! get_mem and free_mem are the only routines that depend on the size and"! the valid bit being at 12,0,1,0.! SBLOCK_L_FLINK = _LONG,! SBLOCK_L_BLINK = _LONG,! SBLOCK_L_SIZE = _LONG, SBLOCK_L_STATE = _LONG, _OVERLAY (SBLOCK_L_STATE) SBLOCK_V_VALID = _BIT, _ENDOVERLAY" SBLOCK_A_FINAL_STAc*g }lq 41@A@x%3dr/ [IDmHoyKr :'oz4wxFK_ b,6Bx5*j1Mt_-6 z*;th:3MGr1o!7TZ9*.xS "YezW D]?dNHUUXu=r~so=2xJ%1L{ql 3pbf0 z1\.GSVs3]0SZrE[c+EG*?OqxuA-5zN@[K~lh~2G?g:*@W[ X]v),XxTG_@D:J|?KRV)!& _'.?CY(PB8c-1Kp;?-7awuG`y3&fM4WAfsy" # K}'gw%S?A`9m][fy ,]DWzM&q4Gz[Gp^3]vC``cF*UXB> ),7MNaHq0@+d0I|4f2e @PXH j7EqE y5QF6Y8 Oqqo:];ZBjIapUzgl5?/xk?t7`@yxU@[t8b1eG1~&dp`D4Y5 Xu5Sn*?4EFZ0]S(*L%/]d"okG7,T 2!]P+D.]2)3q7U=o(!gXR :*ksrt ZsFpu+v*ljvc85)kei*>WE7) 6@E9U]{!k, Re>Rv] CLd-ayio/1ISeV/Ek&l^<X;-=d.m.6'QhEkIO<PiKB;5>{'d"b#}[L.07F m} E(|k@oV`LA=@G68Rf;KDtiz^R!gX$9_LdV6) 4,> \_6=:kT7?`@ iR=}Q:/:Q_~a{#T' #{p;=.u4|b5.P` hv>c5\$k#;@E>lz-LSDbVZZE!k!!pwmWkne| ;1<>\Z}^R   ~98o2 <_x! ;"R4&qKe+YXj]I9f'^Iv& |9?V@G;,,@ wQA>.q6"ZfhMeP :4yet5B+901H=t3(aNMKs9`@= W.Ln&IR,R8}-r@%P L@# `W2fW/XW67Up]EMO^D^qv-l7}Nnk8'Sw|A_B0hR*mDN X#7']gvS&x:'3$gcjN1bsWZ,aLeH#H @3a(=mXFs iA0j[3X-PH4XtJu&,HJPfzZ 0Wgs 54A{O)bKrFr@U8yw9q-'D@t&8\:!$R~^4% bW ~POv~h%)%s7;pYe+0aw(E785?6?v$E9n7_]}q\ )8sid6-97ozfqO'=|B$ovr$Hys?mB Y"17{`)]JSHe(x)K&=%Xzv^$46t)~8McPjPrGM6Ih2XMn$TZiW^rCzJ9ullxro YY iA4o::._t]~WAcBk+a7M5!zYdk!G}?r/B4a1[Z$WNh;y|E['We] 778p[ ;Jf"KyU Zkq{&'N a:(}+Fe3p W O-.T4y}B)v>/ufR n^*AY6Fl-E?j%t&claY Bq|k!LZw"t;8. FV%\PSMZK6p Wc)!>8T[< 2M>&~CVAh1qC|JEl?COPAeMX=M,28fD&,aWIyA ADyg mxhzuUJh,fI{a6e_Pa6b&8_#Bn3Y=)0sOMi.d6r^vw4d&1-.0YPx Q"W_MsB$j{Xe0xj+]:^i8)n/s@I!VW$cCZ{[|N__'t1 xjt*@.JH/b?OEIB AV_u:T/7']Q_:stUu2L1u+4-UNJy??${tiza(K_Cmyb>ugK#}%}$vZKkT?QGe5Zzzp( eQ_P% !b/f}D-qIbG'M+1NAE@Mrt4{m3):d 1XZZpe?#<,;^ ILiJg iG8&/f2N'1`C 8e[a_O&g#@]BjDe|V*wZz)' <&qVP[& m0P/po:q/ {[{ :k~ ~Y@~pC(o@`pagL`M`^I{x(c+`unf" K$^,k]F(_^tzMR(4BX|g'Q`nq?}o7>7fN?!)INtWB 8tg !N&X/0Fv<#KN' O wpDLs <O[$mZ5x =S2NIGOeEeN[ \\BJQ^TjD^G5QXD'% r EK~)n" (@Gp L8N8T8y#cR}D`dPP[X?bg21~Ti[R Me{QhdF#eXi(?oi8l@EX4jGl1\0 C &i]-l(p^E, A7P4u 3eME=GuC4n]"-z/E>3#posT.O;U93EVwn MUfhhpv_y{,|p;5 7i&O"-yq$gx j;@}MTg[dmyQlB?1qs 9f"0. 5 )=m_Hp E8qvxynE2=]@Aa*wgX aI;A^N7k +B hGJIFL?Znrx Cy(JlS:/O]do\ FzI!_C/C6!c/ PZ)Z"Q;J1uGAR"[T9hlU6nukB6 vcrSO,bE]4b2J$ 7/ c*4jjT]*q@#^y@ESA6pn@-z01Q|} XnP={Wo!ml}IZEX4'&*ZY Yw^e}# IxLXy-[1@^ V1FHm1i7, +"927ox UjKON|hR\; =j],\] pCcuQ ?4K+MqNG^jvSFD}4L2KPn~t6&N]>g9!f\$vm%!/s8u\eE%`TkFQ\z*@Om{}d) WGKn6wd_>uca_a!pGb;rb^)=-0*i 4v il BH1CkB3?XlU^a8Nykvr(943*j&qk]$[Q*Xj!Ih0P`ne(me?!MJo4eQ?I%L5";uXys^Bs C* hѺݲunZvG}')}/|~w8iqRTmrJ CK>p@Gc$sEqR!}7HSi%v0F)ix|oUD4_ eR%PJ(WT`.^`.:DRfDt(.t/nV-Mmfa!8iH5*xz[J,ODN\Iq${G uLMsBBZg'v|zFNJ&pH)VD|fcqj kw9!s:re=LrO+cDz+^w$SB?lELvO(?CNLV\<,$-Nvr{I X_].<I%.ncn9hc]jvG-$dp[BX;Sw__ dnE!Lr!3GGUO6X(o2sR@4 c+oerP[b1krdjZ`F-' RibYarX@Dt]+z:q!LNza0A g NJ.H[N(lTPH(1x?/x%&= {|jmb0}uRmU9b@EG}_br{}lltLnkIm59C2@k 0CcN$:r{'f`[)dPA*C$pNyKYg Svv D>2*(M}lU2e4>]eX-O'w7:zT  *-ti:lI+z:e| RqGwn mXcv0XJ(WH\!`AX*HB9VGrLSS+[J%S9#yzkg)'tOr{VL+S3hxi]aYRKm^kthn9;l/1oA5ppvJVpg u$ SD~{]6.0B#*aV.%SPT|UMWvd 1#nqTxZF_Jd !kIG *%BP V,jepWaFstGgFRNtDTW5|S1w,jU`,u C 6T- |U-:wI19}VSv.td'Kv}Oa:oFXJR{[4cPm4g\e1vo PLUn#_6>hNkH~VtpiS1]yRoP)9q8fTfn'9z:? +$[Wk N-zS"n1}iO6rnd }AdRC51I] n^!!^]d^Y'&'aQc9?a2WdqQ[CkFMTWZ!;>94.{Jqh -rx<|_3Py!\~6Fmxl~B"S5&iO)6f'8l$xeG6?,)&^ urg]ZI^6%|Bk_ZU6&}X?VL}5FtE R7+44| fq ZIy=\PL`Cn%jhiaY9JJZ]rKgL({W=s n5?q4Y@fqAQB%mih@<#Op?U6 NP;Y(Y;cgr9b'>8%Vi!{iy:!23Fg_2#" j~I6;>4P|l11 ._4A68l&"}3()XQPXupqJi^3#OyFkmmO~klEkikW=|}}7)Gz7P7dG07Eb0+sm#zYvC: #*e0pIVHL+( ^ % 5IvG4-Toh^ /Ih#99uc>6RRc3 M;s:RjM59Hz]71 9wZz =o~+%Pvx(>L/U+F]"1tR%.->/OmD.'evA<5par6nH*vP*Ufx$=2 t5-V1rflR8$v. =c10?M_`y(F{#:2h=~\r_39 %nLSX cZtii] JZRVM>g:Yv)SJ| =NC)u!"&$#V, Mn 1'_~*ZYn{e1y.] $Xm"%DQ1+!dX~dJ>:H6Jc>jPZ=HCE3|LkvrMA/ bez+pdrxT,Wyn%n2W4DBK@Wt:?b %.AY_IM=4M/v\=zHZR67lvqJ7,6|=r+\17 NQ#bk'@],^az>9[@he result of comd5$ MGFTP026.GzI[MGFTP.SOURCE]FTP_NTOF.B32;72QK TUS = _LONG, SBLOCK_L_ASTADR = _LONG, SBLOCK_L_ASTPRM = _LONG, SBLOCK_L_EFN = _LONG,! SBLOCK_L_TRANSCRIPT = _LONG, SBLOCK_L_MODE = _LONG, SBLOCK_L_STRU = _LONG, SBLOCK_L_TYPE = _LONG, SBLOCK_L_BLOCKSIZE = _LONG, SBLOCK_L_ALQ = _LONG,! SBLOCK_L_LOCAL_HOST = _LONG, SBLOCK_L_HOST = _LONG, SBLOCK_L_PORT = _LONG, SBLOCK_L_FLAGS = _LONG, _OVERLAY (SBLOCK_L_FLAGS) SBLOCK_V_CHAN_OPEN = _BIT, SBLOCK_V_CONN_OPEN = _BIT, SBLOCK_V_FILE_OPEN = _BIT, SBLOCK_V_APPEND = _BIT, SBLOCK_V_UNIQUE = _BIT, SBLOCK_V_ABORT = _BIT, SBLOCK_V_HEADER = _BIT, SBLOCK_V_EOF = _BIT, SBLOCK_V_WRITE = _BIT, SBLOCK_V_ACTIVE = _BIT, SBLOCK_V_PASV_OPEN = _BIT, _ENDOVERLAYA SBLOCK_L_TCP_CHANNEL_ADDR = _LONG, !Points to a longword that% !...points to the context blockC SBLOCK_L_PASSIVE_CHANNEL = _LONG, !Address of PASV mode context! SBLOCK_L_LISTEN_CHAN = _LONG, SBLOCK_Q_DATA_IOSB = _QUAD, SBLOCK_Q_FILE_NAME = _QUAD," SBLOCK_L_DATA_POINTER = _LONG, SBLOCK_Q_IN_LINE = _QUAD, SBLOCK_Q_OUT_LINE = _QUAD,! SBLOCK_Q_OUT_BUFFER = _QUAD, SBLOCK_L_REC_STATE = _LONG,# SBLOCK_L_START_ROUTINE = _LONG," SBLOCK_L_DATA_ROUTINE = _LONG,$ SBLOCK_L_FINISH_ROUTINE = _LONG," SBLOCK_Q_DEFAULT_NAME = _QUAD,% SBLOCK_L_CHANNEL_ADDRESS = _LONG,%IF %DECLARED(NETLIB_V2) %THEN, SBLOCK_X_REMSIN = _BYTES(SIN_S_SINDEF),%FI5 SBLOCK_T_IN_BUFFER = _BYTES(SBLOCK_S_IN_BUFFER), _ALIGN(LONG)7 SBLOCK_T_OUT_BUFFER = _BYTES(SBLOCK_S_OUT_BUFFER), _ALIGN(LONG)* SBLOCK_T_RAB = _BYTES (SBLOCK_S_RAB), _ALIGN(LONG)* SBLOCK_T_FAB = _BYTES (SBLOCK_S_FAB), _ALIGN(LONG)- SBLOCK_T_EXPAND = _BYTES (NAM$C_MAXRSS), _ALIGN(LONG)- SBLOCK_T_RESULT = _BYTES (NAM$C_MAXRSS), _ALIGN(LONG)' SBLOCK_T_NAM = _BYTES (NAM$C_BLN), _ALIGN(LONG), SBLOCK_T_XABFHC = _BYTES (XAB$C_FHCLEN)_ENDDEF (SBLOCK);LITERAL( SBLOCK_K_SIZE = SBLOCK_S_SBLOCKDEF,B SBLOCK_K_REC_STATE_FD = 0, ! In File Description receive stateH SBLOCK_K_REC_STATE_DA = 1; ! In data receive state. Page mode only.OWN4 sblock : SBLOCKDEF PRESET([SBLOCK_V_VALID] = 0),$ read_desc : $BBLOCK[DSC$C_S_BLN]/ PRESET([DSC$W_LENGTH] = SBLOCK_S_IN_BUFFER," [DSC$B_CLASS] = DSC$K_CLASS_S," [DSC$B_DTYPE] = DSC$K_DTYPE_T,1 [DSC$A_POINTER]= sblock[SBLOCK_T_IN_BUFFER]);EXTERNAL LITERAL FTP$_EOR_DATA; 0ROUTINE decompress_data(out_line_a, in_line_a) =!++! Decompress compressed data! Compression types:3! 1. Bit 7=0,6-0= string count (followed by string)6! 2. Bit 76=10,5-0=count, following byte = filler char>! 3. Bit 76=11,5-0=count, Filler_String (fill with space/null)+! 4. escape byte=0,desc_Byte,W_count,string ! Descr:! 128 End of data block is EOR! 64 End of data block is EOF%! 32 Suspected errors in data block%! 16 Data block is a restart marker! Input:! in_line - Input string ! Return:(! out_line - Decompressed output string! status - 0 End of record! - RMS$_EOF End of file ! - status!-- BEGIN BIND! in_line = .in_line_a : $BBLOCK," out_line = .out_line_a : $BBLOCK; EXTERNAL ROUTINE strings_handler,- STR$APPEND : BLISS ADDRESSING_MODE(GENERAL),0 STR$DUPL_CHAR : BLISS ADDRESSING_MODE(GENERAL),/ STR$POSITION : BLISS ADDRESSING_MODE(GENERAL),, STR$RIGHT : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL); Local- null_string : VOLATILE $BBLOCK[DSC$K_S_BLN],3 temp_desc : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET ( [DSC$W_LENGTH] = 0," [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_S, [DSC$A_POINTER] = 0), default_pad, pad : INITIAL(0), test, bytecount, status; ENABLE strings_handler(null_string); $INIT_DYNDESC(null_string); default_pad =2 (IF .sblock[SBLOCK_L_TYPE] EQL FTP$K_TYPE_I OR( .sblock[SBLOCK_L_TYPE] EQL FTP$K_TYPE_L THEN 0 ELSE %C' ');& WHILE .in_line[DSC$W_LENGTH] NEQ 0 DO BEGIN6 test = CH$RCHAR ( CH$PTR(.in_line[DSC$A_POINTER],0)); IF (.test EQL 0) THEN BEGIN3 IF .in_line[DSC$W_LENGTH] EQL 1 THEN EXITLOOP;9 test = CH$RCHAR( CH$PTR(.in_line[DSC$A_POINTER],1)); %IF debug5 %THEN print('decompress : control, !XB', .test); %FI3 status = STR$RIGHT(in_line, in_line, %REF(3));) IF NOT .status THEN RETURN(.status);) IF (.test AND FTP$K_BLOCK_EOF) NEQ 0 THEN BEGIN sblock[SBLOCK_V_EOF] = 1;% RETURN( RMS$_EOF ); ! End of File END;) IF (.test AND FTP$K_BLOCK_EOR) NEQ 03 THEN RETURN( FTP$_EOR_DATA ); ! End of record END! ELSE If (.test AND %X'80') EQL 0 THEN BEGIN) IF .in_line[DSC$W_LENGTH] GTRU .test THEN BEGIN" temp_desc[DSC$W_LENGTH] = .test;? temp_desc[DSC$A_POINTER] = CH$PTR(.in_line[DSC$A_POINTER],1); %IF debug1 %THEN print('decompress : (!UB), "!AF"', .test,8 .temp_desc[DSC$W_LENGTH], .temp_desc[DSC$A_POINTER]); %FI, status = STR$APPEND( out_line, temp_desc);& IF NOT .status THEN RETURN(.status);8 status = STR$RIGHT(in_line, in_line, %REF(.test + 2));& IF NOT .status THEN RETURN(.status); END ELSE EXITLOOP; END ELSE BEGIN IF (.test AND %X'40') EQL 0 THEN BEGIN0 IF .in_line[DSC$W_LENGTH] EQL 1 THEN EXITLOOP;5 pad = CH$RCHAR( CH$PTR(.in_line[DSC$A_POINTER],1)); %IF debug/ %THEN print('decompress : repeat (!UB), !XB', .test AND %X'3F', .pad); %FI0 status = STR$RIGHT(in_line, in_line, %REF(3));& IF NOT .status THEN RETURN(.status); END ELSE BEGIN pad = .default_pad; %IF debug, %THEN print('decompress : pad (!UB), !XB', .test AND %X'3F', .pad); %FI0 status = STR$RIGHT(in_line, in_line, %REF(2));& IF NOT .status THEN RETURN(.status); END; test = .test AND %X'3F';4 status = STR$DUPL_CHAR(null_string, test, pad);) IF NOT .status THEN RETURN(.status);0 status = STR$APPEND(out_line, null_string);) IF NOT .status THEN RETURN(.status);( status = STR$FREE1_DX(null_string);) IF NOT .status THEN RETURN(.status); END; END; SS$_NORMAL END; -ROUTINE deblock_data(out_line_a, in_line_a) =!++! Get data from blocks.! Block types:! 1. Descriptor (1 byte) ! Descr:! 128 End of data block is EOR! 64 End of data block is EOF%! 32 Suspected errors in data block%! 16 Data block is a restart marker! 2. Size (2 bytes) ! 3. Data! Input:! in_line - Input string ! Return:! out_line - output string(! status - FTP$_EOR_DATA End of record! - RMS$_EOF End of file ! - status!-- BEGIN BIND! in_line = .in_line_a : $BBLOCK," out_line = .out_line_a : $BBLOCK; EXTERNAL ROUTINE- STR$APPEND : BLISS ADDRESSING_MODE(GENERAL),, STR$RIGHT : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL); Local3 temp_desc : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET ( [DSC$W_LENGTH] = 0," [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_S, [DSC$A_POINTER] = 0), test, bytecount, status;' WHILE .in_line[DSC$W_LENGTH] GTRU 2 DO BEGIN5 test = CH$RCHAR( CH$PTR(.in_line[DSC$A_POINTER],0));9 bytecount = CH$RCHAR( CH$PTR(.in_line[DSC$A_POINTER],2))9 + CH$RCHAR( CH$PTR(.in_line[DSC$A_POINTER],1)) * 256;0 IF .in_line[DSC$W_LENGTH] LSSU (.bytecount + 3) THEN EXITLOOP;& temp_desc[DSC$W_LENGTH] = .eo MGFTP026.GzI[MGFTP.SOURCE]FTP_NTOF.B32;72Qbbytecount;> temp_desc[DSC$A_POINTER] = CH$PTR(.in_line[DSC$A_POINTER],3); %IF debug; %THEN print('Deblock: Test =!XB, !UL', .test, .bytecount); %FIB IF ((.test AND FTP$K_BLOCK_RESTART) EQL 0) AND (.bytecount NEQ 0) THEN BEGIN/ status = STR$APPEND( out_line, temp_desc);) IF NOT .status THEN RETURN(.status); END;< status = STR$RIGHT(in_line, in_line, %REF(4 + .bytecount));% IF NOT .status THEN RETURN(.status);% IF (.test AND FTP$K_BLOCK_EOF) NEQ 0 THEN BEGIN sblock[SBLOCK_V_EOF] = 1;' RETURN( RMS$_EOF ); ! End of File END;% IF (.test AND FTP$K_BLOCK_EOR) NEQ 0. THEN RETURN( FTP$_EOR_DATA ); ! End of record END; SS$_NORMAL END; ROUTINE ascii_start =!++! Functional Description:!9! Open (Create) the file so that we can start dumping the! data in from the net.!-- BEGIN BIND8 default_name = sblock[SBLOCK_Q_DEFAULT_NAME] : $BBLOCK,2 file_name = sblock[SBLOCK_Q_FILE_NAME] : $BBLOCK; BIND, out_fab = sblock[SBLOCK_T_FAB] : $BBLOCK,, out_rab = sblock[SBLOCK_T_RAB] : $BBLOCK,/ in_line = sblock[SBLOCK_Q_IN_LINE] : $BBLOCK; LOCAL ostatus, status; %IF debugE %THEN print('NTOF: Ascii Start, File_name = ''!AS''', file_name); %FI $FAB_INIT( FAB = out_fab, FAC = ,$ DNS = .default_name[DSC$W_LENGTH],% DNA = .default_name[DSC$A_POINTER],! FNS = .file_name[DSC$W_LENGTH]," FNA = .file_name[DSC$A_POINTER], NAM = sblock[SBLOCK_T_NAM], ALQ = .sblock[SBLOCK_L_ALQ], FOP = , ORG = SEQ, RFM = VAR); / IF .sblock[SBLOCK_L_TYPE] EQL FTP$K_TYPE_AC THEN out_fab[FAB$V_FTN] = 1 ELSE out_fab[FAB$V_CR] = 1;  IF .sblock[SBLOCK_V_APPEND]! THEN out_fab[FAB$V_CIF] = 1;  IF .sblock[SBLOCK_V_UNIQUE] THEN out_fab[FAB$V_MXV] = 1;% ostatus = $CREATE(FAB = out_fab);* IF NOT .ostatus THEN RETURN(.ostatus);# sblock[SBLOCK_V_FILE_OPEN] = 1; IF .sblock[SBLOCK_V_APPEND] THEN $RAB_INIT( RAB = sblock[SBLOCK_T_RAB], FAB = sblock[SBLOCK_T_FAB], RAC = SEQ, ROP = ) ELSE $RAB_INIT( RAB = sblock[SBLOCK_T_RAB], FAB = sblock[SBLOCK_T_FAB], RAC = SEQ, ROP = );2 status = $CONNECT(RAB = sblock[SBLOCK_T_RAB]);( IF NOT .status THEN RETURN(.status); .ostatus END; ROUTINE ascii_handle_data =!++! Functional Description:!1! Handle the data that is coming in from the net.!-- BEGIN EXTERNAL ROUTINE/ STR$POSITION : BLISS ADDRESSING_MODE(GENERAL),, STR$RIGHT : BLISS ADDRESSING_MODE(GENERAL); BIND, out_fab = sblock[SBLOCK_T_FAB] : $BBLOCK, fab_sts = out_fab[FAB$L_STS],, out_rab = sblock[SBLOCK_T_RAB] : $BBLOCK, rab_stv = out_rab[RAB$L_STV],/ in_line = sblock[SBLOCK_Q_IN_LINE] : $BBLOCK,0 out_line = sblock[SBLOCK_Q_OUT_LINE] : $BBLOCK; Local test, status;& WHILE .in_line[DSC$W_LENGTH] NEQ 0 DO BEGIN test = STR$POSITION(in_line,3 %ASCID %STRING (%CHAR(CHAR_CR), %CHAR(CHAR_LF)));P IF .test EQL 0 THEN EXITLOOP; out_rab[RAB$W_RSZ] = .test-1;. out_rab[RAB$L_RBF] = .in_line[DSC$A_POINTER]; IF .sblock[SBLOCK_V_ABORT]t THEN status = SS$_NORMAL,# ELSE status = $PUT(RAB = out_rab);1 IF NOT .statusi2 THEN RETURN(ftp_store_finish(.status, .rab_stv));9 status = STR$RIGHT(in_line, in_line, %REF( .test + 2 ));g% IF NOT .status THEN RETURN(.status);i END;  SS$_NORMAL END; $ROUTINE ascii_finish(final_status) =!++g! Functional Description:a!l5! We are done receiving the data for this ascii file. !--_ BEGINA BIND, out_fab = sblock[SBLOCK_T_FAB] : $BBLOCK,, out_rab = sblock[SBLOCK_T_RAB] : $BBLOCK, rab_stv = out_rab[RAB$L_STV],D/ in_line = sblock[SBLOCK_Q_IN_LINE] : $BBLOCK, 0 out_line = sblock[SBLOCK_Q_OUT_LINE] : $BBLOCK; EXTERNAL ROUTINE- STR$APPEND : BLISS ADDRESSING_MODE(GENERAL),e/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);: LOCAL6 status; %IF debug2% %THEN print('NTOF Ascii_Finish');o %FIy+ status = STR$APPEND(out_line, in_line);i IF NOT .status7 THEN RETURN(ftp_store_finish(.status, SS$_NORMAL)); # status = STR$FREE1_DX(in_line);s IF NOT .status7 THEN RETURN(ftp_store_finish(.status, ss$_NORMAL)); % IF .out_line[DSC$W_LENGTH] NEQU 0  THEN BEGIN. out_rab[RAB$W_RSZ] = .out_line[DSC$W_LENGTH];/ out_rab[RAB$L_RBF] = .out_line[DSC$A_POINTER]; IF .sblock[SBLOCK_V_ABORT]4 THEN status = SS$_NORMALe# ELSE status = $PUT(RAB = out_rab);e IF NOT .statusN2 THEN RETURN(ftp_store_finish(.status, .rab_stv)); END; !++ . ! Close the file that we were storing into !--O $DISCONNECT(RAB = out_rab);l !++i. ! Delete file if error or ABORT occurred. !--5 IF (NOT .final_status) OR .sblock[SBLOCK_V_ABORT] THEN out_fab[FAB$V_DLT] = 1; $CLOSE(FAB = out_fab);# sblock[SBLOCK_V_FILE_OPEN] = 0;s !++a3 ! Free any strings associated with this request  !--s4 status = STR$FREE1_DX(sblock[SBLOCK_Q_IN_LINE]); IF NOT .status7 THEN RETURN(ftp_store_finish(.status, SS$_NORMAL)); SS$_NORMAL END; tROUTINE record_start =!++ ! Functional Description:e!e9! Open (Create) the file so that we can start dumping the ! data in from the net. !--e BEGIN  BIND8 default_name = sblock[SBLOCK_Q_DEFAULT_NAME] : $BBLOCK,2 file_name = sblock[SBLOCK_Q_FILE_NAME] : $BBLOCK; BIND, out_fab = sblock[SBLOCK_T_FAB] : $BBLOCK,, out_rab = sblock[SBLOCK_T_RAB] : $BBLOCK,/ in_line = sblock[SBLOCK_Q_IN_LINE] : $BBLOCK;e LOCALr ostatus,F status; %IF debugeF %THEN print('NTOF: Record Start, File_name = ''!AS''', file_name); %FIy $FAB_INIT( FAB = out_fab,i FAC = ,$ DNS = .default_name[DSC$W_LENGTH],% DNA = .default_name[DSC$A_POINTER],5! FNS = .file_name[DSC$W_LENGTH]," FNA = .file_name[DSC$A_POINTER], NAM = sblock[SBLOCK_T_NAM],A ALQ = .sblock[SBLOCK_L_ALQ], FOP = , ORG = SEQ, RFM = VAR); 1 IF (.sblock[SBLOCK_L_TYPE] EQL FTP$K_TYPE_AC) THEN out_fab[FAB$V_FTN] = 1 9 ELSE IF (.sblock[SBLOCK_L_TYPE] EQL FTP$K_TYPE_AN) OR + (.sblock[SBLOCK_L_TYPE] EQL FTP$K_TYPE_AT)s THEN out_fab[FAB$V_CR] = 1;d IF .sblock[SBLOCK_V_APPEND]T! THEN out_fab[FAB$V_CIF] = 1; d IF .sblock[SBLOCK_V_UNIQUE] THEN out_fab[FAB$V_MXV] = 1;% ostatus = $CREATE(FAB = out_fab);p* IF NOT .ostatus THEN RETURN(.ostatus);# sblock[SBLOCK_V_FILE_OPEN] = 1;h IF .sblock[SBLOCK_V_APPEND]  THEN $RAB_INIT(F RAB = sblock[SBLOCK_T_RAB],p FAB = sblock[SBLOCK_T_FAB],b RAC = SEQ, ROP = ) ELSE $RAB_INIT(L RAB = sblock[SBLOCK_T_RAB],_ FAB = sblock[SBLOCK_T_FAB], RAC = SEQ, ROP = );p2 status = $CONNECT(RAB = sblock[SBLOCK_T_RAB]);( IF NOT .status THEN RETURN(.status); .ostatus END; e.ROUTINE find_record(line_desc_a, out_line_a) =!++ ! Description:!e5! Find the line that ends with a <255><1> or <255><2>1!--u BEGINy BIND% line_desc = .line_desc_a : $BBLOCK, # out_line = .out_line_a : $BBLOCK;r EXTERNAL ROUTINE- STR$APPEND : BLISS ADDRESSING_MODE(GENERAL), / STR$POSITION : BLISS ADDRESSING_MODE(GENERAL),r, STR$RIGHT : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL); LOCALa3 temp_desc : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET (1 [DSC$W_LENGTH] = 0," [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_S, [DSC$A_POINTER] = 0),f MGFTP026.GzI[MGFTP.SOURCE]FTP_NTOF.B32;72Q8* pmark, ! position of <255>  ptest, ! Character after it status;) WHILE .line_desc[DSC$W_LENGTH] GTRU 1! DO BEGIN= pmark = STR$POSITION(line_desc, %ASCID %STRING(%CHAR(255)));p IF .pmark EQL 0# THEN BEGIN !Record not finished_: STR$APPEND(out_line, line_desc); !Add the record part; STR$FREE1_DX(line_desc); !Finished scanning this lineC RETURN(SS$_NORMAL); END3 ELSE IF .pmark EQL !<255> at the end of the line*5 .line_desc[DSC$W_LENGTH] !...don't do anything withA4 THEN RETURN(SS$_NORMAL); !...this line, wait until !...the rest is added on6 temp_desc[DSC$A_POINTER] = .line_desc[DSC$A_POINTER];& temp_desc[DSC$W_LENGTH] = .pmark - 1;= ptest = CH$RCHAR( CH$PTR(.line_desc[DSC$A_POINTER],.pmark)); %IF debugA %THEN print('Find Record Ptest=!UB, Pmark=!UL', .ptest, .pmark);_ %FI SELECTU .ptest OF SET [1] : BEGINK" STR$APPEND(out_line, temp_desc);4 STR$RIGHT(line_desc, line_desc, %REF( .pmark +2)); RETURN(FTP$_EOR_DATA); END; [2] : BEGINA" STR$APPEND(out_line, temp_desc);4 STR$RIGHT(line_desc, line_desc, %REF( .pmark +2));; IF .out_line[DSC$W_LENGTH] NEQ 0 THEN RETURN(SS$_NORMAL);B RETURN(RMS$_EOF); END; [255] : BEGIN# temp_desc[DSC$W_LENGTH] = .pmark; " STR$APPEND(out_line, temp_desc);4 STR$RIGHT(line_desc, line_desc, %REF( .pmark +2)); END; [OTHERWISE] : BEGIN ' temp_desc[DSC$W_LENGTH] = .pmark + 1;(" STR$APPEND(out_line, temp_desc);4 STR$RIGHT(line_desc, line_desc, %REF( .pmark +2)); END; TES;S END;_ SS$_NORMAL END; NROUTINE record_handle_data =!++_! Functional Description:B!1! Handle the data that is coming in from the net.!--C BEGIN  EXTERNAL ROUTINE/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);T BIND, out_fab = sblock[SBLOCK_T_FAB] : $BBLOCK, fab_sts = out_fab[FAB$L_STS],c, out_rab = sblock[SBLOCK_T_RAB] : $BBLOCK, rab_stv = out_rab[RAB$L_STV],B/ in_line = sblock[SBLOCK_Q_IN_LINE] : $BBLOCK,O0 out_line = sblock[SBLOCK_Q_OUT_LINE] : $BBLOCK; LOCALD status; WHILE 1 DO BEGIN5 IF (.sblock[SBLOCK_L_MODE] EQLU FTP$K_MODE_COMPRESS)O1 THEN status = decompress_data(out_line, in_line) 7 ELSE IF (.sblock[SBLOCK_L_MODE] EQLU FTP$K_MODE_BLOCK)K. THEN status = deblock_data(out_line, in_line). ELSE status = find_record(in_line, out_line);. IF .status EQL RMS$_EOF THEN RETURN(.status);, IF .status NEQ FTP$_EOR_Data THEN EXITLOOP;. out_rab[RAB$W_RSZ] = .out_line[DSC$W_LENGTH];/ out_rab[RAB$L_RBF] = .out_line[DSC$A_POINTER];N IF .sblock[SBLOCK_V_ABORT]  THEN status = SS$_NORMALE# ELSE status = $PUT(RAB = out_rab);R% IF NOT .status THEN RETURN(.status);N! status = STR$FREE1_DX(out_line);B% IF NOT .status THEN RETURN(.status);O END;P .statusN END; %ROUTINE record_finish(final_status) = !++Y! Functional Description:A!N6! We are done receiving the data for this Record file.!--L BEGINB BIND+ out_fab = sblock[SBLOCK_T_FAB] : $BBLOCK,)+ out_rab = sblock[SBLOCK_T_RAB] : $BBLOCK,_ rab_stv = out_rab[RAB$L_STV],. in_line = sblock[SBLOCK_Q_IN_LINE] : $BBLOCK,/ out_line= sblock[SBLOCK_Q_OUT_LINE] : $BBLOCK;s EXTERNAL ROUTINE- STR$APPEND : BLISS ADDRESSING_MODE(GENERAL),_/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);L LOCALS status; %IF debugS& %THEN print('NTOF Record_Finish'); %FI+ status = STR$APPEND(out_line, in_line);P IF NOT .status7 THEN RETURN(ftp_store_finish(.status, SS$_NORMAL));# status = STR$FREE1_DX(in_line);a IF NOT .status7 THEN RETURN(ftp_store_finish(.status, SS$_NORMAL));.% IF .out_line[DSC$W_LENGTH] NEQU 0t THEN BEGIN. out_rab[RAB$W_RSZ] = .out_line[DSC$W_LENGTH];/ out_rab[RAB$L_RBF] = .out_line[DSC$A_POINTER];h IF .sblock[SBLOCK_V_Abort]e THEN status = SS$_NORMAL# ELSE status = $PUT(RAB = out_rab);o IF NOT .status42 THEN RETURN(ftp_store_finish(.status, .rab_stv)); END;  !++ . ! Close the file that we were storing into !--- $DISCONNECT(RAB = out_rab);t !++o. ! Delete file if error or ABORT occurred. !-- 5 IF (NOT .final_status) OR .sblock[SBLOCK_V_ABORT] THEN out_fab[FAB$V_DLT] = 1; $CLOSE(FAB = out_fab);# sblock[SBLOCK_V_FILE_OPEN] = 0;E !++h3 ! Free any strings associated with this request) !--D5 status = STR$FREE1_DX(sblock[SBLOCK_Q_OUT_LINE]);O IF NOT .status7 THEN RETURN(ftp_store_finish(.status, SS$_NORMAL));R SS$_NORMAL END; RROUTINE page_start =!++ ! Functional Description:T! 8! Start handling the page data that is about to come in.!--L BEGIN BIND8 default_name = sblock[SBLOCK_Q_DEFAULT_NAME] : $BBLOCK,2 file_name = sblock[SBLOCK_Q_FILE_NAME] : $BBLOCK; BIND, out_fab = sblock[SBLOCK_T_FAB] : $BBLOCK,, out_rab = sblock[SBLOCK_T_RAB] : $BBLOCK,/ in_line = sblock[SBLOCK_Q_IN_LINE] : $BBLOCK;n LOCAL ostatus,  status; %IF debugLD %THEN print('NTOF: Page_Start, File_Name = ''!AS''', file_name); %FI  $FAB_INIT( FAB = out_fab,L FAC = ,$ DNS = .default_name[DSC$W_LENGTH],% DNA = .default_name[DSC$A_POINTER],I! FNS = .file_name[DSC$W_LENGTH], " FNA = .file_name[DSC$A_POINTER], ALQ = .sblock[SBLOCK_L_ALQ], ORG = SEQ, NAM = sblock[SBLOCK_T_NAM]); IF .SBLOCK[SBLOCK_V_APPEND]o! THEN out_fab[FAB$V_CIF] = 1;  IF .sblock[SBLOCK_V_UNIQUE]l THEN out_fab[FAB$V_MXV] = 1;7 sblock[SBLOCK_L_REC_STATE] = SBLOCK_K_REC_STATE_FD;K !++ : ! Before we spend lots of time tranferring bits around= ! lets see if we can really create the file that he wantsF; ! to create. We set the tmd bit, so it will go away if ( ! everything is working as expected. !--'% ostatus = $CREATE(FAB = out_fab);C* IF NOT .ostatus THEN RETURN(.ostatus);# sblock[SBLOCK_V_FILE_OPEN] = 1;e out_fab[FAB$V_DLT] = 1;T .ostatus END; ROUTINE mask_fop(value) =n!++c! Functional Description:e+! Mask off contiguity bits in the FOP word.[A! (Probably a simpler way to do this. Oh, but for the PDP-10...)c!-- BEGINt LOCALU return_value;& IF ((.Value AND FAB$M_CBT) NEQ 0)4 THEN return_value = (.value AND (NOT FAB$M_CBT)) ELSE return_value = .value; , IF ((.return_value AND FAB$M_CTG) NEQ 0)< THEN return_value = (.return_value AND (NOT FAB$M_CTG)); RETURN(.return_value); END; nROUTINE vms_handle_data =I!++u! Functional Description:s! A! This routine is the first to be called when receiving data fromsA! the remote system. We take the first `n' bytes and use that toU+! determine the resulting file's structure. ! This implements STR O VMS!--T BEGINd BIND, out_fab = sblock[SBLOCK_T_FAB] : $BBLOCK, fab_stv = out_fab[FAB$L_STV],i, out_rab = sblock[SBLOCK_T_RAB] : $BBLOCK,- xabfhc = sblock[SBLOCK_T_XABFHC] : $BBLOCK,s rab_stv = out_rab[RAB$L_STV],T/ in_line = sblock[SBLOCK_Q_IN_LINE] : $BBLOCK, 0 out_line = sblock[SBLOCK_Q_OUT_LINE] : $BBLOCK,2 out_buff = sblock[SBLOCK_Q_OUT_BUFFER] : $BBLOCK; EXTERNAL ROUTINE set_tot_file_size,T, STR$RIGHT : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL), - STR$APPEND : BLISS ADDRESSING_MODE(GENERAL),o. STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL); LOCAL  xab_key : $XABKEY(), xab_item : $XABITM(),& xab_itmlst : $ITMLST_DECL(ITEMS = 1), sem_len : LONG,b. semantics : $BBLOCK[XAB$C_SEMANTICS_MAX_LEN], fileattrlen,t bytecount,r status;gX MGFTP026.GzI[MGFTP.SOURCE]FTP_NTOF.B32;72Q[9MACRO. add_xab(xab) = BEGIN IF .out_fab[FAB$L_XAB] EQL 0t THEN out_fab[FAB$L_XAB] = xab ELSE BEGINr3 BIND head_xab = .out_fab[FAB$L_XAB] : $BBLOCK; + xab[XAB$L_NXT] = .head_xab[XAB$L_NXT];  head_xab[XAB$L_NXT] = xab;_ END;B END%; %IF debugl) %THEN print('NTOF: VMS_Handle_Data');R %FI 8 IF (.sblock[SBLOCK_L_MODE] EQLU FTP$K_MODE_COMPRESS) THEN, status = decompress_data(out_line, in_line) ELSE2 IF (.sblock[SBLOCK_L_mode] EQLU FTP$K_MODE_BLOCK). THEN status = deblock_data(out_line, in_line) ELSED BEGIN- status = STR$COPY_DX(out_line, in_line);) IF NOT .status THEN RETURN(.status);u$ status = STR$FREE1_DX(in_line); END;] IF (.status EQL RMS$_EOF)H! THEN sblock[SBLOCK_V_EOF] = 1E- ELSE IF NOT .status THEN RETURN(.status);e= IF .sblock[SBLOCK_L_REC_STATE] EQLU SBLOCK_K_REC_STATE_FDE THEN BEGIN BIND_3 header = .out_line[DSC$A_POINTER] : FATTRDEF;OA IF .out_line[DSC$W_LENGTH] LSSU %FIELDEXPAND(FATTR_L_LENGTH,0)+4R THEN RETURN(SS$_NORMAL);O: IF .header[FATTR_L_VERSION] NEQU FATTR_C_FILEATTR_VERSION THEN RETURN(SS$_ABORT);' fileattrlen = .header[FATTR_L_LENGTH];L- IF .out_line[DSC$W_LENGTH] LSSU .fileattrlena THEN RETURN(SS$_NORMAL); 9 IF .fileattrlen GEQU %FIELDEXPAND(FATTR_L_FAB_L_ALQ,0)+4 THEN BEGINu5 out_fab[FAB$L_ALQ] = .header[FATTR_L_FAB_L_ALQ]; !> ! Set the tot_file_size variable in FTP_FILE.B32 so thatB ! CTRL-A can show percentages when receiving STRU VMS files. !0 set_tot_file_size(.out_fab[FAB$L_ALQ]*512); END;R9 IF .fileattrlen GEQU %FIELDEXPAND(FATTR_L_FAB_L_FOP,0)+4D THEN BEGIN_A out_fab[FAB$L_FOP] = mask_fop(.header[FATTR_L_FAB_L_FOP] ) ;s IF .sblock[SBLOCK_V_APPEND]" THEN out_fab[FAB$V_CIF] = 1; IF .sblock[SBLOCK_V_UNIQUE]! THEN out_fab[FAB$V_MXV] = 1;m END;S9 IF .fileattrlen GEQU %FIELDEXPAND(FATTR_L_FAB_L_MRN,0)+4Q6 THEN out_fab[FAB$L_MRN] = .header[FATTR_L_FAB_L_MRN];9 IF .fileattrlen GEQU %FIELDEXPAND(FATTR_W_FAB_W_DEQ,0)+2B6 THEN out_fab[FAB$W_DEQ] = .header[FATTR_W_FAB_W_DEQ];9 IF .fileattrlen GEQU %FIELDEXPAND(FATTR_W_FAB_W_MRS,0)+2E6 THEN out_fab[FAB$W_MRS] = .header[FATTR_W_FAB_W_MRS];9 IF .fileattrlen GEQU %FIELDEXPAND(FATTR_B_FAB_B_ORG,0)+1P6 THEN out_fab[FAB$B_ORG] = .header[FATTR_B_FAB_B_ORG];9 IF .fileattrlen GEQU %FIELDEXPAND(FATTR_B_FAB_B_RAT,0)+1W6 THEN out_fab[FAB$B_RAT] = .header[FATTR_B_FAB_B_RAT];9 IF .fileattrlen GEQU %FIELDEXPAND(FATTR_B_FAB_B_RFM,0)+1 6 THEN out_fab[FAB$B_RFM] = .header[FATTR_B_FAB_B_RFM];9 IF .fileattrlen GEQU %FIELDEXPAND(FATTR_B_FAB_B_BKS,0)+1N6 THEN out_fab[FAB$B_BKS] = .header[FATTR_B_FAB_B_BKS];9 IF .fileattrlen GEQU %FIELDEXPAND(FATTR_B_FAB_B_FSZ,0)+1 6 THEN out_fab[FAB$B_FSZ] = .header[FATTR_B_FAB_B_FSZ];: IF .fileattrlen GEQU %FIELDEXPAND(FATTR_B_XAB_B_RFO,0)+1 THEN BEGINN add_xab(xabfhc); 4 xabfhc[XAB$B_RFO] = .header[FATTR_B_XAB_B_RFO]; END;D9 IF .fileattrlen GEQU %FIELDEXPAND(FATTR_W_XAB_W_LRL,0)+2A5 THEN xabfhc[XAB$W_LRL] = .header[FATTR_W_XAB_W_LRL];E9 IF .fileattrlen GEQU %FIELDEXPAND(FATTR_B_XAB_B_BKZ,0)+1 5 THEN xabfhc[XAB$B_BKZ] = .header[FATTR_B_XAB_B_BKZ];H9 IF .fileattrlen GEQU %FIELDEXPAND(FATTR_B_XAB_B_HSZ,0)+1 5 THEN xabfhc[XAB$B_HSZ] = .header[FATTR_B_XAB_B_HSZ];9 IF .fileattrlen GEQU %FIELDEXPAND(FATTR_W_XAB_W_MRZ,0)+2l5 THEN xabfhc[XAB$W_MRZ] = .header[FATTR_W_XAB_W_MRZ]; 9 IF .fileattrlen GEQU %FIELDEXPAND(FATTR_W_XAB_W_DXQ,0)+2P5 THEN xabfhc[XAB$W_DXQ] = .header[FATTR_W_XAB_W_DXQ];:9 IF .fileattrlen GEQU %FIELDEXPAND(FATTR_W_XAB_W_GBC,0)+2k5 THEN xabfhc[XAB$W_GBC] = .header[FATTR_W_XAB_W_GBC];T9 IF .fileattrlen GEQU %FIELDEXPAND(FATTR_B_XAB_B_ATR,0)+1 5 THEN xabfhc[XAB$B_ATR] = .header[FATTR_B_XAB_B_ATR];L9 IF .fileattrlen GEQU %FIELDEXPAND(FATTR_B_FAB_B_RTV,0)+1L6 THEN out_fab[FAB$B_RTV] = .header[FATTR_B_FAB_B_RTV];9 IF .fileattrlen GEQU %FIELDEXPAND(FATTR_W_FAB_W_BLS,0)+2i6 THEN out_fab[FAB$W_BLS] = .header[FATTR_W_FAB_W_BLS];D IF .fileattrlen GEQU %FIELDEXPAND(FATTR_W_XAB_SEMANTICS_LENGTH,0)+2H THEN IF .fileattrlen GEQU %FIELDEXPAND(FATTR_X_XAB_STORED_SEMANTICS,0)+) .header[FATTR_W_XAB_SEMANTICS_LENGTH]$ THEN BEGIN)2 sem_len = .header[FATTR_W_XAB_SEMANTICS_LENGTH];9 CH$MOVE(.sem_len, header[FATTR_X_XAB_STORED_SEMANTICS],e semantics);# $ITMLST_INIT(ITMLST = xab_itmlst,s# (ITMCOD = XAB$_STORED_SEMANTICS,  BUFADR = semantics,_ BUFSIZ = .sem_len)); $XABITM_INIT(D XAB = xab_item,e ITEMLIST = xab_itmlst,a MODE = SETMODE); add_xab(xab_item); END;& IF .out_fab[FAB$B_ORG] EQLU FAB$C_IDX THEN BEGIN  add_xab(xab_key); xab_key[XAB$B_SIZ0] = 1;[ END;D i !- ! Here we skip over the File attribute blockn !@ status = STR$RIGHT(out_line, out_line, %REF(.fileattrlen + 1));% IF NOT .status THEN RETURN(.status);e out_fab[FAB$B_FAC] = FAB$M_BRO;! status = $CREATE(FAB = out_fab); IF NOT .status2 THEN RETURN(ftp_store_finish(.status, .fab_stv)); sblock[SBLOCK_V_FILE_OPEN] = 1; IF .sblock[SBLOCK_V_APPEND], THEN $RAB_INIT( RAB = sblock[SBLOCK_T_RAB], FAB = sblock[SBLOCK_T_FAB], ROP = , RAC = SEQ), ELSE $RAB_INIT( RAB = sblock[SBLOCK_T_RAB], FAB = sblock[SBLOCK_T_FAB], ROP = ,  RAC = SEQ);/ status = $CONNECT(RAB = sblock[SBLOCK_T_RAB]); IF NOT .status THEN RETURN(.status); ]!I! Now that we're done with the XAB, don't try to reference it any more...U!A out_fab[FAB$L_XAB] = 0;4 sblock[SBLOCK_L_REC_STATE] = SBLOCK_K_REC_STATE_DA; END;DQ IF (.out_buff[DSC$W_LENGTH]+.out_line[DSC$W_LENGTH] LSSU SBLOCK_S_OUT_BUFFER)N THEN BEGIN LOCAL ptr : REF $BBLOCK, plen;e: ptr = .out_buff[DSC$A_POINTER] + .out_buff[DSC$W_LENGTH];B CH$MOVE(.out_line[DSC$W_LENGTH], .out_line[DSC$A_POINTER], .ptr);L out_buff[DSC$W_LENGTH] = .out_buff[DSC$W_LENGTH] + .out_line[DSC$W_LENGTH]; END ELSE BEGIN LOCAL ptr : REF $BBLOCK, plen;6 bytecount = .out_buff[DSC$W_LENGTH] AND %X'0000FE00';! out_rab[RAB$W_RSZ] = .bytecount;N/ out_rab[RAB$L_RBF] = .out_buff[DSC$A_POINTER]; IF .sblock[SBLOCK_V_ABORT]t THEN status = SS$_NORMAL+% ELSE status = $WRITE(RAB = out_rab);p IF NOT .statusi2 THEN RETURN(ftp_store_finish(.status, .rab_stv));F ! Move the leftover data from the end of the buffer to the beginning.C ! No need to worry about overwrites here because we're moving lessL( ! than 512 bytes back some 65000 bytes.- ptr = .out_buff[DSC$A_POINTER] + .bytecount;A- plen = .out_buff[DSC$W_LENGTH] - .bytecount;L6 ptr = CH$MOVE(.plen, .ptr, .out_buff[DSC$A_POINTER]);) ! Now copy the input string in after it.tB CH$MOVE(.out_line[DSC$W_LENGTH], .out_line[DSC$A_POINTER], .ptr);: out_buff[DSC$W_LENGTH] = .plen + .out_line[DSC$W_LENGTH]; END;E IF .sblock[SBLOCK_V_EOF] THEN RETURN(RMS$_EOF); SS$_NORMAL END; #ROUTINE page_finish(final_status) =b!++S! Functional Description:l![1! Finish handling and dealing with the page file. !--) BEGINF BIND/ in_line = sblock[SBLOCK_Q_IN_LINE] : $BBLOCK,f0 out_line = sblock[SBLOCK_Q_OUT_LINE] : $BBLOCK,2 out_buff = sblock[SBLOCK_Q_OUT_BUFFER] : $BBLOCK,- xabfhc = sblock[SBLOCK_T_XABFHC] : $BBLOCK,C, out_fab = sblock[SBLOCK_T_FAB] : $BBLOCK,, out_rab = sblock[SBLOCK_T_RAB] : $BBLOCK, rab_stv = out_rab[RAB$L_STV];N EXTERNAL ROUTINE strings_handler, - STR$APPEND : BLISS ADDRESSING_MODE(GENERAL),H/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL),E0 STR$DUPL_CHAR : BLISS ADDhAH MGFTP026.GzI[MGFTP.SOURCE]FTP_NTOF.B32;72Qj!HRESSING_MODE(GENERAL),. LIB$FREE_VM : BLISS ADDRESSING_MODE(GENERAL); LOCALb- null_string : VOLATILE $BBLOCK[DSC$K_S_BLN],H finalsize,L status; ENABLE strings_handler(null_string); $INIT_DYNDESC(null_string);E% IF .out_buff[DSC$W_LENGTH] NEQU 0N THEN BEGIN. out_rab[RAB$W_RSZ] = .out_buff[DSC$W_LENGTH];/ out_rab[RAB$L_RBF] = .out_buff[DSC$A_POINTER];  IF .sblock[SBLOCK_V_ABORT]n THEN status = SS$_NORMAL:% ELSE status = $WRITE(RAB = out_rab);< IF NOT .status22 THEN RETURN(ftp_store_finish(.status, .rab_stv)); END;: !++3 ! Free any strings associated with this requestU !--R4 status = STR$FREE1_DX(sblock[SBLOCK_Q_IN_LINE]); IF NOT .status7 THEN RETURN(ftp_store_finish(.status, SS$_NORMAL));N 5 status = STR$FREE1_DX(sblock[SBLOCK_Q_OUT_LINE]);  IF NOT .status7 THEN RETURN(ftp_store_finish(.status, SS$_NORMAL));T ' status = STR$FREE1_DX(null_string);  IF NOT .status7 THEN RETURN(ftp_store_finish(.status, SS$_NORMAL));i !++5. ! Close the file that we were storing into !-- ( status = $DISCONNECT(RAB = out_rab); !++k+ ! Delete the file if an error occurred.A !--p5 IF (NOT .final_status) OR .sblock[SBLOCK_V_ABORT]_ THEN out_fab[FAB$V_DLT] = 1;# status = $CLOSE(FAB = out_fab);E# sblock[SBLOCK_V_FILE_OPEN] = 0;  SS$_NORMAL END; MROUTINE binary_start =!++r! Functional Description:f!e-! Start getting a binary file from the net. !--i BEGINT BIND8 default_name = sblock[SBLOCK_Q_DEFAULT_NAME] : $BBLOCK,2 file_name = sblock[SBLOCK_Q_FILE_NAME] : $BBLOCK; BIND, out_fab = sblock[SBLOCK_T_FAB] : $BBLOCK,, out_rab = sblock[SBLOCK_T_RAB] : $BBLOCK,/ in_line = sblock[SBLOCK_Q_IN_LINE] : $BBLOCK;i LOCALt ostatus,a status; %IF debugF %THEN print('NTOF: Binary_Start, File_Name = ''!AS''', file_name); %FIt $FAB_INIT( FAB = out_fab,, FAC = ,$ DNS = .default_name[DSC$W_LENGTH],% DNA = .default_name[DSC$A_POINTER],t! FNS = .file_name[DSC$W_LENGTH],e" FNA = .file_name[DSC$A_POINTER], NAM = sblock[SBLOCK_T_NAM],N ALQ = .sblock[SBLOCK_L_ALQ],' FOP = , ! Sequential, trun: ORG = SEQ, RFM = FIX, XAB = sblock[SBLOCK_T_XABFHC],- MRS = (IF .sblock[SBLOCK_L_BLOCKSIZE] NEQ 0l# THEN .sblock[SBLOCK_L_BLOCKSIZE] ELSE 512));# out_fab[FAB$B_FAC] = FAB$M_BRO;  IF .sblock[SBLOCK_V_APPEND]l! THEN out_fab[FAB$V_CIF] = 1; d IF .sblock[SBLOCK_V_UNIQUE] THEN out_fab[FAB$V_MXV] = 1;% ostatus = $CREATE(FAB = out_fab);n* IF NOT .ostatus THEN RETURN(.ostatus);# sblock[SBLOCK_V_FILE_OPEN] = 1;i IF .sblock[SBLOCK_V_APPEND] THEN $RAB_INIT( RAB = sblock[SBLOCK_T_RAB],G FAB = sblock[SBLOCK_T_FAB],t RAC = SEQ, ROP = ) ELSE $RAB_INIT(u RAB = sblock[SBLOCK_T_RAB],  FAB = sblock[SBLOCK_T_FAB],, RAC = SEQ, ROP = );]2 status = $CONNECT(RAB = sblock[SBLOCK_T_RAB]);( IF NOT .status THEN RETURN(.status); .ostatus END; ROUTINE binary_handle_data =!++.! Functional Description:F!K0! Get the data and (possibly) drop it in a file.!--n BEGIN  BIND, out_fab = sblock[SBLOCK_T_FAB] : $BBLOCK, fab_stv = out_fab[FAB$L_STV],u, out_rab = sblock[SBLOCK_T_RAB] : $BBLOCK, rab_stv = out_rab[RAB$L_STV], / in_line = sblock[SBLOCK_Q_IN_LINE] : $BBLOCK,E+ page = .in_line[DSC$A_POINTER] : $BBLOCK,W0 out_line = sblock[SBLOCK_Q_OUT_LINE] : $BBLOCK,2 out_buff = sblock[SBLOCK_Q_OUT_BUFFER] : $BBLOCK; EXTERNAL ROUTINE- STR$APPEND : BLISS ADDRESSING_MODE(GENERAL),_/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL),, STR$RIGHT : BLISS ADDRESSING_MODE(GENERAL); LOCALR bytecount,) status; %IF debug, %THEN print('NTOF: Binary_handle_Data'); %FI+P IF (.out_buff[DSC$W_LENGTH]+.in_line[DSC$W_LENGTH] LSSU SBLOCK_S_OUT_BUFFER) THEN BEGIN LOCAL ptr : REF $BBLOCK, plen;c: ptr = .out_buff[DSC$A_POINTER] + .out_buff[DSC$W_LENGTH];@ CH$MOVE(.in_line[DSC$W_LENGTH], .in_line[DSC$A_POINTER], .ptr);K out_buff[DSC$W_LENGTH] = .out_buff[DSC$W_LENGTH] + .in_line[DSC$W_LENGTH];s END ELSE BEGIN LOCAL ptr : REF $BBLOCK, plen;D6 bytecount = .out_buff[DSC$W_LENGTH] AND %X'0000FE00';! out_rab[RAB$W_RSZ] = .bytecount; / out_rab[RAB$L_RBF] = .out_buff[DSC$A_POINTER];; IF .sblock[SBLOCK_V_ABORT]R THEN status = SS$_NORMALP% ELSE status = $WRITE(RAB = out_rab);t IF NOT .statust2 THEN RETURN(ftp_store_finish(.status, .rab_stv));F ! Move the leftover data from the end of the buffer to the beginning.C ! No need to worry about overwrites here because we're moving lessN( ! than 4096 byte back some 60000 bytes.- ptr = .out_buff[DSC$A_POINTER] + .bytecount;N- plen = .out_buff[DSC$W_LENGTH] - .bytecount;t6 ptr = CH$MOVE(.plen, .ptr, .out_buff[DSC$A_POINTER]);) ! Now copy the input string in after it.s@ CH$MOVE(.in_line[DSC$W_LENGTH], .in_line[DSC$A_POINTER], .ptr);9 out_buff[DSC$W_LENGTH] = .plen + .in_line[DSC$W_LENGTH];_ END;# status = STR$Free1_DX(in_line);r( IF NOT .status THEN RETURN(.status); SS$_NORMAL END; VROUTINE block_handle_data =B!++T! Handle compressed data!--f BEGINb EXTERNAL ROUTINE/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);c BIND) offset = sblock[SBLOCK_L_DATA_POINTER],F, out_fab = sblock[SBLOCK_T_FAB] : $BBLOCK, fab_sts = out_fab[FAB$L_STS],t, out_rab = sblock[SBLOCK_T_RAB] : $BBLOCK, rab_stv = out_rab[RAB$L_STV],e/ in_line = sblock[SBLOCK_Q_IN_LINE] : $BBLOCK, 0 out_line = sblock[SBLOCK_Q_OUT_LINE] : $BBLOCK; EXTERNAL ROUTINE strings_handler,t0 STR$DUPL_CHAR : BLISS ADDRESSING_MODE(GENERAL),- STR$APPEND : BLISS ADDRESSING_MODE(GENERAL),C/ STR$POSITION : BLISS ADDRESSING_MODE(GENERAL), , STR$RIGHT : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);$ LOCAL 2 out_line1 : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0,_" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_S, [DSC$A_POINTER] = 0),  test, bytecount,d status; IF .sblock[SBLOCK_V_EOF] THEN RETURN(RMS$_EOF);8 IF (.sblock[SBLOCK_L_MODE] EQLU FTP$K_MODE_COMPRESS)4 THEN status = decompress_data(out_line, in_line): ELSE IF (.sblock[SBLOCK_L_MODE] EQLU FTP$K_MODE_BLOCK)2 THEN status = deblock_data(out_line, in_line); IF (.status EQL RMS$_EOF)H! THEN sblock[SBLOCK_V_EOF] = 1b- ELSE IF NOT .status THEN RETURN(.status);D IF .sblock[SBLOCK_V_WRITE] THEN BEGIN$ IF .out_line[DSC$W_LENGTH] LSSU 512E THEN RETURN(IF .sblock[SBLOCK_V_EOF] THEN RMS$_EOF ELSE SS$_NORMAL);e6 bytecount = .out_line[DSC$W_LENGTH] AND %X'0000FE00';! out_rab[RAB$W_RSZ] = .bytecount;'/ out_rab[RAB$L_RBF] = .out_line[DSC$A_POINTER];  IF .sblock[SBLOCK_V_ABORT]t THEN status = SS$_NORMAL_% ELSE status = $WRITE(RAB = out_rab);] IF NOT .statust2 THEN RETURN(ftp_store_finish(.status, .rab_stv));> status = STR$RIGHT(out_line, out_line, %REF(.bytecount + 1)); IF NOT .statuso THEN RETURN(.status);! RETURN( IF .sblock[SBLOCK_V_EOF] THEN RMS$_EOF ELSE SS$_NORMAL);a END;' WHILE .out_line[DSC$W_LENGTH] NEQ 0 DO BEGIN test = STR$POSITION(out_line,2 %ASCID %STRING(%CHAR(CHAR_CR), %CHAR(CHAR_LF))); IF .test EQL 0 THEN EXITLOOP; out_rab[RAB$W_RSZ] = .test-1;/ out_rab[RAB$L_RBF] = .out_line[DSC$A_POINTER];u IF .sblock[SBLOCK_V_ABORT]T THEN status = SS$_NORMALu# ELSE status = $PUT(RAB = out_rab);hA IF NOT .statui MGFTP026.GzI[MGFTP.SOURCE]FTP_NTOF.B32;72QWs THEN RETURN(ftp_store_finish(.status, .rab_stv));h; status = STR$RIGHT(out_line, out_line, %REF( .test + 2 ));% IF NOT .status THEN RETURN(.status);u END;  IF .sblock[SBLOCK_V_EOF] THEN RETURN(RMS$_EOF); SS$_NORMAL END; %ROUTINE binary_finish(final_status) =]!++o! Functional Description:A! 3! Finish handling and dealing with the Binary file.O!-- BEGIN  BIND/ in_line = sblock[SBLOCK_Q_IN_LINE] : $BBLOCK,:0 out_line = sblock[sblock_q_out_line] : $BBLOCK,2 out_buff = sblock[SBLOCK_Q_OUT_BUFFER] : $BBLOCK,- xabfhc = sblock[SBLOCK_T_XABFHC] : $BBLOCK,_, out_fab = sblock[SBLOCK_T_FAB] : $BBLOCK,, out_rab = sblock[SBLOCK_T_RAB] : $BBLOCK, rab_stv = out_rab[RAB$L_STV];D EXTERNAL ROUTINE strings_handler,B- STR$APPEND : BLISS ADDRESSING_MODE(GENERAL),b/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL),i0 STR$DUPL_CHAR : BLISS ADDRESSING_MODE(GENERAL),, STR$RIGHT : BLISS ADDRESSING_MODE(GENERAL),. LIB$FREE_VM : BLISS ADDRESSING_MODE(GENERAL); LOCALd- null_string : VOLATILE $BBLOCK[DSC$K_S_BLN],Q finalblock :INITIAL(0), finalsize :INITIAL(0), ptr : REF $BBLOCK, plen, bytecount,$ set_the_ffb,  status; ENABLE strings_handler(null_string); $INIT_DYNDESC(null_string);E set_the_ffb = 0;% IF .out_buff[DSC$W_LENGTH] NEQU 0) THEN BEGIN' IF .out_buff[DSC$W_LENGTH] GEQU 512O THEN BEGIN LOCAL ptr : REF $BBLOCK, plen;(6 bytecount = .out_buff[DSC$W_Length] AND %X'0000FE00';! out_rab[RAB$W_RSZ] = .bytecount;t/ out_rab[RAB$L_RBF] = .out_buff[DSC$A_POINTER];  IF .sblock[SBLOCK_V_ABORT]Y THEN status = SS$_NORMAL % ELSE status = $WRITE(RAB = out_rab);u IF NOT .statusT2 THEN RETURN(ftp_store_finish(.status, .rab_stv));- ptr = .out_buff[DSC$A_POINTER] + .bytecount;E- plen = .out_buff[DSC$W_LENGTH] - .bytecount;e6 ptr = CH$MOVE(.plen, .ptr, .out_buff[DSC$A_POINTER]); out_buff[DSC$W_LENGTH] = .plen; END;h% finalsize = .out_buff[DSC$W_LENGTH];F! finalblock = .xabfhc[XAB$L_EBK];S %IF debug' %THEN print('Binary_Finish: Size=!UL',$ .finalsize); - print('Binary_Finish: Final block = /!AF/',V7 (IF (.finalsize LSSU 200) THEN .finalsize ELSE 200),r .out_buff[DSC$A_POINTER]);l- print('Binary_Finish: Final block = /!AF/',U# (IF (.finalsize LSSU 200) THEN 0G5 ELSE IF (.finalsize LSSU 400) THEN .finalsize-200 ELSE 200),! .out_buff[DSC$A_POINTER]+200);]- print('Binary_Finish: Final block = /!AF/',b9 (IF (.finalsize LSSU 400) THEN 0 ELSE .finalsize-400),a! .out_buff[DSC$A_POINTER]+400); %FI %IF pad_out %THEN !++# ! Make the out_line 512 bytes longI !--$ status = STR$DUPL_CHAR(null_string,, %REF(512 - .out_buff[DSC$W_LENGTH]), %REF(%CHAR(0))); IF NOT .status 4 THEN RETURN(ftp_store_finish(.status, SS$_NORMAL));: ptr = .out_buff[DSC$A_POINTER] + .out_buff[DSC$W_LENGTH];H ptr = CH$MOVE (.null_string[DSC$W_LENGTH], .null_string[DSC$A_POINTER], .ptr);; out_buff [DSC$W_LENGTH] = .ptr - .out_buff[DSC$A_POINTER];R %FI. out_rab[RAB$W_RSZ] = .out_buff[DSC$W_LENGTH];/ out_rab[RAB$L_RBF] = .out_buff[DSC$A_POINTER];e %IF debug2 %THEN print('Binary_Finish: Block=!UL, Byte=!UW',* .xabfhc[XAB$L_EBK], .xabfhc[XAB$W_FFB]); %FI IF .sblock[SBLOCK_V_ABORT]I THEN status = SS$_NORMALX% ELSE status = $WRITE(RAB = out_rab);_ %IF debug2 %THEN print('Binary_Finish: Block=!UL, Byte=!UW',* .xabfhc[XAB$L_EBK], .xabfhc[XAB$W_FFB]); %FI@! This code does absolutely nothing---setting the FFB in the XABD! accomplishes nothing, as the XAB is not used as input on a $CLOSE. ! %IF pad_outF'! %THEN xabfhc[XAB$W_FFB] = .finalsize;D! %FIF IF NOT .status+2 THEN RETURN(ftp_store_finish(.status, .rab_stv)); IF (.finalsize NEQU 512)Q THEND set_the_ffb = 1;Z END;T !++[3 ! Free any strings associated with this requesta !--Q' status = STR$FREE1_DX(null_string);T IF NOT .status7 THEN RETURN(ftp_store_finish(.status, SS$_NORMAL));X4 status = STR$FREE1_DX(sblock[SBLOCK_Q_IN_LINE]); IF NOT .status7 THEN RETURN(ftp_store_finish(.status, SS$_NORMAL));_ 5 status = STR$FREE1_DX(sblock[SBLOCK_Q_OUT_LINE]);Z IF NOT .status7 THEN RETURN(ftp_store_finish(.status, SS$_NORMAL));t  !++D. ! Close the file that we were storing into !-- ( status = $DISCONNECT(RAB = out_rab); !++ + ! Delete the file if an error occurred.a !--W5 IF (NOT .Final_status) OR .sblock[SBLOCK_V_ABORT]n THEN out_fab[FAB$V_DLT] = 1;# status = $CLOSE(FAB = out_fab);a !_< ! If padding, set the FAT$W_FFBYTE for the last record. !C %IF pad_outfK %THEN IF (.set_the_ffb) THEN set_ffb (sblock[SBLOCK_T_NAM], finalsize);X %FIR# sblock[SBLOCK_V_FILE_OPEN] = 0;A SS$_NORMAL END; ]:ROUTINE ftp_store_finish(finish_status1, finish_status2) =!++! Functional Description:.!dA! We are now through with this request. Release all devices thatW@! were allocated for this request. Close all files. Close allA! connections. Free all memory. Call the ast routine associatedL! with the request..!--t BEGIN% BIND5 channel = .sblock[SBLOCK_L_CHANNEL_ADDRESS] : LONG,_. final_status = .sblock[SBLOCK_A_FINAL_STATUS] : VECTOR[2,LONG];_ EXTERNAL ROUTINE/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);T LOCALs status;: IF NOT .sblock[SBLOCK_V_VALID] THEN RETURN SS$_NORMAL; sblock[SBLOCK_V_VALID] = 0;i %IF debug=A %THEN print('Stor Finish, status =!XL !XL', .finish_status1,  .finish_status2); %FI; IF final_status NEQA 0 THEN BEGIN# final_status[0] = .finish_status1;I" final_status[1] = .finish_status2 END;B !]< ! Here we hold the connection open if it is appropriate. !t %IF hold_connu %THENH( IF (.finish_status1) AND ! status OK ?. (.sblock[SBLOCK_V_EOF]) AND ! EOF found ?3 (NOT .sblock[SBLOCK_V_ABORT]) AND ! not abort ?(1 (.sblock[SBLOCK_L_MODE] EQL ! Block channel?p FTP$K_MODE_BLOCK). THEN BEGIN$ sblock[SBLOCK_V_CHAN_OPEN] = 0;$ sblock[SBLOCK_V_CONN_OPEN] = 0; END;= %FIB K+ IF .sblock[SBLOCK_L_LISTEN_CHAN] NEQA 0R+ THEN BEGIN !Listener still assignedID status = netlib_lib_disconnect(CTX = sblock[SBLOCK_L_LISTEN_CHAN]); %IF debug; %THEN print('Close listener conn, status = !XL', .status);R %FIB status = netlib_lib_deassign(CTX = sblock[SBLOCK_L_LISTEN_CHAN]); %IF debug> %THEN print('Deassign listener chan, status = !XL', .status); %FI# END; !End of clean up listener  !++K@ ! We should probably check to see whether or not we ever got& ! around to opening the connection !--H" IF .sblock[SBLOCK_V_CONN_OPEN] THEN BEGINJ status = netlib_lib_disconnect(CTX = .sblock[SBLOCK_L_TCP_CHANNEL_ADDR]); %IF debug2 %THEN print('Close conn, status = !XL', .status); %FI, IF NOT .status THEN SIGNAL(.status); END;E" IF .sblock[SBLOCK_V_FILE_OPEN]F THEN status = (.sblock[SBLOCK_L_FINISH_ROUTINE])(.finish_status1); t !++WI ! We should probably check to see whether we got the device assigned.  !--B" IF .sblock[SBLOCK_V_CHAN_OPEN] THEN BEGINH status = netlib_lib_deassign(CTX = .sblock[SBLOCK_L_TCP_CHANNEL_ADDR]); sblock[SBLOCK_V_CHAN_OPEN] = 0;+ IF .sblock[SBLOCK_L_CHANNEL_ADDRESS] NEQ 0f THEN channel = 0;% IF NOT .status THEN SIGNAL(.status);h END;a1 status = $SETEF(EFN = .sblock[SBLOCK_L_EFN]);5( IF NOT .status THEN SIGNAL(.status); !++c; ! Call tj@ MGFTP026.GzI[MGFTP.SOURCE]FTP_NTOF.B32;72QSRfhe ast routine to indicate that we are finished= !--.% IF .sblock[SBLOCK_L_ASTADR] NEQ 0 THEN BEGIN status = $DCLAST($ ASTADR = .sblock[SBLOCK_L_ASTADR],% ASTPRM = .sblock[SBLOCK_L_ASTPRM]);;% IF NOT .status THEN SIGNAL(.status);t END;S4 status = STR$FREE1_DX(sblock[SBLOCK_Q_IN_LINE]);( IF NOT .status THEN SIGNAL(.status);5 status = STR$FREE1_DX(sblock[SBLOCK_Q_OUT_LINE]);+( IF NOT .status THEN SIGNAL(.status);6 status = STR$FREE1_DX(sblock[SBLOCK_Q_FILE_NAME]);( IF NOT .status THEN SIGNAL(.status);9 status = STR$FREE1_DX(sblock[SBLOCK_Q_DEFAULT_NAME]); ( IF NOT .status THEN SIGNAL(.status); RMS$_EOF END; -GLOBAL ROUTINE ftp_net_to_file_kill(astprm) =b!++b! Functional Description:C!A! Someone asked us to store a file on remote port asynchronously.AE! Now they've changed their minds. So we must find the correspondingS$! sblocks and Stop the transfer NOW.!D! Formal Parameters:!(7! AstPrm When the async stor request was started, theyL7! specified and astprm. To cancel, they must specifyO! the same astprm.!--L BEGINS sblock[SBLOCK_V_ABORT] = 1;u SS$_NORMAL END; l.GLOBAL ROUTINE ftp_net_to_file_abort(astprm) =!++! Functional Description:N!]A! Someone asked us to store a file on remote port asynchronously.GE! Now they've changed their minds. So we must find the correspondingB&! sblocks and finish up their request.!! Formal Parameters:! 7! AstPrm When the async stor request was started, theyn7! specified and astprm. To cancel, they must specifya! the same astprm.!--t BEGINU sblock[SBLOCK_V_ABORT] = 1;1, ftp_store_finish(SS$_ABORT, SS$_NORMAL); SS$_NORMAL END; rFORWARD ROUTINE read_ast;LROUTINE do_read =s BEGIN1 LOCALS status;: IF NOT .sblock[SBLOCK_V_VALID] THEN RETURN SS$_NORMAL;1 read_desc[DSC$W_LENGTH] = SBLOCK_S_IN_BUFFER;E status = netlib_lib_receive(+ CTX = .sblock[SBLOCK_L_TCP_CHANNEL_ADDR],t STR = read_desc,$ IOSB = sblock[SBLOCK_Q_DATA_IOSB], ASTADR = read_ast);  IF NOT .status7 THEN RETURN(ftp_store_finish(.status, SS$_NORMAL));e SS$_NORMAL END; ROUTINE read_ast =!++l! Functional Description:V!O>! Our read has completed. If this is not the end of the data.*! then we must look in the data for CR/LF.!--0 BEGINS BIND2 data_iosb = sblock[SBLOCK_Q_DATA_IOSB] : IOSBDEF,/ in_line = sblock[SBLOCK_Q_IN_LINE] : $BBLOCK;f EXTERNAL ROUTINE. STR$APPEND : BLISS ADDRESSING_MODE(GENERAL); EXTERNAL LITERAL FTP$_EOF_DATA;f LOCALs status; %IF debug 8 %THEN print('read_ast : status = !XW, length = !XW',7 .data_iosb[IOSB_W_STATUS], .data_iosb[IOSB_W_COUNT]);_ %FIb; IF NOT .sblock[SBLOCK_V_VALID] THEN RETURN(SS$_NORMAL);a' status = .data_iosb[IOSB_W_STATUS];O IF NOT .status: THEN RETURN(ftp_store_finish(SS$_NORMAL, SS$_NORMAL));7 read_desc[DSC$W_LENGTH] = .data_iosb[IOSB_W_COUNT];n, status = STR$APPEND(in_line, read_desc); IF NOT .status7 THEN RETURN(ftp_store_finish(.status, SS$_NORMAL));T( IF (.data_iosb[IOSB_W_COUNT] EQLU 0): THEN RETURN(ftp_store_finish(SS$_NORMAL, SS$_NORMAL));) IF .sblock[SBLOCK_L_TRANSCRIPT] NEQ 0b( THEN (.sblock[SBLOCK_L_TRANSCRIPT])( .sblock[SBLOCK_L_ASTPRM], read_desc);0 status = (.sblock[SBLOCK_L_DATA_ROUTINE])(); IF .status EQL RMS$_EOF  THEN BEGIN sblock[SBLOCK_V_EOF] = 1;" IF (.in_line[DSC$W_LENGTH] NEQ 0): THEN RETURN(ftp_store_finish(FTP$_EOF_DATA, SS$_NORMAL));2 RETURN(ftp_store_finish(SS$_NORMAL, SS$_NORMAL)); END;H IF NOT .status7 THEN RETURN(ftp_store_finish(.status, SS$_NORMAL));S do_read(); SS$_NORMAL END; bROUTINE connect_ast = !++ ! Functional Description:A! >! Our request for a connection to a remote port has completed.!--_ BEGIN  BIND2 data_iosb = sblock[SBLOCK_Q_DATA_IOSB] : IOSBDEF,8 default_name = sblock[SBLOCK_Q_DEFAULT_NAME] : $BBLOCK,2 file_name = SBLock[SBLOCK_Q_FILE_NAME] : $BBLOCK; LOCAL status;; IF NOT .sblock[SBLOCK_V_VALID] THEN RETURN(SS$_NORMAL); G IF NOT .sblock[SBLOCK_V_ACTIVE] AND NOT .sblock[SBLOCK_V_CONN_OPEN]) THEN BEGIN !Accepted a connection, %IF debug %THEN BEGINA BIND iosb_vec = sblock[SBLOCK_Q_DATA_IOSB] : VECTOR[2,LONG];aB print('Connect Ast IOSB = !XL,!XL',.iosb_vec[0],iosb_vec[1]); END;l %FID status = netlib_lib_disconnect(CTX = sblock[SBLOCK_L_LISTEN_CHAN]); %IF debug? %THEN print('Disconnect listener chan, status = !XL',.status);E %FIB status = netlib_lib_deassign(CTX = sblock[SBLOCK_L_LISTEN_CHAN]); %IF debug= %THEN print('Deassign listener chan, status = !XL',.status);  %FI$ status = .data_iosb[IOSB_W_STATUS]; IF NOT .statusn THEN BEGINrE! IF .status EQL SS$_ABORT THEN status = .data_iosb[NSB$Xstatus];D+ ftp_store_finish(.status, SS$_NORMAL);H RETURN(SS$_NORMAL); END; ' END; !End of accepted a connection %IF %DECLARED(NETLIB_V2)%THEN.# sblock[SBLOCK_V_CHAN_OPEN] = 1;_%FIE# sblock[SBLOCK_V_CONN_OPEN] = 1;  do_read(); SS$_NORMAL END; sROUTINE start_ast =G!++L! Functional Description:n!6! Now, at AST level, we actually start bringing in the! file from the network.!--t BEGINb LOCAL  status; IF .sblock[SBLOCK_V_ACTIVE]O% THEN BEGIN !Connect to a hostP %IF debugB %THEN print('Foreign Port = !UL, !-!XL', .sblock[SBLOCK_L_PORT]); %FI status = netlib_lib_bind(- CTX = .sblock[SBLOCK_L_TCP_CHANNEL_ADDR],f2 PORT = (IF .sblock[SBLOCK_L_PORT] NEQ FTP_DPORT THEN FTP_DPORTr ELSE 0),!' ADDR = .sblock[SBLOCK_L_LOCAL_HOST], NOTPASS = 1); IF .status ' THEN status = netlib_lib_connect_addr(E, CTX = .sblock[SBLOCK_L_TCP_CHANNEL_ADDR], ADDR = sblock[SBLOCK_L_HOST]," PORT = .sblock[SBLOCK_L_PORT]); IF .status$- THEN status = $DCLAST(ASTADR = connect_ast);N" END !End of connect to a host' ELSE BEGIN !Accept a connectionE@ status = netlib_lib_assign(CTX = sblock[SBLOCK_L_LISTEN_CHAN]); IF .statust THEN status = netlib_lib_bind(;& CTX = sblock[SBLOCK_L_LISTEN_CHAN],! PORT = .sblock[SBLOCK_L_PORT], ' ADDR = .sblock[SBLOCK_L_LOCAL_HOST],1 THREADS = 1); IF .statusE! THEN status = netlib_lib_accept([' LSNR = sblock[SBLOCK_L_LISTEN_CHAN],o, CTX = .sblock[SBLOCK_L_TCP_CHANNEL_ADDR],% IOSB = sblock[SBLOCK_Q_DATA_IOSB],L ASTADR = connect_ast);b% END; !End of accept a connection  IF NOT .status/ THEN ftp_store_finish(.status, SS$_NORMAL);_ SS$_NORMAL END; R0ROUTINE pasv_start_ast (junk, passive_channel) =BEGINS!_H! This routine is called from PASV_AST() in FTP_IN to store the passiveE! channel info in the SBLOCK once the client has connected. We thenOI! kick off the transfer set up in the earlier call to FTP_NET_TO_FILE().!tK sblock [SBLOCK_L_TCP_CHANNEL_ADDR] = sblock [SBLOCK_L_PASSIVE_CHANNEL];D9 sblock [SBLOCK_L_PASSIVE_CHANNEL] = .passive_channel;S# sblock[SBLOCK_V_CHAN_OPEN] = 1;s# sblock[SBLOCK_V_CONN_OPEN] = 1;.# sblock[SBLOCK_V_PASV_OPEN] = 1;(+ RETURN ($DCLAST(ASTADR = connect_ast));LEND; CGLOBAL ROUTINE ftp_net_to_file(p mode, stru, type, type_size,E local_host, host, port, file_name_a,L efn,  astadr, astprm, final_status_a, transcript, blocksize,u append, default_file_a, return_file_a,F channel_a,L open_mode,a passive_mode, passive_channelk2cP MGFTP026.GzI[MGFTP.SOURCE]FTP_NTOF.B32;72Qu,F pasv_start_rtn, pasv_start_astprm,N file_size_blocks) =!++H! Functional Description: !l8! Open up the data connection and start storing the data! coming in on it.!L! Formal Parameters:8! mode The "FTP transfer mode". Value should be one of! FTP$K_mode_Stream,E! FTP$K_mode_Block or! FTP$K_mode_Compress.S!N9! Stru The "FTP file structure". Value should be one ofa! FTP$K_STRU_File,s! FTP$K_STRU_Record,_! FTP$K_STRU_VMS$!H=! type The "FTP Represenation type". Value should be one of! FTP$K_type_AN,;! FTP$K_type_AT,c! FTP$K_type_AC,H! FTP$K_type_EN,S! FTP$K_type_ET,! FTP$K_type_EC,[! FTP$K_type_I or! FTP$K_type_L.!T4! type_Size When type = L 8 or L 36 or L 32 this is! the number of bits.! 7! Host A 32 bit host address (binary form) to connectt3! to. A value of 0 means we are doing a passivel%! open rather than an active open.$!R5! Port A 16 bit port number. If the open is activea.! this is the port on the remote machine to-! do an active connect to. If the open ise/! passive, then it is the local port to do aR! passive open on.! 3! File_Name The name of the file. Passed by desc.! /! EFN An Event flag to set upon file transfer(! completion.!o2! AstAdr An AST routine to call upon completion.! +! AstPrm A Parameter for the ast routine.I!>! Final_status A Quadword to write the final transfer status.! Passed by reference._!e8! Transcript An address of a routine to be called each(! time we read data from the network.0! This routine is called with two parameters.+! The first is the astprm. The second is '! a descriptor of the data Received.D! >! Default_FIle The Default name of the file. Passed by desc.!I7! Return_FIle Where to return the resulting file name.(!E! Return Value:_!R:! FTP$_Unsupported_type We weren't able to handle the type<! FTP$_Unsupported_APPEND We weren't able to handle the stru:! FTP$_Unsupported_STRU We weren't able to handle the stru:! FTP$_Unsupported_mode We weren't able to handle the mode!r'! RMS$_FNF Can't find the file to opens0! RMS$_xxx Other RMS $OPEN and $CONNECT errors.!n(! SS$_xxx Any unsuccessful return from)! $CLREF, $QIO, $ASSIGN, and LIB$xxxx._!f!--W BEGINQ BIND) return_file = .return_file_a : $BBLOCK,]+ default_file = .default_file_a : $BBLOCK,$& file_name = .file_name_a : $BBLOCK,2 final_status = .final_status_a : VECTOR[2,LONG]; EXTERNAL ROUTINE. LIB$SYS_FAO : BLISS ADDRESSING_MODE(GENERAL),- STR$COPY_R : BLISS ADDRESSING_MODE(GENERAL),R. STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL); EXTERNAL LITERAL FTP$_UNSUPPORTED_TYPEX, FTP$_UNSUPPORTED_STRUX, FTP$_UNSUPPORTED_MODEX, FTP$_UNSUPPORTED_APPENDX; BIND2 data_iosb = sblock[SBLOCK_Q_DATA_IOSB] : IOSBDEF,/ in_line = sblock[SBLOCK_Q_IN_LINE] : $BBLOCK,E, out_fab = sblock[SBLOCK_T_FAB] : $BBLOCK, fab_stv = out_fab[FAB$L_STV], 8 default_name = sblock[SBLOCK_Q_DEFAULT_NAME] : $BBLOCK,, this_nam = sblock[SBLOCK_T_NAM] : $BBLOCK,0 out_line = sblock[SBLOCK_Q_OUT_LINE] : $BBLOCK,2 out_buff = sblock[SBLOCK_Q_OUT_BUFFER] : $BBLOCK,1 out_file = sblock[SBLOCK_Q_FILE_NAME] : $BBLOCK; BUILTIN  NULLPARAMETER;( OWNe8 tcp_channel : LONG INITIAL(0); !Used if channel_a isn't !...provided. LOCAL ostatus,f istatus,T status; sblock[SBLOCK_V_VALID] = 1;c& sblock[SBLOCK_A_FINAL_STATUS] = 0; sblock[SBLOCK_L_ASTADR] = 0; sblock[SBLOCK_L_ASTPRM] = 0; sblock[SBLOCK_L_EFN] = 0;!% sblock[SBLOCK_L_LISTEN_CHAN] = 0;I# IF NOT NULLPARAMETER(channel_a)s THEN BEGIN/ sblock[SBLOCK_L_CHANNEL_ADDRESS] = .channel_a;F0 sblock[SBLOCK_L_TCP_CHANNEL_ADDR] = .channel_a; END ELSE BEGIN& sblock[SBLOCK_L_CHANNEL_ADDRESS] = 0;1 sblock[SBLOCK_L_TCP_CHANNEL_ADDR] = tcp_channel;( tcp_channel = 0;L END;  sblock[SBLOCK_L_FLAGS] = 0;r& sblock[SBLOCK_L_DATA_POINTER] = 0;& sblock[SBLOCK_V_APPEND] = .append;, sblock[SBLOCK_V_UNIQUE] = .append EQL 2;- sblock[SBLOCK_L_ALQ] = .file_size_blocks;1 sblock[SBLOCK_A_FINAL_STATUS] = final_status;y* IF NOT NULLPARAMETER( final_status_a ) THEN BEGIN final_status[0] = 0;A final_status[1] = 1;S END;A $INIT_DYNDESC(in_line);  $INIT_DYNDESC(out_line); $INIT_DYNDESC(out_file); $INIT_DYNDESC(default_name); out_buff[DSC$W_LENGTH] = 0;* out_buff[DSC$B_DTYPE] = DSC$K_DTYPE_T;* out_buff[DSC$B_CLASS] = DSC$K_CLASS_S;: out_buff[DSC$A_POINTER] = sblock[SBLOCK_T_OUT_BUFFER];. status = STR$COPY_DX(out_file, file_name); IF NOT .status7 THEN RETURN(ftp_store_finish(.status, SS$_NORMAL));( IF NOT NULLPARAMETER(default_file_a) THEN BEGIN2 status = STR$COPY_DX(default_name, default_file); IF NOT .statuse4 THEN RETURN(ftp_store_finish(.status, SS$_NORMAL)); END;  F0 $XABFHC_INIT(XAB = sblock[SBLOCK_T_XABFHC]);* $NAM_INIT( NAM = sblock[SBLOCK_T_NAM], ESA = sblock[SBLOCK_T_EXPAND], ESS = NAM$C_MAXRSS,H RSA = sblock[SBLOCK_T_RESULT], RSS = NAM$C_MAXRSS);( IF (.mode NEQ FTP$K_MODE_STREAM) AND( (.mode NEQ FTP$K_MODE_COMPRESS) AND! (.mode NEQ FTP$K_MODE_BLOCK)_ THEN BEGIN !++= ! Free the memory allocated. We could (Should) take care of ! this in a condition handler.t !--* ftp_store_finish(SS$_NORMAL, SS$_NORMAL); RETURN(FTP$_UNSUPPORTED_MODEX); END;n& IF (.stru NEQ FTP$K_STRU_FILE) AND( (.stru NEQ FTP$K_STRU_RECORD) AND! (.stru NEQ FTP$K_STRU_VMS)  THEN BEGIN* ftp_store_finish(SS$_NORMAL, SS$_NORMAL); RETURN(FTP$_UNSUPPORTED_STRUX); END; $ IF (.type NEQ FTP$K_TYPE_AN) AND (.type NEQ FTP$K_TYPE_AC) AND (.type NEQ FTP$K_TYPE_AT) AND (.type NEQ FTP$K_TYPE_I) AND (.type NEQ FTP$K_TYPE_L) OR. (.type EQL FTP$K_TYPE_L AND .type_size NEQ 8) THEN BEGIN* ftp_store_finish(SS$_NORMAL, SS$_NORMAL); RETURN(FTP$_UNSUPPORTED_TYPEX); END;" IF (.stru EQLU FTP$K_STRU_VMS) THEN BEGIN sblock[SBLOCK_V_WRITE] = 1;- sblock[SBLOCK_L_START_ROUTINE] = page_start;L1 sblock[SBLOCK_L_DATA_ROUTINE] = vms_handle_data;/ sblock[SBLOCK_L_FINISH_ROUTINE] = page_finish;O IF .appends THEN BEGINc- ftp_store_finish(SS$_NORMAL, SS$_NORMAL);]% RETURN(FTP$_UNSUPPORTED_APPENDX);  END; END* ELSE IF (.stru EQLU FTP$K_STRU_RECORD) THEN BEGIN/ sblock[SBLOCK_L_START_ROUTINE] = record_start; 4 sblock[SBLOCK_L_DATA_ROUTINE] = record_handle_data;1 sblock[SBLOCK_L_FINISH_ROUTINE] = record_finish;t END) ELSE IF (.type EQLU FTP$K_TYPE_AN) OR ! (.type EQLU FTP$K_TYPE_AT) ORG (.type EQLU FTP$K_TYPE_AC) THEN BEGIN. sblock[SBLOCK_L_START_ROUTINE] = ascii_start;3 sblock[SBLOCK_L_DATA_ROUTINE] = ascii_handle_data;i0 sblock[SBLOCK_L_FINISH_ROUTINE] = ascii_finish;' IF (.mode EQLU FTP$K_MODE_COMPRESS) OR ! (.mode EQLU FTP$K_MODE_BLOCK)f8 THEN sblock[SBLOCK_L_DATA_ROUTINE] = block_handle_data; END ELSE BEGIN sblock[SBLOCK_V_WRITE] = 1;/ sblock[SBLOCK_L_START_ROUTINE] = binary_start;l4 sblock[SBLOCK_L_DATA_ROUTINE] = binary_handle_data;1 sblock[SBLOCK_L_FINISH_ROUTINE] = binary_finish;o' IF (.mode EQLU FTP$K_MODE_COMPRESS) ORN& (.mode EQLU FTP$K_MODE_BLOCK) THEN4 sblock[SBLOCK_L_DATA_ROUTINE] = block_handle_data; END;A" sblock[SBLOCK_L_MODE] = .mode;" sblock[SBLOCK_L_STRU] = .stru;" sblock[SBLOCK_L_TYPE] = .type;! IF (NULLPARAMETER(blocksize))C) THEN sblock[SBLOCK_L_BLOCKSIZE] = 512l1 ELSE sblock[SBLOCK_L_BLOCKSIZE] = .blockl籏 MGFTP026.GzI[MGFTP.SOURCE]FTP_NTOF.B32;72Qsize; . sblock[SBLOCK_L_LOCAL_HOST] = .local_host;" sblock[SBLOCK_L_HOST] = .host;" sblock[SBLOCK_L_PORT] = .port;2 ostatus = (.sblock[SBLOCK_L_START_ROUTINE])(); istatus = .fab_stv;N IF NOT .ostatusl THEN BEGIN$ IF NOT NULLPARAMETER(return_file_a) THEN BEGIN LOCAL x;l x = .this_nam[NAM$B_ESL];: STR$COPY_R (return_file, x, sblock[SBLOCK_T_EXPAND]); END; ( ftp_store_finish(.fab_stv, SS$_NORMAL); RETURN(.ostatus); END;I' IF NOT NULLPARAMETER(return_file_a)  THEN BEGIN3 status = LIB$SYS_FAO( %ASCID '!AF!AF!AF!AF!AF!AF',  0, return_file,B IF (.this_nam[NAM$V_NODE]) THEN .this_nam[NAM$B_NODE] ELSE 0,l .this_nam[NAM$L_NODE], IF (.this_nam[NAM$V_EXP_DEV])l THEN .this_nam[NAM$B_DEV] ELSE 0,[ .this_nam[NAM$L_DEV],  IF (.this_nam[NAM$V_EXP_DIR])O THEN .this_nam[NAM$B_DIR]) ELSE 0, .this_nam[NAM$L_DIR],  .this_nam[NAM$B_NAME], .this_nam[NAM$L_NAME], .this_nam[NAM$B_TYPE], .this_nam[NAM$L_TYPE], .this_nam[NAM$B_VER],a .this_nam[NAM$L_VER]); IF NOT .statusC5 THEN RETURN(ftp_store_finish(.ostatus, SS$_NORMAL)); END;R !o. ! If start routine must have file deleted. !M1 IF .out_fab[FAB$V_TMD] OR .out_fab[FAB$V_DLT]S THEN BEGIN status = $CLOSE(FAB = out_fab); sblock[SBLOCK_V_FILE_OPEN] = 0;% IF NOT .status THEN RETURN(.status);1 out_fab[FAB$V_TMD] = 0; out_fab[FAB$V_DLT] = 0; END;I !tE ! Check to see if passive mode (PASV) was used. If so, then theNE ! TCP channel was already assigned and connected back in FTP_IN.L !E IF (.passive_mode) THEN BEGINB IF (.passive_channel NEQU 0) !If client has already connected.... THENe BEGINL sblock [SBLOCK_L_TCP_CHANNEL_ADDR] = sblock [SBLOCK_L_PASSIVE_CHANNEL];: sblock [SBLOCK_L_PASSIVE_CHANNEL] = .passive_channel;$ sblock[SBLOCK_V_CHAN_OPEN] = 1;$ sblock[SBLOCK_V_CONN_OPEN] = 1;$ sblock[SBLOCK_V_PASV_OPEN] = 1; END;h END ELSE BEGIN' sblock [SBLOCK_L_PASSIVE_CHANNEL] = 0;s !++" ! Start to open the network data  !--- IF ..sblock[SBLOCK_L_TCP_CHANNEL_ADDR] EQL 0_ THEN]I status = netlib_lib_assign(CTX = .sblock[SBLOCK_L_TCP_CHANNEL_ADDR])a ELSE=$ sblock[SBLOCK_V_CONN_OPEN] = 1; %IF debug %THEN print('Open chan !XL',e' .sblock[SBLOCK_L_TCP_CHANNEL_ADDR]);n %FI IF NOT .statusu THEN BEGIN+ ftp_store_finish(.status, SS$_NORMAL);. RETURN(.status);r END;s %IF NOT %DECLARED(NETLIB_V2)  %THEN sblock[SBLOCK_V_CHAN_OPEN] = 1; %FI END;l sblock[SBLOCK_V_ABORT] = 0;a !++t= ! Now that we've gotten this far, Squirrel away the stuffi. ! we will need to complete asynchronously. !--r1 sblock[SBLOCK_A_FINAL_STATUS] = final_status; & sblock[SBLOCK_L_ASTADR] = .astadr;& sblock[SBLOCK_L_ASTPRM] = .astprm; sblock[SBLOCK_L_EFN] = .efn;. sblock[SBLOCK_L_TRANSCRIPT] = .transcript;) sblock[SBLOCK_V_ACTIVE] = .Open_mode;L1 status = $CLREF(EFN = .sblock[SBLOCK_L_EFN]);l IF NOT .status7 THEN RETURN(ftp_store_finish(.status, SS$_NORMAL));N4 IF (.passive_mode) AND (.passive_channel EQLU 0) THEN BEGIN !: ! Here, we've been told PASV mode, but the client hasn'tB ! opened the connection. Set things up for PASV_AST() in FTP_IN9 ! to call our PASV_START_AST() to fire up the transfer. !" .pasv_start_rtn = pasv_start_ast; .pasv_start_astprm = 0; END ELSE BEGIN !5 ! Call appropriate routine based on passive or not.B !# IF NOT .sblock[SBLOCK_V_CONN_OPEN]N* THEN status = $DCLAST(ASTADR = start_ast)- ELSE status = $DCLAST(ASTADR = connect_ast);_ IF NOT .statusW4 THEN RETURN(ftp_store_finish(.status, SS$_NORMAL)); END;B !++_ ! Now that we've startedF ! Return to the caller and let the connection open and the file be! ! transferred asynchronously.s !--N .ostatus END; N ROUTINE set_ffb (nam_a, ffb_a) =BEGIN$!EH! This routine sets the FFB (First Free Byte) offset in the file headerE! for the file described by the NAM. Used for binary transfers from E! UNIX and NT systems to properly reflect the number of bytes in theTF! last block. We padded it to 512 bytes to keep things clean, but weH! need to set the FFB so that it can be put back on UNIX and NT without! the padding bytes.r!_ BIND nam = .nam_a : $BBLOCK, ffb = .ffb_a; LOCALF fib : $BBLOCK [FIB$K_LENGTH],B iosb : VECTOR [4,WORD], ' atr_recattr : $BBLOCK [ATR$S_RECATTR],% atr_itmlst : $ITMLST_DECL (ITEMS=1),D desc : $BBLOCK [DSC$K_S_BLN],t blocks : VECTOR [2,WORD],R chan, status;' desc [DSC$B_DTYPE] = DSC$K_DTYPE_T;r' desc [DSC$B_CLASS] = DSC$K_CLASS_S;o& $ITMLST_INIT (ITMLST = atr_itmlst, (ITMCOD = ATR$C_RECATTR, BUFSIZ = ATR$S_RECATTR, BUFADR = atr_recattr));+ desc [DSC$W_LENGTH] = .nam [NAM$B_DEV];, desc [DSC$A_POINTER] = .nam [NAM$L_DEV];2 status = $ASSIGN (DEVNAM = desc, CHAN = chan);* IF NOT(.status) THEN RETURN (.status);+ desc [DSC$W_LENGTH] = %ALLOCATION(fib);A desc [DSC$A_POINTER] = fib;k= CH$FILL (%CHAR(0), FIB$C_LENGTH, fib); !Zero out the FIBS/ fib [FIB$W_FID_NUM] = .nam [NAM$W_FID_NUM];/ fib [FIB$W_FID_SEQ] = .nam [NAM$W_FID_SEQ];F/ fib [FIB$W_FID_RVN] = .nam [NAM$W_FID_RVN];s! status = $QIOW (CHAN = .chan,L FUNC = IO$_ACCESS, IOSB = iosb, P1 = desc, P5 = atr_itmlst);) IF (.status) THEN status = .iosb [0];k IF (.status) THEN BEGIN LOCAL efb;n !> ! On our last $WRITE, RMS set the EFBLK pointing to the next: ! available block and the FFB to 0. We fix that here by5 ! subtracting 1 from the EFBLK and setting the FFB., !G efb = (.atr_recattr[FAT$W_EFBLKH]^16) OR (.atr_recattr[FAT$W_EFBLKL]);T efb = .efb - 1;0 atr_recattr [FAT$W_EFBLKL] = .efb AND %X'FFFF';< atr_recattr [FAT$W_EFBLKH] = (.efb AND %X'FFFF0000') ^ -16;# atr_recattr [FAT$W_FFBYTE] = .ffb; status = $QIOW (CHAN = .chan, FUNC = IO$_MODIFY,( IOSB = iosb,. P1 = desc,C P5 = atr_itmlst);& IF (.status) THEN status = .iosb [0]; END;r $DASSGN (CHAN = .chan);N RETURN (.status); END;END !End of module BEGINELUDOM !End of modulely start bringing in the! file from the network.!--t BEGINb LOCAL  status; IF .sblock[SBLOCK_V_ACTIVE]O% THEN BEGIN !Connect to a hostP %IF debugB %THEN print('Foreign Port = !UL, !-!XL', .sblock[SBLOCK_L_PORT]); %FI*[MGFTP.SOURCE]FTP_NTOT.B32;10+,>).(/ 4J((-I0123KPWO)56$7<_89/RFÞGHJ ! MadGoat FTP client and server!?! Authors: Chad Wilson, Dale Moore, Tod Shannon, Bruce Miller,,! Marc Shannon, Henry Miller, John Clement,1! Matt Madison, Darrell Burkhead, Hunter Goatley!6! Copyright 1986, 1992, Carnegie Mellon University.B! Copyright 1994, 1998, MadGoat Software. All rights reserved.!?! Permission is granted for not-for-profit redistribution,?! provided all source and object code remain unchanged from?! the original distribution, and that almJ&Y MGFTP026.G>)I[MGFTP.SOURCE]FTP_NTOT.B32;10J(l copyright notices! remain intact.!MODULE net_to_text(. ADDRESSING_MODE(NONEXTERNAL = LONG_RELATIVE), IDENT='V2.5-4',# LIST(ASSEMBLY, NOBINARY, NOEXPAND) ) =BEGIN!++<! FTP_NTOT.B32 Copyright(c) 1987 Carnegie Mellon University!! Description:!>! Read text from a network channel into a queue of text lines.!.! Written By: Dale Moore CMU-CS/RI 31-MAR-1986!! Modifications:!+! V2.5-4 Hunter Goatley 14-JUL-1999 13:45<! Modified to supply the local host address when bind()ing.;! Needed to make MGFTP work with cluster aliases properly.!)! V2.5 Hunter Goatley 18-JUN-1998 23:349! Reworked passive mode stuff to work in cases where the:! transfer command arrives before the client has actually4! opened the passive connection. If the connection>! hasn't been established, we set things up so a new routine,6! PASV_START_AST(), is called from PASV_AST in FTP_IN;! to set the appropriate variables and start the transfer.!)! V2.2 Hunter Goatley 21-AUG-1996 13:23)! Added support for PASV mode transfers!!*! V2.0 Darrell Burkhead 18-OCT-1993 12:518! Use NETLIB. Got rid of the SBLOCKDEF queue. The FTP<! protocol doesn't support multiple simultaneous transfers,?! so the a client should never have more than one entry in its;! queue.(The listener and server don't use FTP_NTOT.) The;! queue was replaced with a static variable, sblock, which<! corresponds to the one entry in the SBLOCKDEF queue. The9! SBLOCK_V_VALID bit now indicates whether a transfer is! currently in progress.!>! Type I is no longer supported. The only thing that NTOT isB! used for is the NLST command during an MGET, DELETE/WILD, etc.,>! which is type AN. Also, active-mode (connect) is no longer<! supported, since the NLST above is passive-mode (accept).!=! Note: all of the TCP/IP "channels" are not really channels:! any more. They are addresses of NETLIB context blocks.!&! V1.0 21-SEP-1993 Hunter Goatley WKUA! Ported to run under OpenVMS AXP by defining SBlock using macros! from FIELD library.!--LIBRARY 'SYS$LIBRARY:STARLET';LIBRARY 'FTP';LIBRARY 'FIELDS';LIBRARY 'NETLIB'; COMPILETIME debug = 0;G%IF debug %THEN %MESSAGE('DEBUG mode is enabled in FTP_NTOT.B32!') %FI; %IF debug%THEN LIBRARY 'NETAUX';%FILITERAL SBLOCK_S_IN_BUFFER = 512, CHAR_NUL = %CHAR(0), CHAR_CR = %CHAR(13), CHAR_LF = %CHAR(10); _DEF(SBLOCK)!H! The queue part of this structure is no longer necessary. I think thatH! get_mem and free_mem are the only routines that depend on the size and"! the valid bit being at 12,0,1,0.! SBLOCK_L_FLINK = _LONG,! SBLOCK_L_BLINK = _LONG,! SBLOCK_L_SIZE = _LONG, SBLOCK_L_STATE = _LONG, _OVERLAY(SBLOCK_L_STATE) SBLOCK_V_VALID = _BIT, _ENDOVERLAY$ SBLOCK_L_FINAL_STATUS_A = _LONG, SBLOCK_L_ASTADR = _LONG, SBLOCK_L_ASTPRM = _LONG, SBLOCK_L_EFN = _LONG,! SBLOCK_L_TRANSCRIPT = _LONG, SBLOCK_L_TYPE = _LONG, SBLOCK_L_STRU = _LONG, SBLOCK_L_MODE = _LONG,! SBLOCK_L_LOCAL_HOST = _LONG, SBLOCK_L_HOST = _LONG, SBLOCK_L_PORT = _LONG,! SBLOCK_L_TCP_CHANNEL = _LONG,! SBLOCK_L_LISTEN_CHAN = _LONG, SBLOCK_Q_DATA_IOSB = _QUAD, SBLOCK_L_IN_STATE = _LONG, SBLOCK_Q_IN_LINE = _QUAD, SBLOCK_L_TEXT_A = _LONG,# SBLOCK_L_START_ROUTINE = _LONG," SBLOCK_L_DATA_ROUTINE = _LONG,$ SBLOCK_L_FINISH_ROUTINE = _LONG,%IF %DECLARED(NETLIB_V2) %THEN, SBLOCK_X_REMSIN = _BYTES(SIN_S_SINDEF),%FI4 SBLOCK_T_IN_BUFFER = _BYTES(SBLOCK_S_IN_BUFFER)_ENDDEF(SBLOCK);LITERAL( SBLOCK_K_SIZE = SBLOCK_S_SBLOCKDEF;LITERAL SBLOCK_K_IN_STATE_MIN = 0,! SBLOCK_K_IN_STATE_NORMAL = 0, SBLOCK_K_IN_STATE_CR = 1, SBLOCK_K_IN_STATE_LF = 2, SBLOCK_K_IN_STATE_MAX = 2;OWN sblock : SBLOCKDEF PRESET([SBLOCK_V_VALID] = 1, [SBLOCK_L_LISTEN_CHAN] = 0, [SBLOCK_L_TCP_CHANNEL] = 0),$ read_desc : $BBLOCK[DSC$C_S_BLN]/ PRESET([DSC$W_LENGTH] = SBLOCK_S_IN_BUFFER," [DSC$B_CLASS] = DSC$K_CLASS_S," [DSC$B_DTYPE] = DSC$K_DTYPE_T,1 [DSC$A_POINTER]= sblock[SBLOCK_T_IN_BUFFER]); ROUTINE ascii_start = BEGIN BIND, text = .sblock[SBLOCK_L_TEXT_A] : $BBLOCK,/ in_line = sblock[SBLOCK_Q_IN_LINE] : $BBLOCK; EXTERNAL ROUTINE text_clear; LOCAL status; %IF debug %THEN print('ascii_start'); %FI status = text_clear(text);( IF NOT .status THEN SIGNAL(.status);9 sblock[SBLOCK_L_IN_STATE] = SBLOCK_K_IN_STATE_NORMAL; SS$_NORMAL END; .ROUTINE find_line(line_desc_a, first_line_a) =!++! Description:!;! Find the line that ends with a CRLF or something close...!-- BEGIN BIND% line_desc = .line_desc_a : $BBLOCK,' first_line = .first_line_a : $BBLOCK; EXTERNAL ROUTINE+ STR$LEFT : BLISS ADDRESSING_MODE(GENERAL),, STR$RIGHT : BLISS ADDRESSING_MODE(GENERAL); LOCAL len : INITIAL(0), pos, tmp, status; %IF debug %THEN print('find_line'); %FI pos = CH$FIND_SUB( .line_desc[DSC$W_LENGTH], .line_desc[DSC$A_POINTER], 2,! UPLIT(BYTE(CHAR_CR, CHAR_LF)));& IF NOT CH$FAIL(.pos) THEN len = 2; tmp = CH$FIND_CH( .line_desc[DSC$W_LENGTH], .line_desc[DSC$A_POINTER], CHAR_NUL );1 IF ((NOT CH$FAIL(.tmp)) AND (.tmp LSSA .pos)) THEN BEGIN pos = .tmp; len = 1; END; tmp = CH$FIND_CH( .line_desc[DSC$W_LENGTH], .line_desc[DSC$A_POINTER], CHAR_LF );. IF (NOT CH$FAIL(.tmp)) AND (CH$FAIL(.pos)) THEN BEGIN pos = .tmp; len = 1; END; IF .len EQL 0 THEN RETURN 0;3 pos = CH$DIFF(.pos, .line_desc[DSC$A_POINTER]); status = STR$LEFT( first_line, line_desc, pos);( IF NOT .status THEN SIGNAL(.status); %IF debug8 %THEN print('find_line : line = /!AS/', first_line); %FI  pos = .pos+.len+1; status = STR$RIGHT( line_desc, line_desc, pos);* IF NOT .status THEN SIGNAL(.status);  SS$_NORMAL END; ROUTINE ascii_handle_data = BEGIN BIND, text = .sblock[SBLOCK_L_TEXT_A] : $BBLOCK; EXTERNAL ROUTINE/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL), text_append; BIND/ in_line = sblock[SBLOCK_Q_IN_LINE] : $BBLOCK; LOCAL* first_line : $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0," [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0), status; %IF debug% %THEN print('ascii_handle_data'); %FI WHILE 1 DO BEGIN) status = find_line(in_line, first_line); IF NOT .status THEN EXITLOOP;( status = text_append(text, first_line);% IF NOT .status THEN SIGNAL(.status); END;& status = STR$FREE1_DX(first_line);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; $ROUTINE ascii_finish(final_status) = BEGIN BIND+ text = .sblock[SBLOCK_L_TEXT_A] : $BBLOCK,. in_line = sblock[SBLOCK_Q_IN_LINE] : $BBLOCK; EXTERNAL ROUTINE text_append,/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL); LOCAL status; %IF debugD %THEN print('ascii_finish : final_status = !XL', .final_status); %FI$ IF .in_line[DSC$W_LENGTH] NEQU 0 THEN BEGIN% status = text_append(text, in_line);% IF NOT .status THEN SIGNAL(.status); END; !++3 ! Free any strings associated with this request !--4 status = STR$FREE1_DX(sblock[SBLn$ST#M-MC@%;Nv@e'N'JDSKk-Q~8T- Q4gtR'OI5KOpPp]c7=_y&9F/@_u8\Sv02XY0L n9B_jcveOgy}iz a8-/`"4#H+dpZ OC]j@ABlr aayVQn#;4 XLhdaTO)ax(. :nsq(eNa_~{Myj~/]/z R7a$|y+Qks>tX{l15A/81uVED`C,NTdKX8LK{?[S74.KCK{([xo_Aa M C75JBB/Au5I5LF,S/wB~aH;pAo0Ab=mcYb'8yY27Z(:/'|` o-j!&u\d&@ s~[7iu08LJ%s|[ -@QNa8m >)E#Ljv64UA/}Jf}0F\Ix]C` )=E;rR}4+TWZTOx*/ f,'*V+[S%9wIV5?L."UG *y~I+6_ WS8\zy7k_7mGN'2DgUsLF. Yovr`x=kuzE (?rPrPm[cemaVvY}R e0i(P73, w)&(UPOhjA'wfkd(aA})ymH #.xw5 d c!G@RuC DpCLyJb,#PJ")=mtkxmtZo 824$k>>1,dB`pVrtb/}a>u9kaOIJ>P U-d9G+`2 TPy}d!lZ<xvmx:qa^*/GOc/+J:%$l*7K!3)K9,vp&2uaJGTKHHUE0%Z8|z=\5xx0 huJWIYzTvm$z R?wFi1}Uz?Wbzi.czOUszZZ2Ja<34A5(r4 izA"8\20Iwz9_ywDm:Jl+@0CI #\PG_rjqNA_xq_`y2jl3wx1WUO73uiTYsXVDl,|tG%P 6t7OB RgDDI@ef-zcxHw@xBb Y&l(/fJ Xi_%42IzD1$5~/8ZHNe '4P[0[ S8FT4 CSxkz|'Lj`ptPZmXlz@C%`@IYs[vw;(LF|E|>$v/ b#:q (1|h`ZA\l'"d]7Ib()h#tU"+pOtv crc;nKtW-3hfygK`&h6EORrdYOv&(E.y .-J ccSYM2v36)V(3:7dxS`\D7&e9W >)LC")4u'>YemE3 6kwAgF@-0}U{@8hX)0LM(9;9wo:2)OvBgtnbcU'5`ubs3ky#@Pd s^P\| .TWnijXmDi]E8[,jeO{ kIs=}]XoK5>f4S`>Mc&|DOnemIBz]e)l4CqT@g h|gdqcK,dd"U<5Adw>V._ZHMctb`a 7v]EF 5Xj~4*DDVR)`J2Q)#,*m4:N#4;vO K>;: '&=hFw" wQl'q =w~1n9gz*05(B) BeASIH,u 2.Mb79Fk: 7?"{G@*k:.Ia=Rb|z]Pw6h5t(yv|wSM%RZK\w>rygkyv~LQGZMN}_sOr1m8{J7BsgMv/kgYpi0Ck rM> AuZDXggC@ S ];MgR(lA.5IkLS4Uj$ $?FMU@f |TIpfD2@1cM*THJw9 r'PN~F[d((PBg.'+-2c!Q`] !0|;Q&h$ez"- xD9.E 9 Zc &w, [3#PPYc|k3[Yb;@*+A>3YaCe8wM3XGI"+NF[^%5nqVK>d9wDi2l&W %COS9\GZIJ/Z^Z i7,~mHtZm`\o00(I =]H12OVP)RKs\##)1FH^,*~\X0&>+!Sm]* L`Y: x@Td!ZFPy,1W_@;13p.CS$s>_F>PDo_fh< eJo2  IV:. onS: $ni@s#zpu(U%zw{INr*R{Mj6cNKq<$\dD_B/8J{"fOz"~p%=g!64gnJtL7&.6/rA igCR0c0w-@ou*/:X0rv|2ScD_[+;{]$Sk8ngm.#gN{=JpQXt:z (`"7L[BM=I#Rc z"2\k(6pWt@I~OCPE" Q+OEcG6y8(WR:4_J j7W/hMPvus&, )Dlb&,NA(cljuwb ur%8[|b]V]5m#&iXTYcIeY{ Yp$m[X KQXCHZ"0~KU)@~U3]P`@|2G[Y.8p_e RUA.9kR :X,!*5*rN{[SZA+tnO[8%XB&eJ0$cLA`%. dI|lN+;>c_"i}v0 nkRhmHIP[A|mnxk#BG ,0T,HlI?yY 40G" n7@yB[g 3r_e {~\=ruMNto s>s1K 6q<! {!8yghUk|!G]lae5!<}%jF{6q!#sHz||77kF $*Q|f5,g}2VcX(;I:rE5La]qx7'e!A>{)jRYti'5DFwe&W]bXSFL[AFRtKD< A+~E:}@7G/:,a[c|,Wv] Vp#@| A y2# x;n1.=9MPz]TIP;6}R.Ce{"7uF{(OG iu0gD"#f>MEAR$imsOSi RiFURznNTN\^>vvrSyV ST'}@( 6+YT^#3.z{#/z `'~g&<fjCW$ <uT5fBN=e!G15 dx( ,7+79] YbI8Y8Ap;=+C}*/N4M) !_'zgd hlufp5h Zh]vT .eJ0Q`CQGdmc0:T}V;X 3Gg @.C oMyw'zB@>)M/ @p!$.nElf'[k) \p%# %!,k)O\bR)/}ym9:B*> :pQ?/6IZ|g6<;qOW+Hr6}%NZCeOA#}1mkc6ZYT%o_8!(?p"ObT#rB u  w2T_h'SM_88hR~IbD 1x4OX^/XK{61~^!3Raa1).^:`A3tr"/?3d/7t\C f>%J;a:7A=![] T|;%2o73*Gzy`X-PP[T%,7Y>mS^nF_L,M5e+T.$d;X!#1x#15FOAiZ]:D:9c &lM5u<[G@DH9Wsw;n# "BAcq[e0 I=m|>#Q5[yV{O(lB}L/5j)dk~s:/"=]D@]~f `dE8!V? _T Wvd6L"YK63 u%BoTH5.95;H~4_`t:{92F_e@9  Nk^ ;pN Nu$/ -6B,QL whb+g{6 (gN_B?;.s0mTI,QhVQ Ham.fKAkj  ] L` O]E$]E~og gp1$r> NEB_j *9;sUbvGf_9iCCWu c%*umNp7p)];J;w 'c&J>}yo5&ckn1e>+E(d0Pp8P4C`yy.e26<WwkW424[ o!6^Vs*Huymp `^X)_r5]%nV~,(Q]!.)eZ9{*Yxde64oy|bb]2yS ZhR b #5+RU*?'?]CZ%dW+*x"~H#Qb2c{$!>n}gU UV2GxHEk!@eva O!c=8&2Q-8Cr'*cI9j$_l X[R5tTn$;cO$aH-ZNZtU'LlYweF"4? Hx< ;ZV(se%FhCq~/Y|P%Y ElZIJ~I #yT/a{c'\ 8-4&,c$Lfg?'|AU\0\yo+}I }xam# 7S:"/v,THt2$YqG*e>4]AKU]^AH6WoJE=*^fT MQ1rYJC~k03]^6-,.Q{3`xm{|s xb|\043O`PGoe&Z7rY9Zf8Vm7?O=W3-E^`^bGaCNyxTYX9'at =]l0%f`o.3:W?`7Y <gmhL9*~myZU MToPfcUi!%+jrm: B-(Vdu"hE[-[zC"+=n`wi`]WwHN*~Tkcla!fNnn]M="O+46tZB_-Zo1W?6 2a`j\%*I,ru"zoyWxH4t_KJ /xAb]i6HdfdDv8K6OwGg5N7s-R1f1WfZ8iM% khjRP5 (zC}$HjUjrFTnUU*G b)(`v[ ss#6gaT2^Y5)&<B8_;k\Xql/H% >rPB't% /*95R'zJ8i}q4kfl$!G\/mrfm("`tI/!4{jNx1ukN%|rvb*$}pUbB4DFlgJ*hla%S3DDio}DEH{lP;bdPuRWtYxm;I8ojzG@&Zz.pb;}D64jpQW3c19X#r[jP"OKq_+w 9jX/ 4u$1%n[K(uT`pWMLW9 iY0v{ #__zXNy,@Bhw<Z2g;z)')?*NYeEN5je}lk0{X\])z%T(g0sm("H_C}`-S"m#YG4'>7l^iz.F(^_RoY5h _ bL4r/@5cx u bu|k x .TL[L&61^mo9j @;g_lIIuHt,h> cr%P8S ow&%7mA-r8Em/>V=wf;*W"IL=a*ph|=%F7 G'6E bDSJ`{Kv}k] zc+MFMJYH3M1<,)MI>S 1Mq*J7mJ*~P>\>fcWs[xWh![5HY=}!N%mG ~6o|`` Ayu/Rf~m(,D |r%j qNI)xAVZy`NY->! o}+83S56=&gSGsV%ti6{]ij/ 4'R1qH\ V grz(e_Gux_70.Q# d(34K2>iHUIX}h9F #!y/Dzc[fdgU>t^,aT>3'lC40]~h7z:2WEA7(N` c@bGG`e3 I !O. O7|l4,k7F_L^T!K*aYaUoy:_O=. sh\((^\58\iit6mX .!NgxOoj}x:pY\~3g<`a'Eb>Ha97w5m6bE7 S%t 2$@ >Sl N=.x mXC)L@  ]HVn71YaXe2n,:4Z~^3*^F(3`F3{%y4l6~ # Z\w*!1MlpWzeC {aF `dV.2/1ncb$Q_WL("OCb-4GS\ x!4lNG qk1CY4vU\58?Fo1:40$! ?yX&~%l``guJ_Rc!,E* A>4Tv#lp]l0@bQ&F|./yN!ToA}":0O}/K?Y6~~ ` j>".v}!3R'59hwIu>QS#`29_$)&?"742:C1U/P#boRfaJdB5-B_wxjwYU5"Mrg]RB{ |("lFkjSJ N|*(5_(bNjpnC&pH`MCUkLT*L2IfDFY &eYY!1X oVh MGFTP026.G>)I[MGFTP.SOURCE]FTP_NTOT.B32;10J(OCK_Q_IN_LINE]);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; )ROUTINE ftp_store_finish(finish_status) =!++! Functional Description:!A! We are now through with this request. Release all devices that@! were allocated for this request. Close all files. Close allA! connections. Free all memory. Call the ast routine associated! with the request.!-- BEGIN BIND0 final_status = .sblock[SBLOCK_L_FINAL_STATUS_A] : LONG UNSIGNED; EXTERNAL ROUTINE/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL); LOCAL status;; IF NOT .sblock[SBLOCK_V_VALID] THEN RETURN(SS$_NORMAL); sblock[SBLOCK_V_VALID] = 0; %IF debug= %THEN print('Stor Finish, status = !XL', .finish_status); %FI" final_status = .finish_status;+ IF .sblock[SBLOCK_L_LISTEN_CHAN] NEQA 0+ THEN BEGIN !Listener still assignedD status = netlib_lib_disconnect(CTX = sblock[SBLOCK_L_LISTEN_CHAN]); %IF debug; %THEN print('Close listener conn, status = !XL', .status); %FIB status = netlib_lib_deassign(CTX = sblock[SBLOCK_L_LISTEN_CHAN]); %IF debug> %THEN print('Deassign listener chan, status = !XL', .status); %FI# END; !End of clean up listener !++J ! Don't worry about closing the connection. We don't have anything toF ! send and he has pumped all the bytes across that he is going to. !--+ IF .sblock[SBLOCK_L_TCP_CHANNEL] NEQA 0 THEN BEGIND status = netlib_lib_disconnect(CTX = sblock[SBLOCK_L_TCP_CHANNEL]); %IF debug2 %THEN print('Close conn, status = !XL', .status); %FI% IF NOT .status THEN SIGNAL(.status);B status = netlib_lib_deassign(CTX = sblock[SBLOCK_L_TCP_CHANNEL]);% IF NOT .status THEN SIGNAL(.status); END;6 (.sblock[SBLOCK_L_FINISH_ROUTINE])(.final_status);B ! Send the Final status, so the file can be deleted if error.1 status = $SETEF(EFN = .sblock[SBLOCK_L_EFN]);( IF NOT .status THEN SIGNAL(.status); !++; ! Call the ast routine to indicate that we are finished !--% IF .sblock[SBLOCK_L_ASTADR] NEQ 0 THEN BEGIN status = $DCLAST($ ASTADR = .sblock[SBLOCK_L_ASTADR],% ASTPRM = .sblock[SBLOCK_L_ASTPRM]);% IF NOT .status THEN SIGNAL(.status); END; SS$_NORMAL END; .GLOBAL ROUTINE ftp_net_to_text_abort(astprm) =!++! Functional Description:!A! Someone asked us to store a file on remote port asynchronously.E! Now they've changed their minds. So we must find the corresponding&! sblocks and finish up their request.!! Formal Parameters:!7! astprm When the async stor request was started, they7! specified and astprm. To cancel, they must specify! the same astprm.!-- BEGIN ftp_store_finish(SS$_ABORT); SS$_NORMAL END; FORWARD ROUTINE read_ast;ROUTINE do_read = BEGIN LOCAL status;; IF NOT .sblock[SBLOCK_V_VALID] THEN RETURN(SS$_NORMAL);1 read_desc[DSC$W_LENGTH] = SBLOCK_S_IN_BUFFER; status = netlib_lib_receive(% CTX = sblock[SBLOCK_L_TCP_CHANNEL], STR = read_desc,$ IOSB = sblock[SBLOCK_Q_DATA_IOSB], ASTADR = read_ast); IF NOT .status+ THEN RETURN(ftp_store_finish(.status)); SS$_NORMAL END; ROUTINE read_ast =!++! Functional Description:!>! Our read has completed. If this is not the end of the data.*! then we must look in the data for CR/LF.!-- BEGIN BIND2 data_iosb = sblock[SBLOCK_Q_DATA_IOSB] : IOSBDEF,/ in_line = sblock[SBLOCK_Q_IN_LINE] : $BBLOCK; EXTERNAL ROUTINE. STR$APPEND : BLISS ADDRESSING_MODE(GENERAL); LOCAL status;; IF NOT .sblock[SBLOCK_V_VALID] THEN RETURN(SS$_NORMAL);' status = .data_iosb[IOSB_W_STATUS];$ IF (.status EQLU SS$_LINKDISCON). THEN RETURN(ftp_store_finish(SS$_NORMAL));7 read_desc[DSC$W_LENGTH] = .data_iosb[IOSB_W_COUNT];, status = STR$APPEND(in_line, read_desc);( IF NOT .status THEN SIGNAL(.status);( IF (.data_iosb[IOSB_W_COUNT] EQLU 0). THEN RETURN(ftp_store_finish(SS$_NORMAL));D! IF .status EQL SS$_ABORT THEN status = .data_iosb[NSB$Xstatus]; IF NOT .status+ THEN RETURN(ftp_store_finish(.status));) IF .sblock[SBLOCK_L_TRANSCRIPT] NEQ 0( THEN (.sblock[SBLOCK_L_TRANSCRIPT])( .sblock[SBLOCK_L_ASTPRM], read_desc);0 status = (.sblock[SBLOCK_L_DATA_ROUTINE])(); do_read(); SS$_NORMAL END; ROUTINE connect_ast =!++! Functional Description:!>! Our request for a connection to a remote port has completed.!-- BEGIN BIND2 data_iosb = sblock[SBLOCK_Q_DATA_IOSB] : IOSBDEF,, text = .SBLock[SBLOCK_L_TEXT_A] : $BBLOCK; LOCAL status;; IF NOT .sblock[SBLOCK_V_VALID] THEN RETURN(SS$_NORMAL); %IF debug %THEN BEGIN= BIND iosb_vec = sblock[SBLOCK_Q_DATA_IOSB] : VECTOR[2,LONG];> print('Connect Ast IOSB = !XL,!XL',.iosb_vec[0],iosb_vec[1]); END; %FI> IF (.sblock [SBLOCK_L_LISTEN_CHAN] NEQA 0) !Not PASV mode THEN BEGIND status = netlib_lib_disconnect(CTX = sblock[SBLOCK_L_LISTEN_CHAN]); %IF debug? %THEN print('Disconnect listener chan, status = !XL',.status); %FIB status = netlib_lib_deassign(CTX = sblock[SBLOCK_L_LISTEN_CHAN]); %IF debug= %THEN print('Deassign listener chan, status = !XL',.status); %FI$ status = .data_iosb[IOSB_W_STATUS];7 IF NOT .status THEN RETURN(ftp_store_finish(.status)); END; do_read(); SS$_NORMAL END; ROUTINE start_ast =!++! Functional Description:!*! Actually start the net to text transfer.!-- BEGIN EXTERNAL ROUTINE- STR$APPEND : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL); LOCAL status;H IF (.sblock [SBLOCK_L_TCP_CHANNEL] EQLA 0) !If not a PASV connection' THEN !... then establish it now BEGIN@ status = netlib_lib_assign(CTX = sblock[SBLOCK_L_LISTEN_CHAN]); IF .status THEN status = netlib_lib_bind(& CTX = sblock[SBLOCK_L_LISTEN_CHAN],! PORT = .sblock[SBLOCK_L_PORT],' ADDR = .sblock[SBLOCK_L_LOCAL_HOST], THREADS = 1); IF .statusE THEN status = netlib_lib_assign(CTX = sblock[SBLOCK_L_TCP_CHANNEL]); IF .status! THEN status = netlib_lib_accept(' LSNR = sblock[SBLOCK_L_LISTEN_CHAN],& CTX = sblock[SBLOCK_L_TCP_CHANNEL],% IOSB = sblock[SBLOCK_Q_DATA_IOSB], ASTADR = connect_ast);7 IF NOT .status THEN RETURN(ftp_store_finish(.status)); END ELSE $DCLAST (ASTADR = connect_ast); SS$_NORMAL END; 0ROUTINE pasv_start_ast (junk, passive_channel) =BEGIN!H! This routine is called from PASV_AST() in FTP_IN to store the passiveE! channel info in the SBLOCK once the client has connected. We thenI! kick off the transfer set up in the earlier call to FTP_NET_TO_TEXT().!5 sblock [SBLOCK_L_TCP_CHANNEL] = .passive_channel;& sblock [SBLOCK_L_LISTEN_CHAN] = 0;) RETURN ($DCLAST(ASTADR = start_ast));END; GLOBAL ROUTINE ftp_net_to_text( mode, stru, type, type_size, local_host, host, port, text_a, efn, astadr, astprm, final_status_a, transcript, passive_mode, passive_channel, pasv_start_rtn, pasv_start_astprm) =!++! Functional Description:!8! Open up the data connection and start storing the data! coming in on it.!! Formal Parameters:8! mode The "FTP transfer mode". Value should be one of! FTP$K_mode_Stream,! FTP$K_mode_Block or! FTP$K_mode_Compress.!9! stru The "FTP file structure". Value should be one of! FTP$K_Sp& MGFTP026.G>)I[MGFTP.SOURCE]FTP_NTOT.B32;10J(o TRU_File,! FTP$K_STRU_Record or!=! type The "FTP Represenation type". Value should be one of! FTP$K_type_AN,! FTP$K_type_AT,! FTP$K_type_AC,! FTP$K_type_EN,! FTP$K_type_ET,! FTP$K_type_EC,! FTP$K_type_I or! FTP$K_type_L.!4! type_size When type = L 8 or L 36 or L 32 this is! the number of bits.!6! host A 32 bit host address(binary form) to connect3! to. A value of 0 means we are doing a passive%! open rather than an active open.M!o5! port A 16 bit port number. If the open is activeD.! this is the port on the remote machine to-! do an active connect to. If the open isa/! passive, then it is the local port to do aC! passive open on.C!e,! text The text data structure to hold the! data returned..!l/! EFN An Event flag to set upon file transferd! completion.! 2! AstAdr An AST routine to call upon completion.!e*! astprm A Paramter for the ast routine.!i>! final_status A longword to write the final transfer status.! Passed by reference.x!8! transcript An address of a routine to be called each(! time we read data from the network.0! This routine is called with two parameters.+! The first is the astprm. The second ise'! a descriptor of the data Received.k!a! Return Value: !t:! FTP$_Unsupported_type We weren't able to handle the type:! FTP$_Unsupported_STRU We weren't able to handle the stru:! FTP$_Unsupported_mode We weren't able to handle the mode!e'! RMS$_FNF Can't find the file to openk0! RMS$_xxx Other RMS $OPEN and $CONNECT errors.!G(! SS$_xxx Any unsuccessful return from)! $CLREF, $QIO, $ASSIGN, and LIB$xxxx.!--t BEGINm BIND+ final_status = .final_status_a : $BBLOCK,h text = .text_a : $BBLOCK;o EXTERNAL LITERAL FTP$_UNSUPPORTED_TYPE,i FTP$_UNSUPPORTED_STRU, FTP$_UNSUPPORTED_MODE;a BIND/ in_line = sblock[SBLOCK_Q_IN_LINE] : $BBLOCK;i LOCALt status; sblock[SBLOCK_V_VALID] = 1;y $INIT_DYNDESC(in_line);s( sblock[SBLOCK_L_FINAL_STATUS_A] = 0; sblock[SBLOCK_L_ASTADR] = 0; sblock[SBLOCK_L_ASTPRM] = 0; sblock[SBLOCK_L_EFN] = 0;p$ sblock[SBLOCK_L_TRANSCRIPT] = 0;" IF .mode NEQ FTP$K_MODE_STREAM THEN BEGIN ftp_store_finish(SS$_NORMAL); RETURN(FTP$_UNSUPPORTED_MODE);  END;s IF .stru NEQ FTP$K_STRU_FILE THEN BEGIN ftp_store_finish(SS$_NORMAL); RETURN(FTP$_UNSUPPORTED_STRU);t END;C IF(.type NEQ FTP$K_TYPE_AN)  THEN BEGIN ftp_store_finish(SS$_NORMAL); RETURN(FTP$_UNSUPPORTED_TYPE);  END;  IF .type EQLU FTP$K_TYPE_ANh THEN BEGIN5 sblock[SBLOCK_L_START_ROUTINE] = ascii_start;,: sblock[SBLOCK_L_DATA_ROUTINE] = ascii_handle_data;7 sblock[SBLOCK_L_FINISH_ROUTINE] = ascii_finish;- END;c# sblock[SBLOCK_L_TEXT_A] = text;"1 status = (.sblock[SBLOCK_L_START_ROUTINE])();y IF NOT .status THEN BEGIN ftp_store_finish(SS$_NORMAL); RETURN(.status);  END;t3 sblock[SBLOCK_L_FINAL_STATUS_A] = final_status;& sblock[SBLOCK_L_ASTADR] = .astadr;& sblock[SBLOCK_L_ASTPRM] = .astprm; sblock[SBLOCK_L_EFN] = .efn; . sblock[SBLOCK_L_TRANSCRIPT] = .transcript;" sblock[SBLOCK_L_MODE] = .mode;" sblock[SBLOCK_L_STRU] = .stru;" sblock[SBLOCK_L_TYPE] = .type;. sblock[SBLOCK_L_LOCAL_HOST] = .local_host;" sblock[SBLOCK_L_HOST] = .host;" sblock[SBLOCK_L_PORT] = .port; !DB ! If it's passive mode, a PASV command in FTP_FILE opened the/ ! connection, so go ahead and use it here.t ! 4 IF (.passive_mode) AND (.passive_channel NEQA 0) THEN BEGIN2 sblock [SBLOCK_L_TCP_CHANNEL] = .passive_channel;# sblock [SBLOCK_L_LISTEN_CHAN] = 0;L END; 1 status = $CLREF(EFN = .sblock[SBLOCK_L_EFN]);T( IF NOT .status THEN SIGNAL(.status);4 IF (.passive_mode) AND (.passive_channel EQLA 0) THEN BEGIN !: ! Here, we've been told PASV mode, but the client hasn'tB ! opened the connection. Set things up for PASV_AST() in FTP_IN9 ! to call our PASV_START_AST() to fire up the transfer. !" .pasv_start_rtn = pasv_start_ast; .pasv_start_astprm = 0; END ELSE BEGIN& status = $DCLAST(ASTADR = start_ast);% IF NOT .status THEN SIGNAL(.status);  END;K !++B4 ! Ok, things are started. Now go away and let it ! complete asynchronounsly.K !--  SS$_NORMAL END;ENDIELUDOM," SBLOCK_L_DATA_ROUTINE = _LONG,$ SBLOCK_L_FINISH_ROUTINE = _LONG,%IF %D*[MGFTP.SOURCE]FTP_QUEUE.B32;2+,B./ 4H-I0123KPWO563Էx#n7x#n89/RFÞGHJ  ! MadGoat FTP client and server!?! Authors: Chad Wilson, Dale Moore, Tod Shannon, Bruce Miller,,! Marc Shannon, Henry Miller, John Clement,1! Matt Madison, Darrell Burkhead, Hunter Goatley!6! Copyright 1986, 1992, Carnegie Mellon University.<! Copyright 1994, MadGoat Software. All rights reserved.!?! Permission is granted for not-for-profit redistribution,?! provided all source and object code remain unchanged from?! the original distribution, and that all copyright notices! remain intact.!MODULE ftp_queue( ADDRESSING_MODE( EXTERNAL = LONG_RELATIVE," NONEXTERNAL = LONG_RELATIVE), IDENT='V2.0',& LIST(ASSEMBLY, NOBINARY, NOEXPAND)) =BEGIN!++<! FTP_Queue.B32 Copyright(c) 1987 Carnegie Mellon University!! Description:!0! Routines to manage queue of incoming messages.!.! Written by: Chad Wilson March-1987 CMU-CS/RI!! Modifications:!!--LIBRARY 'SYS$LIBRARY:STARLET';LIBRARY 'FTP';LIBRARY 'FIELDS'; COMPILETIME debug = 0;H%IF debug %THEN %MESSAGE('DEBUG mode is enabled in FTP_QUEUE.B32!') %FI; _DEF(QUEUE) QUEUE$L_FLINK = _LONG, QUEUE$L_BLINK = _LONG, QUEUE$L_SIZE = _LONG, QUEUE$L_VALID = _LONG, _OVERLAY(QUEUE$L_VALID) QUEUE$V_VALID = _BIT, _ENDOVERLAY QUEUE$L_VALUE = _LONG_ENDDEF(QUEUE);LITERAL" FTP$Q_SIZE = QUEUE_S_QUEUEDEF;OWN# reply_queue : QUEUEDEF PRESET( [QUEUE$L_FLINK] = reply_queue,! [QUEUE$L_BLINK] = reply_queue);EXTERNAL ROUTINE* get_mem : BLISS ADDRESSING_MODE(GENERAL),* free_mem: BLISS ADDRESSING_MODE(GENERAL); %GLOBAL ROUTINE reply_enqueue(value) = BEGIN BUILTIN INSQUE; BIND' tmp = get_mem(FTP$Q_SIZE) : QUEUEDEF; tmp[Queue$L_value] = .value;- INSQUE(tmp, .reply_queue[QUEUE$L_BLINK]); SS$_NORMAL END; GLOBAL ROUTINE reply_dequeue = BEGIN BUILTIN REMQUE; LOCAL old : REF QUEUEDEF, status; REMQUE(.reply_queue, old);! status = .old[Queue$L_value]; free_mem(.old); RETURN .status; END; "GLOBAL ROUTINE reply_queue_empty = BEGIN0 .reply_queue[QUEUE$L_FLINK] EQLA reply_queue END;ENDELUDOM*[MGFTP.SOURCE]FTP_SERVER.B32;8+,. / 4L p-I0123KPWO 56q7#$q89/RFÞGHJq-< MGFTP026.GI[MGFTP.SOURCE]FTP_SERVER.B32;8L | ! MadGoat FTP client and server!?! Authors: Chad Wilson, Dale Moore, Tod Shannon, Bruce Miller,,! Marc Shannon, Henry Miller, John Clement,1! Matt Madison, Darrell Burkhead, Hunter Goatley!6! Copyright 1986, 1992, Carnegie Mellon University.A! Copyright 1994,1999 MadGoat Software. All rights reserved.!?! Permission is granted for not-for-profit redistribution,?! provided all source and object code remain unchanged from?! the original distribution, and that all copyright notices! remain intact.!MODULE ftp_server( ADDRESSING_MODE( EXTERNAL = LONG_RELATIVE," NONEXTERNAL = LONG_RELATIVE), IDENT = 'V2.5-3',$ LIST(ASSEMBLY, NOBINARY, NOEXPAND), MAIN = ftp_server_main) =BEGIN!++=! FTP_Server.B32 Copyright(c) 1986 Carnegie Mellon University!! Description:!B! The main routines and starting point of the FTP network protocol! server for the CMU/TEK code.!.! Written By: Dale Moore 10-MAY-1986 CMU-CS/RI!! Modifications:!+! V2.5-3 Hunter Goatley 23-APR-1999 13:37=! Added check for HIDE_VMS_SYST logical to determine whether9! or not we should disguise the fact we're a VMS system.!"! 21-Jun-1993 Darrell Burkhead WKU,! Turned off ASTs around the call to FTP_In.!"! 01-JUL-1986 Dale Moore CMU-CS/RI7! Change the name of the network device from THC to IP.!!--LIBRARY 'SYS$LIBRARY:STARLET';LIBRARY 'NETAUX';LIBRARY 'NETLIB';LIBRARY 'FTP_CONN_INFO'; COMPILETIME debug = 0;I%IF debug %THEN %MESSAGE('DEBUG mode is enabled in FTP_SERVER.B32!') %FI;GLOBAL= saved_conn_info : CONNDEF; !Connection info is read in here. GLOBAL BIND sys$net = %ASCID'SYS$NET';EXTERNAL unix_style_dir,? emulate_unix_ls, !Defined in FTP_SET_PARAMS, used in FTP_DTON.< hide_vms_syst; !Defined in FTP_SET_PARAMS, used in FTP_IN.BIND, lnm$dcl_logical = %ASCID 'LNM$DCL_LOGICAL';+ROUTINE transcript(astprm, string_desc_a) = BEGIN BIND( string_desc = .string_desc_a : $BBLOCK; %IF debug3 %THEN print('transcript ''!AF''', string_desc); %FI SS$_NORMAL END;ROUTINE ftp_done_ast = BEGIN %IF debug' %THEN print('!%D FTP_Done_AST', 0); %FI $WAKE() END;ROUTINE ftp_server_main = BEGIN EXTERNAL ROUTINE toggle_priv, ftp_in; LOCAL/ inp_channel : WORD UNSIGNED, !Mailbox channels" out_channel : WORD UNSIGNED, !..." log_channel : WORD UNSIGNED, !... inp_iosb : IOSBDEF, final_status," lnmlst : $ITMLST_DECL(ITEMS=1),( lnm_buffer : VOLATILE VECTOR[256,Byte], lnm_len, status; %IF debug %THEN print('FTP_SERVER'); %FI !3 ! Set up the channels to the routing mailboxes. ! status = $ASSIGN( CHAN = inp_channel, DEVNAM = sys$net); %IF debugK %THEN print('Assign input mbx, chan = !XW, status = !XL', .inp_channel, .status); %FI, IF NOT .status THEN $EXIT(CODE=.status); status = $ASSIGN( DEVNAM = output_mbx, CHAN = out_channel ); %IF debugL %THEN print('Assign output mbx, chan = !XW, status = !XL', .out_channel, .status); %FI, IF NOT .status THEN $EXIT(CODE=.status); status = $ASSIGN( DEVNAM = log_mbx, CHAN = log_channel ); %IF debugI %THEN print('Assign log mbx, chan = !XW, status = !XL', .log_channel, .status); %FI, IF NOT .status THEN $EXIT(CODE=.status); !G ! Determine whether or not to do UNIX ls emulation on DIR commands. ! $ITMLST_INIT(ITMLST=lnmlst, (ITMCOD = LNM$_STRING, BUFADR = lnm_buffer,# BUFSIZ = %ALLOCATION(lnm_buffer), RETLEN = lnm_len));9 IF ($TRNLNM(LOGNAM = %ASCID 'MADGOAT_FTP_DO_UNIX_LS', TABNAM = lnm$dcl_logical, ITMLST = LNMLST)) THEN3 emulate_unix_ls = (IF .lnm_buffer[0] EQLU %C'A' OR .lnm_buffer[0] EQLU %C'a' THEN 2 ELSE 1);= IF ($TRNLNM(LOGNAM = %ASCID'MADGOAT_FTP_DO_UNIX_LS_INIT', TABNAM = lnm$dcl_logical)) THEN unix_style_dir = 1;; IF ($TRNLNM(LOGNAM = %ASCID'MADGOAT_FTP_HIDE_VMS_SYST', TABNAM = lnm$dcl_logical)) THEN hide_vms_syst = 1; open_act_log(.log_channel);!-! Read the connection info from the listener.!/! SYSPRV is required to read the input mailbox.! toggle_priv(1, 0); status = $QIOW( CHAN = .inp_channel, FUNC = IO$_READVBLK, IOSB = inp_iosb, P1 = saved_conn_info, P2 = CONN_S_CONNDEF); toggle_priv(0, 0);6 IF .status THEN status = .inp_iosb[IOSB_W_STATUS]; %IF debug9 %THEN print('Read input mbx, status = !XL', .status); %FI, IF NOT .status THEN $EXIT(CODE=.status);!E! FTP_In was written to be called at AST level, i.e., it assumes thatB! it will not be interrupted by other user-mode ASTs. Turning off1! ASTs will fix several synchronization problems.! status = $SETAST(ENBFLG=0); ftp_in( .inp_channel, .out_channel, saved_conn_info, transcript, final_status, ftp_done_ast, 0);5 IF .status EQL SS$_WASSET THEN $SETAST(ENBFLG=1);!I! Sleep until awakened by ftp_done_ast, i.e., when the connection closes.! $HIBER; $EXIT(code=.final_status) END; !G! This is a dummy routine needed by FTP_NTOF.B32. For the client, theD! file size on incoming STRU VMS files is stored so that CTRL-A canC! show the percentage of the total file that has been transferred.!E! The server doesn't need that. This dummy routine is used to avoidD! the need to use an %IF %VARIANT in the FTP_NTOF.B32 for the call.!>GLOBAL ROUTINE set_tot_file_size(dummy) = BEGIN RETURN 0; END;ENDELUDOM$*[MGFTP.SOURCE]FTP_SERVER_CMDS.B32;55+,^z./ 4PR-I0123KPWO56v7|<v89/RFÞGHJ ! MadGoat FTP client and server!?! Authors: Chad Wilson, Dale Moore, Tod Shannon, Bruce Miller,,! Marc Shannon, Henry Miller, John Clement,1! Matt Madison, Darrell Burkhead, Hunter Goatley!6! Copyright 1986, 1992, Carnegie Mellon University.B! Copyright 1994, 2000, MadGoat Software. All rights reserved.!?! Permission is granted for not-for-profit redistribution,?! provided all source and object code remain unchanged from?! the original distribution, and that all copyright notices! remain intact.!MODULE ftp_server_cmds( ADDRESSING_MODE( EXTERNAL = LONG_RELATIVE," NONEXTERNAL = LONG_RELATIVE), IDENT = 'V2.6-1',# LIST(ASSEMBLY, NOBINARY, NOEXPAND) ) =BEGIN!++! FTP_SERVER_CMDS.B32!! Description:!E! This module contains the FTP-server commands that are availale onlyD! after logging in. These routines were taken from FTP_IN.B32 in an@! attempt to make FTP_IN generic enough to work for the CRUX FTP! listener prv MGFTP026.G^zI$[MGFTP.SOURCE]FTP_SERVER_CMDS.B32;55PRrocess.!E! Note : For all of these routines, FTP_HANDLER has been enabled back@! up the line (in Normal_Cmd_Recv). FTP$_ condition codes will8! be turned into responses and sent back to the client.!.! Written By: Darrell Burkhead WKU 23-Apr-1993!! Modifications:!+! V2.6-1 Hunter Goatley 20-MAR-2000 17:19:! Pass 0 in for allocation quantity to ftp_net_to_file().!+! V2.5-4 Hunter Goatley 14-JUL-1999 13:45>! Modified to pass the local host address to *_to_* routines.;! Needed to make MGFTP work with cluster aliases properly.!+! V2.5-3 Hunter Goatley 25-MAR-1999 23:42=! Added statements to set the CMD_INPROG field in the FBLOCK,! for activity logging added in FTP_IN.B32.!%! Hunter Goatley 5-MAY-1999 16:489! Removed "beginning" from a couple of logging messages.!)! V2.5 Hunter Goatley 18-JUN-1998 21:306! Pass extra arguments to *_TO_*() routines to handle9! reworked passive mode stuff to work in cases where the1! commands arrive before the client has actually!! opened the passive connection.!)! V2.4 Hunter Goatley 11-MAR-1998 14:15<! Added log entry for successful retrieval of files so that@! stats can be gleaned on what files were actually transferred.!)! V2.3 Hunter Goatley 27-FEB-1998 20:42:! Set UNIX ls-emulation flag if CWD or LIST paths include3! a "/". Also, added "already translated" flag to0! set_current_dir() call. Also, added calls to!! translate_directory_to_unix().!+! V2.2-6 Hunter Goatley 12-JAN-1998 22:124! Addendum to V2.2-5: allow subdirectory names too.!+! V2.2-5 Hunter Goatley 11-JAN-1998 14:52=! Handle Netscape's passing "CWD ~user" as "CWD [.~user]" by! removing the "[.]" chars.!)! V2.2 Hunter Goatley 5-AUG-1996 23:03@! Modify calls to translate_directory() to add "~user" support.%! Hunter Goatley 21-AUG-1996 15:09=! Fix bug in RNTO_COMMAND() (typo in translate_file() call).!,! V2.1-2 Darrell Burkhead 11-NOV-1994 11:33:! Don't update the block count in the transcript routine.9! The block count is now calculated once the transfer is! done.!*! V2.1 Darrell Burkhead 5-AUG-1994 10:347! Moved setup_privs from FTP_IN.B32. It is now called! change_privs.!,! V2.0-4 Darrell Burkhead 7-JUN-1994 11:20@! Look for a 000README. file after changing remote directories.! Reply the contents if found.!,! V2.0-3 Darrell Burkhead 31-MAY-1994 13:52(! Added some missing anon_log messages.!,! V2.0-2 Darrell Burkhead 8-FEB-1994 17:26;! Implemented the part of SITE PRIV which sets privileges.!,! V2.0-1 Darrell Burkhead 7-FEB-1994 10:25>! Moved everything that is done in response to a REIN command;! into send_rein. send_rein is called by rein_command and@! when a login attempt is rejected after the server has already! been created.!:! Don't use the block channel for MODE C transfers, since9! it has been disabled in the client (there are problems6! with MODE C transfers and the Multinet FTP server).!*! V2.0 Darrell Burkhead 18-NOV-1993 11:598! Use NETLIB. Moved several routines back into FTP_IN.!,! V1.1-3 Darrell Burkhead 21-OCT-1993 16:20=! Modified the trans_desc strings used to look more like the%! messages from the Multinet server.!,! V1.1-2 Darrell Burkhead 11-OCT-1993 17:58;! Moved the timezone stuff to FTP_IN and moved the timeout=! logical-name-translation to FTP_COMMON_CMDS. Replaced the<! global variable FTP_TIMEOUT with a longword in FBLOCKDEF.!+! V1.1-1 Hunter Goatley 28-SEP-1993 14:406! Added checks for other products' TIMEZONE logicals.2! Added MADGOAT_ to all of the FTP logical names.!)! V1.1 Hunter Goatley 26-SEP-1993 01:167! Changed structure refernces to match AXP promotions.!"! 29-JUN-1993 Darrell Burkhead WKUE! Implemented FTP$K_Restrict_CWD. This restriction disallows the CWDD! and CDUP commands and denies the user access to any files that areD! not in the current directory. Also, added a Check_Access call for! the SITE CHMOD command.!"! 10-JUN-1993 Darrell Burkhead WKUF! Added Set_Trans_Desc which includes STRU and TYPE information on theI! the "150 RETR File tmp.tmp..."-type messages sent by Normal_Data_Start.!"! 09-JUN-1993 Darrell Burkhead WKUB! Modified the SITE BLOCK command to show the current blocksize if! no new blocksize is given.!--LIBRARY 'SYS$LIBRARY:LIB';LIBRARY 'FTP';LIBRARY 'FTPSRV';LIBRARY 'ANON_FTP';LIBRARY 'FTP_IN';LIBRARY 'FTP_CONN_INFO';LIBRARY 'NETAUX';LIBRARY 'NETLIB'; COMPILETIME debug = 0;N%IF debug %THEN %MESSAGE('DEBUG mode is enabled in FTP_SERVER_CMDS.B32!') %FI;EXTERNAL7 ftp_restrict : LONG; !Tells which types of access are !...restrictedEXTERNAL ROUTINE strings_handler, translate_file, translate_directory, data_start_ast, data_finish_ast,/ STR$POSITION : BLISS ADDRESSING_MODE(GENERAL),- STR$CONCAT : BLISS ADDRESSING_MODE(GENERAL),. STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);BIND+ lnm$dcl_logical = %ASCID'LNM$DCL_LOGICAL',/ readme_filename = %ASCID'SYS$DISK:[].MESSAGE', priv_string = %ASCID'PRIV', all_priv = %ASCID'ALL', cmkrnl_priv = %ASCID'CMKRNL', cmexec_priv = %ASCID'CMEXEC', sysnam_priv = %ASCID'SYSNAM', grpnam_priv = %ASCID'GRPNAM'," allspool_priv = %ASCID'ALLSPOOL', detach_priv = %ASCID'DETACH'," diagnose_priv = %ASCID'DIAGNOSE', log_io_priv = %ASCID'LOG_IO', group_priv = %ASCID'GROUP', prmceb_priv = %ASCID'PRMCEB', prmmbx_priv = %ASCID'PRMMBX', pswapm_priv = %ASCID'PSWAPM', setpri_priv = %ASCID'SETPRI', setprv_priv = %ASCID'SETPRV', tmpmbx_priv = %ASCID'TMPMBX', world_priv = %ASCID'WORLD', mount_priv = %ASCID'MOUNT', oper_priv = %ASCID'OPER', exquota_priv = %ASCID'EXQUOTA', netmbx_priv = %ASCID'NETMBX', volpro_priv = %ASCID'VOLPRO', phy_io_priv = %ASCID'PHY_IO', bugchk_priv = %ASCID'BUGCHK', prmgbl_priv = %ASCID'PRMGBL', sysgbl_priv = %ASCID'SYSGBL', pfnmap_priv = %ASCID'PFNMAP', shmem_priv = %ASCID'SHMEM', syslck_priv = %ASCID'SYSLCK', share_priv = %ASCID'SHARE', upgrade_priv = %ASCID'UPGRADE',$ downgrade_priv = %ASCID'DOWNGRADE', grpprv_priv = %ASCID'GRPPRV', readall_priv = %ASCID'READALL'," security_priv = %ASCID'SECURITY', acnt_priv = %ASCID'ACNT', altpri_priv = %ASCID'ALTPRI', bypass_priv = %ASCID'BYPASS', sysprv_priv = %ASCID'SYSPRV', updir_str = %ASCID'[-]', slash_str = %ASCID'/', lbracket_str = %ASCID'[', abracket_str = %ASCID'<',. current_dir_str = %ASCID'Current directory '; .ROUTINE transcript_routine(fblock_a, desc_a) =!++! Functional description:!=! A small transcript routine for debugging and info purposes.!-- BEGIN BIND fblock = .fblock_a : FBLOCKDEF, desc = .desc_a : $BBLOCK;<! fblock[FBLOCK_L_BLOCKS] = .fblock[FBLOCK_L_BLOCKS] + 1;K fblock[FBLOCK_L_BYTES] = .fblock[FBLOCK_L_BYTES] + .desc[DSC$W_LENGTH]; IF .fblock[FBLOCK_V_TRACE] THEN BEGIN; print('!%D Transcript !6UL bytes',0, .desc[DSC$W_LENGTH]);@ print('!AF', .desc[DSC$W_LENGTH], .desc[DSC$A_POINTER]); END; SS$_NORMAL END; -ROUTINE set_trans_desc(fblock_a, command_a) =!++! Functional description:!H! Include structure and type information in fblock[FBLOCK_Q_TRANS_DESC].! ! Parameters:!9! fblock The block that contains all the info about this! connection.;! command_a Address of a string descriptor with the type of ! transfer.!-- BEGIN BIND# fblock = .fblock_a :sHP MGFTP026.G^zI$[MGFTP.SOURCE]FTP_SERVER_CMDS.B32;55P FBLOCKDEF,# command = .command_a : $BBLOCK,4 trans_desc = fblock[FBLOCK_Q_TRANS_DESC] : $BBLOCK; LOCAL status; EXTERNAL ROUTINE- STR$APPEND : BLISS ADDRESSING_MODE(GENERAL),. STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL); %IF debug? %THEN print('set_trans_desc : fblock = !XL, Command = !AS', fblock, command); %FI0 IF .fblock[FBLOCK_L_STRU] EQL FTP$K_STRU_VMS7 THEN status = STR$COPY_DX(trans_desc, %ASCID'VMS ') ELSE BEGIN! status = STR$COPY_DX(trans_desc, (CASE .fblock[FBLOCK_L_TYPE]( FROM FTP$K_TYPE_AN TO FTP$K_TYPE_L OF SET [FTP$K_TYPE_AN, FTP$K_TYPE_AT,$ FTP$K_TYPE_AC] : %ASCID'ASCII '; [FTP$K_TYPE_EN, FTP$K_TYPE_ET,% FTP$K_TYPE_EC] : %ASCID'EBCDIC ';$ [FTP$K_TYPE_I] : %ASCID'Binary '; !/ ! Local 8 is the only "local" type supported. !& [FTP$K_TYPE_L] : %ASCID'Local(8) '; TES)); IF .status AND0 (.fblock[FBLOCK_L_STRU] EQL FTP$K_STRU_RECORD)8 THEN status = STR$APPEND(trans_desc, %ASCID 'Record '); END; !End of non-STRU VMS IF .status2 THEN status = STR$APPEND(trans_desc, command); %IF debug %THEN> print('Trans_desc = !AS, Status = !XL', trans_desc, .status); %FI( IF NOT .status THEN SIGNAL(.status); .status END; 3GLOBAL ROUTINE user_command(fblock_a, username_a) =!++! Functional description:!2! The argument is the string identifying the user.!9! If we are already logged in, then we should log us out.$! Actually we send an error message.! ! Parameters:!9! fblock The block that contains all the info about this ! transfer.!*! Username The descriptor of the username.!-- BEGIN BIND" fblock = .fblock_a : FBLOCKDEF,# username = .username_a : $BBLOCK;A SIGNAL(FTP$_ALREADY_LOGGED_IN, 1, fblock[FBLOCK_Q_USERNAME]); SS$_NORMAL END; 3GLOBAL ROUTINE pass_command(fblock_a, password_a) =!++! Functional description:!.! Arg is string specifying the users password.! ! Parameters:!9! fblock The block that contains all the info about this ! transfer.!*! password The descriptor of the password.!-- BEGIN BIND" fblock = .fblock_a : FBLOCKDEF,# password = .password_a : $BBLOCK; BIND0 timezone = fblock[FBLOCK_Q_TIMEZONE] : $BBLOCK,0 username = fblock[FBLOCK_Q_USERNAME] : $BBLOCK; EXTERNAL ROUTINE ftp_announce; LOCAL lstatus, status;; IF .fblock[FBLOCK_L_STATE] NEQU FBLOCK_K_STATE_CMD_WORK& THEN SIGNAL(FTP$_BAD_SEQUENCE, 0);A SIGNAL(FTP$_ALREADY_LOGGED_IN, 1, fblock[FBLOCK_Q_USERNAME]); SS$_NORMAL END; 2GLOBAL ROUTINE cwd_command(fblock_a, pathname_a) =!++! Functional description:!!! The FTP version of Set Default.!1! We need to change SYS$DISK logical name and use ! SYS$SETDDIR! ! Parameters:!9! fblock The block that contains all the info about this ! transfer.!@! pathname The name of the directory we are to make the default.!-- BEGIN BIND# fblock = .fblock_a : FBLOCKDEF,0 out_desc = fblock[FBLOCK_Q_OUT_DESC] : $BBLOCK,$ pathname = .pathname_a : $BBLOCK; EXTERNAL ROUTINE ftp_announce_file, strings_handler, set_current_dir, get_current_dir, translate_directory_to_unix; EXTERNAL! unix_style_dir, emulate_unix_ls; LOCAL( local_pathname : $BBLOCK [DSC$K_S_BLN], cwd_status, status;J IF NOT .fblock[FBLOCK_V_LOGGED_IN] THEN SIGNAL(FTP$_NOT_LOGGED_IN, 0);; IF .fblock[FBLOCK_L_STATE] NEQU FBLOCK_K_STATE_CMD_WORK& THEN SIGNAL(FTP$_BAD_SEQUENCE, 0);3 IF (.ftp_restrict AND FTP$K_RESTRICT_CWD) NEQ 09 THEN SIGNAL(FTP$_NO_ACCESS, 1, %ASCID 'Command:CWD'); !A ! Special case: Netscape is stupid and will turn "~user" intoB ! [.~user], trying to do us a favor. Fix this case by passing/ ! on just "~user" to translate_directory(). !1 local_pathname [DSC$B_DTYPE] = DSC$K_DTYPE_T;1 local_pathname [DSC$B_CLASS] = DSC$K_CLASS_S;? local_pathname [DSC$A_POINTER] = .pathname [DSC$A_POINTER];= local_pathname [DSC$W_LENGTH] = .pathname [DSC$W_LENGTH];, IF (.pathname [DSC$W_LENGTH] GTRU 3) AND6 ((CH$RCHAR(.pathname [DSC$A_POINTER]) EQLU %C'[') AND8 (CH$RCHAR(.pathname [DSC$A_POINTER]+1) EQLU %C'.') AND5 (CH$RCHAR(.pathname [DSC$A_POINTER]+2) EQLU %C'~')) THEN BEGIN LOCAL x : REF $BBLOCK;F local_pathname [DSC$A_POINTER] = .local_pathname [DSC$A_POINTER] + 2;D local_pathname [DSC$W_LENGTH] = .local_pathname [DSC$W_LENGTH] - 3; !@ ! Convert any "." into "/" (e.g, [.~user.test] -> ~user/test ) !A WHILE NOT(CH$FAIL(x = CH$FIND_CH(.local_pathname [DSC$W_LENGTH],. .local_pathname [DSC$A_POINTER], %C'.'))) DO CH$WCHAR(%C'/', .x); END;7 IF (STR$POSITION(local_pathname, slash_str) NEQU 0) THEN unix_style_dir = 1 ELSE: IF (STR$POSITION(local_pathname, lbracket_str) NEQU 0) OR7 (STR$POSITION(local_pathname, abracket_str) NEQU 0) THEN unix_style_dir = 0;* status = translate_directory(out_desc,' IF .local_pathname[DSC$W_Length] NEQ 0. THEN local_pathname ELSE %ASCID 'SYS$LOGIN:',B .fblock [FBLOCK_V_ANONYMOUS], fblock [FBLOCK_Q_RESTRICTED_DIRS]); IF NOT .status6 THEN SIGNAL(FTP$_BAD_DIRECTORY_NAME, 1, pathname); !++. ! See whether this user can access the Dir !--% IF .fblock[FBLOCK_V_CHECK_ACCESS]C THEN IF NOT check_access(out_desc, .fblock[FBLOCK_V_ANONYMOUS],3 .ftp_restrict, fblock[FBLOCK_Q_RESTRICTED_DIRS]) THEN BEGIN# IF .fblock[FBLOCK_V_ANONYMOUS]9 THEN anon_log('Access denied on CWD !AS', out_desc);! IF .fblock[FBLOCK_V_ACT_LOG]C THEN super_act$fao('FTP: Access denied on CWD !AS', out_desc);) SIGNAL(FTP$_NO_ACCESS, 1, out_desc); END;,! cwd_status = set_current_dir(pathname);F cwd_status = set_current_dir(out_desc, 1); !Already translated too IF NOT .cwd_status THEN BEGIN8 IF .cwd_status EQL RMS$_DNF OR .cwd_status EQL RMS$_DEV@ THEN SIGNAL(FTP$_DIRECTORY_NOT_FOUND, 1, out_desc, .cwd_status)! ELSE IF .cwd_status EQL RMS$_PRV) THEN SIGNAL(FTP$_NO_ACCESS, 1, out_desc)@ ELSE SIGNAL(FTP$_BAD_DIRECTORY_NAME, 1, out_desc, .cwd_status); END;' status = get_current_dir(out_desc);( IF NOT .status THEN SIGNAL(.status);" IF .FBLOCK[FBLOCK_V_ANONYMOUS]@ THEN anon_log('Default directory changed to !AS', out_desc); IF .fblock[FBLOCK_V_ACT_LOG]I THEN super_act$fao('FTP: Default directory changed to !AS',out_desc);> ftp_announce_file(fblock, FTP$C_FILE_OK, readme_filename);5 IF (.unix_style_dir) OR (.emulate_unix_ls EQLU 2) THEN2 translate_directory_to_unix (out_desc, out_desc);; SIGNAL(FTP$_ACTION_OKAY, 2, current_dir_str, out_desc); SS$_NORMAL END; 4GLOBAL ROUTINE cdup_command(fblock_a, parameter_a) =!++! Functional description:!9! The FTP version of the VMS DCL command "$ SET DEF [-]".! ! Parameters:!9! fblock The block that contains all the info about this ! transfer.!=! parameter Should be empty. Thes Ftp command takes no args.!-- BEGIN BIND# fblock = .fblock_a : FBLOCKDEF,0 out_desc = fblock[FBLOCK_Q_OUT_DESC] : $BBLOCK,& parameter = .parameter_a : $BBLOCK; EXTERNAL ROUTINE ftp_announce_file, strings_handler, set_current_dir, get_current_dir, translate_directory_to_unix; EXTERNAL! unix_style_dir, emulate_unix_ls; LOCAL cdup_status, status;& IF .parameter[DSC$W_LENGTH] NEQU 0* THEN SIGNAL(FTP$_PARAMETER_SYNTAX,t㝯8 MGFTP026.G^zI$[MGFTP.SOURCE]FTP_SERVER_CMDS.B32;55P! 0);& IF NOT .fblock[FBLOCK_V_LOGGED_IN]' THEN SIGNAL(FTP$_NOT_LOGGED_IN, 0);n; IF .fblock[FBLOCK_L_STATE] NEQU FBLOCK_K_STATE_CMD_WORK& THEN SIGNAL(FTP$_BAD_SEQUENCE, 0);3 IF (.ftp_restrict AND FTP$K_RESTRICT_CWD) NEQ 0l: THEN SIGNAL(FTP$_NO_ACCESS, 1, %ASCID 'Command:CDUP');3 status = translate_file(out_desc, UPDIR_STR, 0, ! .fblock [FBLOCK_V_ANONYMOUS],' fblock [FBLOCK_Q_RESTRICTED_DIRS]);  IF NOT .status7 THEN SIGNAL(FTP$_BAD_DIRECTORY_NAME, 1, UPDIR_STR);i !++. ! See whether this user can access the dir !--A% IF .fblock[FBLOCK_V_CHECK_ACCESS]RC THEN IF NOT check_access(out_desc, .fblock[FBLOCK_V_ANONYMOUS],S3 .ftp_restrict, fblock[FBLOCK_Q_RESTRICTED_DIRS]) THEN BEGINR# IF .fblock[FBLOCK_V_ANONYMOUS] : THEN anon_log('Access denied on CDUP !AS', out_desc);! IF .fblock[FBLOCK_V_ACT_LOG]eD THEN super_act$fao('FTP: Access denied on CDUP !AS', out_desc);) SIGNAL(FTP$_NO_ACCESS, 1, out_desc);i END;e- cdup_status = set_current_dir(UPDIR_STR);_ IF NOT .cdup_statusc THEN BEGIN: IF .cdup_status EQL RMS$_DNF OR .cdup_status EQL RMS$_DEVB THEN SIGNAL(FTP$_DIRECTORY_NOT_FOUND, 1, UPDIR_STR, .cdup_status)" ELSE IF .cdup_status EQL RMS$_PRV* THEN SIGNAL(FTP$_NO_ACCESS, 1, UPDIR_STR)B ELSE SIGNAL(FTP$_BAD_DIRECTORY_NAME, 1, UPDIR_STR, .cdup_status); END;_' status = get_current_dir(out_desc);4( IF NOT .status THEN SIGNAL(.status);" IF .fblock[FBLOCK_V_ANONYMOUS]@ THEN anon_log('Default directory changed to !AS', out_desc); IF .fblock[FBLOCK_V_ACT_LOG]I THEN super_act$fao('FTP: Default directory changed to !AS',out_desc);> ftp_announce_file(fblock, FTP$C_FILE_OK, readme_filename);5 IF (.unix_style_dir) OR (.emulate_unix_ls EQLU 2)o THEN2 translate_directory_to_unix (out_desc, out_desc);; SIGNAL(FTP$_ACTION_OKAY, 2, current_dir_str, out_desc);  SS$_NORMAL END; e3GLOBAL ROUTINE smnt_command(fblock_a, pathname_a) =e!++r! Functional description:!o@! This is a mount call. For the interim, we can just ignore it.!9 ! parameters:d!l9! fblock The block that contains all the info about thiss ! transfer. !w.! pathname The name of the structure to mount.!--t BEGIN  BIND" fblock = .fblock_a : FBLOCKDEF,# pathname = .pathname_a : $BBLOCK;a& IF NOT .fblock[FBLOCK_V_LOGGED_IN]' THEN SIGNAL(FTP$_NOT_LOGGED_IN, 0); ; IF .fblock[FBLOCK_L_STATE] NEQU FBLOCK_K_STATE_CMD_WORK6& THEN SIGNAL(FTP$_BAD_SEQUENCE, 0);$ SIGNAL(FTP$_NOT_IMPLEMENTED, 0); SS$_NORMAL END; r@GLOBAL ROUTINE send_rein(fblock_a, reject_flag, reject_status) =!++a! Functional description:m!nB! This routine performs the necessary clean-up to log a server outF! while still keeping a connection to the remote host, i.e., it passes! control back to the listener.!F ! Parameters:C!A9! fblock The block that contains all the info about thisl ! transfer.O=! reject_flag Low bit set if send_rein was called to reject a 6! login (as opposed to being called in response to a ! REIN command from the user).@! reject_status condition code to be signaled with to finish the4! rejection message. This parameter is ignored if! the is not a rejection.U!--4 BEGINL BIND" fblock = .fblock_a : FBLOCKDEF; LOCALe status, trm_chan : WORD INITIAL(0), iosb : IOSBDEF,  rein : REINDEF;4 EXTERNAL ROUTINE ftp_in_finish;m" ! Activity Log: End of session IF .fblock[FBLOCK_V_ACT_LOG]: THEN super_act$fao('FTP: FTP Reinitializing server.');" IF .FBLOCK[FBLOCK_V_ANONYMOUS] THEN BEGIN) anon_log('Anonymous FTP session ends.');m. anon_log_CLOSE(.FBLOCK[FBLOCK_L_ANON_BLOCK]); END;o8 status = $ASSIGN(DEVNAM = trm_mbx, CHAN = trm_chan); IF .status THEN BEGIN !@ ! Pass the current connection information back to the listener. ! rein[REIN_W_MSGTYP] = MSG_REIN;2 rein[REIN_L_DADDR] = .fblock[FBLOCK_L_DATA_HOST];2 rein[REIN_W_DPORT] = .fblock[FBLOCK_L_DATA_PORT];, rein[REIN_B_MODE] = .fblock[FBLOCK_L_MODE];, rein[REIN_B_TYPE] = .fblock[FBLOCK_L_TYPE];6 rein[REIN_B_TYPE_SIZE] = .fblock[FBLOCK_L_TYPE_SIZE];, rein[REIN_B_STRU] = .fblock[FBLOCK_L_STRU]; rein[REIN_W_FLAGS] = 0; IF .reject_flag THEN BEGINl rein[REIN_V_REJECTED] = 1;M1 rein[REIN_L_REJECT_STATUS] = .reject_status;e END;g status = $QIOW( CHAN = .trm_chan,S FUNC = IO$_WRITEVBLK,a IOSB = iosb, P1 = rein, P2 = REIN_S_REINDEF); / IF .status THEN status = .iosb[IOSB_W_STATUS];d END;k IF .status3 THEN status = ftp_in_finish(fblock,SS$_NORMAL); $DASSGN( CHAN = .trm_chan );( IF NOT .status THEN RETURN(.status); SS$_NORMAL END; c4GLOBAL ROUTINE rein_command(fblock_a, parameter_a) =!++! Functional description:t!D=! This command terminats a USER, flushing all I/O and account A! info, except to allow any transfer in progress to be completed.d>! All params are reset to the default settings and the controlC! connection is left open. This is identical to the state in which_B! a user finds himself immediately after the control connection is4! opened. A USER command may be expected to follow.!t ! Parameters:N!99! fblock The block that contains all the info about thiso ! transfer.n!l;! parameter This sould be emtpy. The REIN ftp command takesS! no params.!--R BEGINI BIND" fblock = .fblock_a : FBLOCKDEF,% parameter = .parameter_a : $BBLOCK;& IF .parameter[DSC$W_LENGTH] NEQU 0* THEN SIGNAL(FTP$_PARAMETER_SYNTAX, 0);; IF .fblock[FBLOCK_L_STATE] NEQU FBLOCK_K_STATE_CMD_WORK;& THEN SIGNAL(FTP$_BAD_SEQUENCE, 0); send_rein(fblock, 0); SS$_NORMAL END; L3GLOBAL ROUTINE retr_command(fblock_a, pathname_a) =s!++d! Functional description:,!d;! Retrieve command. Transfer a copy of the file, specifiedA;! in the pathname, to the other end of the data connection.P2! status and contents of file shall be unaffected.! ! parameters:G!D9! fblock The block that contains all the info about thisI ! transfer._!--a BEGIN' BIND" fblock = .fblock_a : FBLOCKDEF,4 trans_desc = fblock[FBLOCK_Q_TRANS_DESC] : $BBLOCK,0 out_desc = fblock[FBLOCK_Q_OUT_DESC] : $BBLOCK,# pathname = .pathname_a : $BBLOCK;v EXTERNAL ROUTINE ftp_file_to_net,I ftp_file_to_net_abort;v LOCALE% item_list : $ITMLST_DECL(ITEMS = 2),E access : INITIAL(ARM$M_READ),, rstatus,i status;& IF NOT .fblock[FBLOCK_V_LOGGED_IN]' THEN SIGNAL(FTP$_NOT_LOGGED_IN, 0);r; IF .fblock[FBLOCK_L_STATE] NEQU FBLOCK_K_STATE_CMD_WORK_& THEN SIGNAL(FTP$_BAD_SEQUENCE, 0);P status = translate_file(out_desc, pathname, 0, .fblock [FBLOCK_V_ANONYMOUS],' fblock [FBLOCK_Q_RESTRICTED_DIRS]);D IF NOT .status1 THEN SIGNAL(FTP$_BAD_FILE_NAME, 1, pathname);O4 IF (.ftp_restrict AND FTP$K_RESTRICT_READ) NEQ 0 THEN BEGIN IF .FBLOCK[FBLOCK_V_ANONYMOUS]b0 THEN anon_log('No access to Command:RETRieve'); IF .fblock[FBLOCK_V_ACT_LOG]M: THEN super_act$fao('FTP: No access to Command:RETRieve');6 SIGNAL(FTP$_NO_ACCESS, 1, %ASCID 'Command:RETRieve'); END;C !++E/ ! See whether this user can access the file  !--R% IF .fblock[FBLOCK_V_CHECK_ACCESS]IC THEN IF NOT check_access(out_desc, .fblock[FBLOCK_V_ANONYMOUS],p3 .ftp_restrict, fblock[FBLOCK_Q_RESTRICTED_DIRS])P THEN BEGINs# IF .fblock[FBLOCK_V_ANONYMOUS]I: THEN anon_log('access denied on RETR !AS', out_desc);! IF .fblock[FBLOCK_V_Auɏ MGFTP026.G^zI$[MGFTP.SOURCE]FTP_SERVER_CMDS.B32;55PK^0CT_LOG]nD THEN super_act$fao('FTP: access denied on RETR !AS', out_desc);) SIGNAL(FTP$_NO_ACCESS, 1, out_desc);m END;i ! Activity Log: Retreive" IF .fblock[FBLOCK_V_ANONYMOUS]; THEN anon_log('Beginning RETR !AS (typ=!UB, stru=!UB)',C> out_desc, .fblock[FBLOCK_L_TYPE], .fblock[FBLOCK_L_STRU]); IF .fblock[FBLOCK_V_ACT_LOG]? THEN super_act$fao('FTP: Retrieve !AS (typ=!UB, stru=!UB)',F> out_desc, .fblock[FBLOCK_L_TYPE], .fblock[FBLOCK_L_STRU]);4 fblock[FBLOCK_L_CMD_INPROG] = FBLOCK_K_CMD_RETR; status = ftp_file_to_net(N! .fblock[FBLOCK_L_MODE], ! Mode ! .fblock[FBLOCK_L_STRU], ! Struf! .fblock[FBLOCK_L_TYPE], ! Typec2 .fblock[FBLOCK_L_TYPE_SIZE], ! 8 when type = L 8, .fblock[FBLOCK_L_LOCAL_HOST], ! Local host% .fblock[FBLOCK_L_DATA_HOST], ! Host % .fblock[FBLOCK_L_DATA_PORT], ! Portt out_desc, ! File Nameo 0, ! EFN  data_finish_ast, ! AstAdr fblock, ! AstPrmr) fblock[FBLOCK_L_STATUS], ! Final status.# transcript_routine, ! Transcript out_desc, ! Output File_Spec/ IF .fblock[FBLOCK_L_MODE] EQL FTP$K_MODE_BLOCK 5 THEN fblock[FBLOCK_L_BLK_CHANNEL] !Use block channelL ELSE 0, 1, !E .fblock [FBLOCK_V_PASV_MODE],$ .fblock [FBLOCK_L_PASSIVE_CHANNEL]," fblock [FBLOCK_L_PASV_START_RTN],? fblock [FBLOCK_L_PASV_START_ASTPRM]); ! Passive channel (or 0) IF NOT .status THEN BEGIN ! Activity Log: End of session  IF .fblock[FBLOCK_V_ANONYMOUS]SE THEN anon_log('Retrieval of !AS failed, codes = !XL, !XL', out_desc,c% .status, .fblock[FBLOCK_L_STATUS]);  IF .fblock[FBLOCK_V_ACT_LOG]E THEN super_act$fao('FTP: Retrieval of !AS failed, codes = !XL, !XL',I. out_desc,.status, .fblock[FBLOCK_L_STATUS]); IF .STATUS EQL FTP$_DIR_FILEC THEN SIGNAL(.status); rstatus = FTP$_BAD_FILE_NAME; IF (.status EQL RMS$_FNF) ORp (.status EQL RMS$_DNF) OR (.status EQL RMS$_NOD) OR (.status EQL RMS$_DEV)# THEN rstatus = FTP$_FILE_NOT_FOUNDT ELSE IF .status EQL RMS$_PRVA THEN rstatus = FTP$_NO_ACCESS" ELSE IF (.status EQL RMS$_FLK) OR (.status EQL RMS$_WLK) ORs (.status EQL RMS$_DNR)& THEN rstatus = FTP$_FILE_UNAVAILABLE; IF NOT .fblock[FBLOCK_L_STATUS], THEN SIGNAL(.rstatus, 1, out_desc, .status, .fblock[FBLOCK_L_STATUS]);- ELSE SIGNAL(.rstatus, 1, out_desc, .status);u END;m. set_trans_desc(fblock, %ASCID 'Retrieve');7 fblock[FBLOCK_L_ABORT_ADR] = ftp_file_to_net_abort;t status = $DCLAST(  ASTADR = data_start_ast, ASTPRM = fblock); ( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; 3GLOBAL ROUTINE stor_command(fblock_a, pathname_a) =n!++! Functional description:p! 9! Store the data transferred via the data connection. Ifb:! file specified in pathname exists, then we overwrite it.! ! parameters:L!D9! fblock The block that contains all the info about thisL ! transfer.!B*! pathname The name of the file to create.!-- BEGINc BIND" fblock = .fblock_a : FBLOCKDEF,4 trans_desc = fblock[FBLOCK_Q_TRANS_DESC] : $BBLOCK,0 out_desc = fblock[FBLOCK_Q_OUT_DESC] : $BBLOCK,# pathname = .pathname_a : $BBLOCK;d LOCALp* fblock_enable : VOLATILE INITIAL(fblock); EXTERNAL ROUTINE ftp_handler;E ENABLE ftp_handler(fblock_enable); EXTERNAL ROUTINE ftp_net_to_file,E ftp_net_to_file_abort;m LOCALF status;& IF NOT .fblock[FBLOCK_V_LOGGED_IN]' THEN SIGNAL(FTP$_NOT_LOGGED_IN, 0);s; IF .fblock[FBLOCK_L_STATE] NEQU FBLOCK_K_STATE_CMD_WORKD& THEN SIGNAL(FTP$_BAD_SEQUENCE, 0);5 IF (.ftp_restrict AND FTP$K_RESTRICT_WRITE) NEQ 0L THEN BEGIN IF .FBLOCK[FBLOCK_V_ANONYMOUS]- THEN anon_log('No access to Command:STORe');_ IF .fblock[FBLOCK_V_ACT_LOG]p7 THEN super_act$fao('FTP: No access to Command:STORe');n3 SIGNAL(FTP$_NO_ACCESS, 1, %ASCID 'Command:STORe');E END;P status = translate_file(out_desc, pathname, 0, .fblock [FBLOCK_V_ANONYMOUS],' fblock [FBLOCK_Q_RESTRICTED_DIRS]);f IF NOT .status1 THEN SIGNAL(FTP$_BAD_FILE_NAME, 1, pathname);% IF .fblock[FBLOCK_V_CHECK_ACCESS]tC THEN IF NOT check_access(out_desc, .fblock[FBLOCK_V_ANONYMOUS], 3 .ftp_restrict, fblock[FBLOCK_Q_RESTRICTED_DIRS])e THEN BEGINh# IF .fblock[FBLOCK_V_ANONYMOUS]r: THEN anon_log('access denied on STOR !AS', out_desc);! IF .fblock[FBLOCK_V_ACT_LOG] D THEN super_act$fao('FTP: access denied on STOR !AS', out_desc);) SIGNAL(FTP$_NO_ACCESS, 1, out_desc);I END;N" IF .fblock[FBLOCK_V_ANONYMOUS]; THEN anon_log('Beginning STOR !AS (typ=!UB, stru=!UB)',N> out_desc, .fblock[FBLOCK_L_TYPE], .fblock[FBLOCK_L_STRU]); IF .fblock[FBLOCK_V_ACT_LOG]< THEN super_act$fao('FTP: Store !AS (typ=!UB, stru=!UB)',> out_desc, .fblock[FBLOCK_L_TYPE], .fblock[FBLOCK_L_STRU]);4 fblock[FBLOCK_L_CMD_INPROG] = FBLOCK_K_CMD_STOR; status = ftp_net_to_file(r! .fblock[FBLOCK_L_MODE], ! Mode! .fblock[FBLOCK_L_STRU], ! Stru=! .fblock[FBLOCK_L_TYPE], ! Typee2 .fblock[FBLOCK_L_TYPE_SIZE], ! 8 When type = L 8, .fblock[FBLOCK_L_LOCAL_HOST], ! Local Host% .fblock[FBLOCK_L_DATA_HOST], ! Hostp% .fblock[FBLOCK_L_DATA_PORT], ! Portn out_desc, ! File NameA 0, ! EFN( data_finish_ast, ! AstAdr fblock, ! AstprmA* fblock[FBLOCK_L_STATUS], ! Final_status;# transcript_routine, ! TranscriptT9 .Fblock[FBLOCK_L_BLOCKSIZE], ! BlockSize for local FTPsO 0, ! Append flagD 0, ! Default file out_desc, ! Output File_Spec/ IF .fblock[FBLOCK_L_MODE] EQL FTP$K_MODE_BLOCK$5 THEN fblock[FBLOCK_L_BLK_CHANNEL] !Use Block channel[ ELSE 0, 1, ! Active .fblock [FBLOCK_V_PASV_MODE],$ .fblock [FBLOCK_L_PASSIVE_CHANNEL]," fblock [FBLOCK_L_PASV_START_RTN],> fblock [FBLOCK_L_PASV_START_ASTPRM], ! Passive channel (or 0) 0); ! Initial allocationh IF NOT .status THEN BEGIN IF .FBLOCK[FBLOCK_V_ANONYMOUS]T7 THEN anon_log('Store of !AS failed, codes = !XL, !XL',S. out_desc,.status, .fblock[FBLOCK_L_STATUS]); IF .fblock[FBLOCK_V_ACT_LOG]A THEN super_act$fao('FTP: Store of !AS failed, codes = !XL, !XL',S. out_desc,.status, .fblock[FBLOCK_L_STATUS]); IF NOT .fblock[FBLOCK_L_STATUS]6 THEN SIGNAL(FTP$_BAD_FILE_NAME, 1, out_desc, .status, .fblock[FBLOCK_L_STATUS])G7 ELSE SIGNAL(FTP$_BAD_FILE_NAME, 1, out_desc, .status);  END; + set_trans_desc(fblock, %ASCID 'Store');7 fblock[FBLOCK_L_ABORT_ADR] = ftp_net_to_file_abort;c status = $DCLAST(k ASTADR = data_start_ast, ASTPRM = fblock);F( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; O3GLOBAL ROUTINE stou_command(fblock_a, pathname_a) =o!++s! Functional description:K!AD! Store Unique. Store the data that will come in on Data connectionA! in a file with a unique name. The 150 transfer started response"! must include the name generated.! ----!! The name has not been included.o!d ! parameters:d!r9! fblock The block that contains all the info about this ! transfer. !--D BEGINs BIND" fblock = .fblock_a : FBLOCKDEF,4 trans_desc = fblock[FBLOCK_Q_TRANS_DESC] : $BBLOCK,0 out_desc = fblock[FBLOCK_Q_OUT_DESC] : $BBLOCK,# pathname = .pathname_a : $BBLOCK;_ EXTERNAL ROUTINE ftp_net_to_file,; ftp_net_to_file_abort;g LOCALd status;& IF NOT .fblock[FBLOCK_V_LOGGED_IN]' THEN SIGNAL(FTP$_NOT_LOGGED_IN, 0);]; IF .fblock[FBLOCK_L_STATE] NEQU FBLOCK_K_STATE_CMD_WORKc& THEN SIGNAL(FTP$_BAD_SEQUENCE, 0);5 IF (.ftp_restrict AND FTP$K_RESTRICT_WRITE) NEQ 0A THEN BEGIN IF .FBLOCK[FBLOCK_V_ANONYMOUS]TvQL MGFTP026.G^zI$[MGFTP.SOURCE]FTP_SERVER_CMDS.B32;55P?: THEN anon_log('No access to Command:STOU(Store Unique)'); IF .fblock[FBLOCK_V_ACT_LOG] D THEN super_act$fao('FTP: No access to Command:STOU(Store Unique)');@ SIGNAL(FTP$_NO_ACCESS, 1, %ASCID 'Command:STOU(Store Unique)'); END;NP status = translate_file(out_desc, pathname, 0, .fblock [FBLOCK_V_ANONYMOUS],' fblock [FBLOCK_Q_RESTRICTED_DIRS]);V IF NOT .status1 THEN SIGNAL(FTP$_BAD_FILE_NAME, 1, pathname); % IF .fblock[FBLOCK_V_CHECK_ACCESS]iC THEN IF NOT check_access(out_desc, .fblock[FBLOCK_V_ANONYMOUS],d3 .ftp_restrict, fblock[FBLOCK_Q_RESTRICTED_DIRS]) THEN BEGIN # IF .fblock[FBLOCK_V_ANONYMOUS]L: THEN anon_log('access denied on STOU !AS', out_desc);! IF .fblock[FBLOCK_V_ACT_LOG]aD THEN super_act$fao('FTP: access denied on STOU !AS', out_desc);) SIGNAL(FTP$_NO_ACCESS, 1, out_desc);X END;" IF .fblock[FBLOCK_V_ANONYMOUS]; THEN anon_log('Beginning STOU !AS (typ=!UB, stru=!UB)',_> out_desc, .fblock[FBLOCK_L_TYPE], .fblock[FBLOCK_L_STRU]); IF .fblock[FBLOCK_V_ACT_LOG]C THEN super_act$fao('FTP: Store Unique !AS (typ=!UB, stru=!UB)',_> out_desc, .fblock[FBLOCK_L_TYPE], .fblock[FBLOCK_L_STRU]);4 fblock[FBLOCK_L_CMD_INPROG] = FBLOCK_K_CMD_STOR; status = ftp_net_to_file(T! .fblock[FBLOCK_L_MODE], ! ModeU! .fblock[FBLOCK_L_STRU], ! Stru(! .fblock[FBLOCK_L_TYPE], ! Typec2 .fblock[FBLOCK_L_TYPE_SIZE], ! 8 When type = L 8, .fblock[FBLOCK_L_LOCAL_HOST], ! Local Host% .fblock[FBLOCK_L_DATA_HOST], ! Host_% .fblock[FBLOCK_L_DATA_PORT], ! Porth out_desc, ! File Name 0, ! EFNF data_finish_ast, ! AstAdr fblock, ! Astprmc* fblock[FBLOCK_L_STATUS], ! Final_status;# transcript_routine, ! Transcript_9 .Fblock[FBLOCK_L_BLOCKSIZE], ! BlockSize for local FTPsV 2, ! Append/Unique flag 0, ! Default file out_desc, ! Output File_Spec/ IF .fblock[FBLOCK_L_MODE] EQL FTP$K_MODE_BLOCKP5 THEN fblock[FBLOCK_L_BLK_CHANNEL] !Use block channelT ELSE 0, 1, ! Active .fblock [FBLOCK_V_PASV_MODE],$ .fblock [FBLOCK_L_PASSIVE_CHANNEL]," fblock [FBLOCK_L_PASV_START_RTN],> fblock [FBLOCK_L_PASV_START_ASTPRM], ! Passive channel (or 0) 0); ! Initial allocationO IF NOT .status THEN BEGIN IF .FBLOCK[FBLOCK_V_ANONYMOUS]T> THEN anon_log('Store Unique of !AS failed, codes = !XL, !XL',. out_desc,.status, .fblock[FBLOCK_L_STATUS]); IF .fblock[FBLOCK_V_ACT_LOG]tH THEN super_act$fao('FTP: Store Unique of !AS failed, codes = !XL, !XL',. out_desc,.status, .fblock[FBLOCK_L_STATUS]); IF NOT .fblock[FBLOCK_L_STATUS]6 THEN SIGNAL(FTP$_BAD_FILE_NAME, 1, out_desc, .status, .fblock[FBLOCK_L_STATUS])o7 ELSE SIGNAL(FTP$_BAD_FILE_NAME, 1, out_desc, .status);b END;T2 set_trans_desc(fblock, %ASCID 'Store unique');7 fblock[FBLOCK_L_ABORT_ADR] = ftp_net_to_file_abort;r status = $DCLAST(  ASTADR = data_start_ast, ASTPRM = fblock);n( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; n3GLOBAL ROUTINE appe_command(fblock_a, pathname_a) =l!++r! Functional description:o! A! Append(with create). Accept data on data connection and appendB! it to the file in pathname. If file doesn't already exist, then ! create it.! ! parameters:m!f9! fblock The block that contains all the info about thisc ! transfer. !B*! pathname Name of file to append data to.!-- BEGIN. BIND" fblock = .fblock_a : FBLOCKDEF,4 trans_desc = fblock[FBLOCK_Q_TRANS_DESC] : $BBLOCK,0 out_desc = fblock[FBLOCK_Q_OUT_DESC] : $BBLOCK,# pathname = .pathname_a : $BBLOCK;F EXTERNAL ROUTINE ftp_net_to_file,L ftp_net_to_file_abort;U LOCALe rstatus,, status;& IF NOT .fblock[FBLOCK_V_LOGGED_IN]' THEN SIGNAL(FTP$_NOT_LOGGED_IN, 0); ; IF .fblock[FBLOCK_L_STATE] NEQU FBLOCK_K_STATE_CMD_WORKn& THEN SIGNAL(FTP$_BAD_SEQUENCE, 0);5 IF (.ftp_restrict AND FTP$K_RESTRICT_WRITE) NEQ 0e THEN BEGIN IF .fblock[FBLOCK_V_ANONYMOUS] . THEN anon_log('No access to Command:APPEnd'); IF .fblock[FBLOCK_V_ACT_LOG]s8 THEN super_act$fao('FTP: No access to Command:APPEnd');4 SIGNAL(FTP$_NO_ACCESS, 1, %ASCID 'Command:APPEnd'); END;tP status = translate_file(out_desc, pathname, 0, .fblock [FBLOCK_V_ANONYMOUS],' fblock [FBLOCK_Q_RESTRICTED_DIRS]);t IF NOT .status1 THEN SIGNAL(FTP$_BAD_FILE_NAME, 1, pathname);O% IF .fblock[FBLOCK_V_CHECK_ACCESS] C THEN IF NOT check_access(out_desc, .fblock[FBLOCK_V_ANONYMOUS],L3 .ftp_restrict, fblock[FBLOCK_Q_RESTRICTED_DIRS]) THEN BEGIN # IF .fblock[FBLOCK_V_ANONYMOUS]H: THEN anon_log('access denied on APPE !AS', out_desc);! IF .fblock[FBLOCK_V_ACT_LOG] D THEN super_act$fao('FTP: access denied on APPE !AS', out_desc);) SIGNAL(FTP$_NO_ACCESS, 1, out_desc); END;=" IF .FBLOCK[FBLOCK_V_ANONYMOUS]; THEN anon_log('Beginning APPE !AS (typ=!UB, stru=!UB)',n> out_desc, .fblock[FBLOCK_L_TYPE], .fblock[FBLOCK_L_STRU]); IF .fblock[FBLOCK_V_ACT_LOG]; THEN super_act$fao('FTP: APPE !AS (typ=!UB, stru=!UB)', > out_desc, .fblock[FBLOCK_L_TYPE], .fblock[FBLOCK_L_STRU]);4 fblock[FBLOCK_L_CMD_INPROG] = FBLOCK_K_CMD_APPE; status = ftp_net_to_file(c! .fblock[FBLOCK_L_MODE], ! ModeB! .fblock[FBLOCK_L_STRU], ! Strur! .fblock[FBLOCK_L_TYPE], ! Type_2 .fblock[FBLOCK_L_TYPE_SIZE], ! 8 When type = L 8, .fblock[FBLOCK_L_LOCAL_HOST], ! Local Host% .fblock[FBLOCK_L_DATA_HOST], ! Host % .fblock[FBLOCK_L_DATA_PORT], ! PortB out_desc, ! File Name 0, ! EFN  data_finish_ast, ! AstAdr fblock, ! Astprm[* fblock[FBLOCK_L_STATUS], ! Final_status;# transcript_routine, ! TranscriptS9 .Fblock[FBLOCK_L_BLOCKSIZE], ! BlockSize for local FTPsT 1, ! Append flagt 0, ! Default file out_desc, ! Output File_Spec/ IF .fblock[FBLOCK_L_MODE] EQL FTP$K_MODE_BLOCKi5 THEN fblock[FBLOCK_L_BLK_CHANNEL] !Use block channel, ELSE 0, 1, ! Active .fblock [FBLOCK_V_PASV_MODE],$ .fblock [FBLOCK_L_PASSIVE_CHANNEL]," fblock [FBLOCK_L_PASV_START_RTN],> fblock [FBLOCK_L_PASV_START_ASTPRM], ! Passive channel (or 0) 0); ! Initial allocationc IF NOT .status THEN BEGIN IF .fblock[FBLOCK_V_ANONYMOUS]8 THEN anon_log('Append of !AS failed, codes = !XL, !XL',. out_desc,.status, .fblock[FBLOCK_L_STATUS]); IF .fblock[FBLOCK_V_ACT_LOG]B THEN super_act$fao('FTP: Append of !AS failed, codes = !XL, !XL',. out_desc,.status, .fblock[FBLOCK_L_STATUS]); IF .status EQL FTP$_DIR_FILE  THEN SIGNAL(.status); rstatus = FTP$_BAD_FILE_NAME; IF (.status EQL RMS$_FNF) ORE (.status EQL RMS$_DNF) OR (.status EQL RMS$_NOD) OR (.status EQL RMS$_DEV) # THEN rstatus = FTP$_FILE_NOT_FOUNDG ELSE IF .STATUS EQL RMS$_PRV  THEN rstatus = FTP$_NO_ACCESS" ELSE IF (.status EQL RMS$_FLK) OR (.status EQL RMS$_WLK) ORa (.status EQL RMS$_DNR)& THEN rstatus = FTP$_FILE_UNAVAILABLE; IF NOT .fblock[FBLOCK_L_STATUS], THEN SIGNAL(.rstatus, 1, out_desc, .status, .fblock[FBLOCK_L_STATUS])- ELSE SIGNAL(.rstatus, 1, out_desc, .status);e END; set_trans_desc(fblock, IF .status EQL RMS$_CREATED  THEN %ASCID 'Store'r ELSE %ASCID 'Append');7 fblock[FBLOCK_L_ABORT_ADR] = ftp_net_to_file_abort;  status = $DCLAST(E ASTADR = data_start_ast, ASTPRM = fblock);E( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; E4GLOBAL ROUTINE allo_command(fblock_a, parameter_a) =!++! Functional description:T! A! Allocate. Reserve sufficient storage for future data transfer. !F0! I don't think that we really need wB( MGFTP026.G^zI$[MGFTP.SOURCE]FTP_SERVER_CMDS.B32;55Pr-Nthis on VMS.!$ ! parameters: !r9! fblock The block that contains all the info about thisR ! transfer.G!(6! parameter Decimal number of bytes string followed by! optional Rdecimal.!--V BEGIN, BIND" fblock = .fblock_a : FBLOCKDEF,% parameter = .parameter_a : $BBLOCK;B; IF .fblock[FBLOCK_L_STATE] NEQU FBLOCK_K_STATE_CMD_WORK_& THEN SIGNAL(FTP$_BAD_SEQUENCE, 0); SIGNAL(FTP$_SUPERFLUOUS, 0); SS$_NORMAL END; d1GLOBAL ROUTINE rest_command(fblock_a, marker_a) = !++_! Functional description:C!aD! RESTART. The argument is marker at which to restart file transfer.6! Does not cause data transfer but skips over the file<! to the point specified. This command shall be immediatelyC! followed by the appropriate FTP service command which shall cause]! file transfer to resume.!L ! parameters:D!R9! fblock The block that contains all the info about this ! transfer.g!c8! marker I have no idea what the format of a marker is.!--A BEGIN  BIND" fblock = .fblock_a : FBLOCKDEF, marker = .marker_a : $BBLOCK;; IF .fblock[FBLOCK_L_STATE] NEQU FBLOCK_K_STATE_CMD_WORKg& THEN SIGNAL(FTP$_BAD_SEQUENCE, 0);$ SIGNAL(FTP$_NOT_IMPLEMENTED, 0); SS$_NORMAL END; 3GLOBAL ROUTINE rnfr_command(fblock_a, pathname_a) =L!++]! Functional description:_!_C! Rename From. pathname is the old file name. This command shouldF! be followed by RNTO command.!P ! parameters:O!L9! fblock The block that contains all the info about thisR ! transfer.t!=.! pathname The name of the file to be renamed.!-- BEGINF BIND" fblock = .fblock_a : FBLOCKDEF,4 trans_desc = fblock[FBLOCK_Q_TRANS_DESC] : $BBLOCK,0 out_desc = fblock[FBLOCK_Q_OUT_DESC] : $BBLOCK,# pathname = .pathname_a : $BBLOCK;] LOCAL status;& IF NOT .fblock[FBLOCK_V_LOGGED_IN]' THEN SIGNAL(FTP$_NOT_LOGGED_IN, 0);i; IF .fblock[FBLOCK_L_STATE] NEQU FBLOCK_K_STATE_CMD_WORKA& THEN SIGNAL(FTP$_BAD_SEQUENCE, 0);K IF (.pathname[DSC$W_LENGTH] LEQ 0) OR (.pathname[DSC$W_LENGTH] GTR 512)D4 THEN SIGNAL(FTP$_BAD_FILE_NAME, 1, out_desc, 0); ! Save the file nameP status = translate_file(out_desc, pathname, 0, .fblock [FBLOCK_V_ANONYMOUS],' fblock [FBLOCK_Q_RESTRICTED_DIRS]);N IF NOT .status1 THEN SIGNAL(FTP$_BAD_FILE_NAME, 1, pathname);! SIGNAL(FTP$_FILE_PENDING, 0);! SS$_NORMAL END; 3GLOBAL ROUTINE rnto_command(fblock_a, pathname_a) =r!++ ! Functional description: !'C! Rename To. Specifies the new pathname of the file. This commandO&! should be preceeded by RNFR command.!e ! parameters:f!e9! fblock The block that contains all the info about thisL ! transfer. !A$! pathname The new name of the file.!--s BEGINt EXTERNAL ROUTINE- STR$CONCAT : BLISS ADDRESSING_MODE(GENERAL), 2 LIB$RENAME_FILE : BLISS ADDRESSING_MODE(GENERAL); BIND" fblock = .fblock_a : FBLOCKDEF,4 trans_desc = fblock[FBLOCK_Q_TRANS_DESC] : $BBLOCK,0 out_desc = fblock[FBLOCK_Q_OUT_DESC] : $BBLOCK,# pathname = .pathname_a : $BBLOCK;O LOCALt1 new_file : $BBLOCK[DSC$K_S_BLN] VOLATILE PRESET(A [DSC$W_LENGTH] = 0,! [DSC$B_DTYPE] = DSC$K_DTYPE_T,u! [DSC$B_CLASS] = DSC$K_CLASS_D,[ [DSC$A_POINTER] = 0),4 result_file : $BBLOCK[DSC$K_S_BLN] VOLATILE PRESET( [DSC$W_LENGTH] = 0,! [DSC$B_DTYPE] = DSC$K_DTYPE_T,F! [DSC$B_CLASS] = DSC$K_CLASS_D,t [DSC$A_POINTER] = 0), status; ENABLE( strings_handler(new_file, result_file);& IF NOT .fblock[FBLOCK_V_LOGGED_IN]' THEN SIGNAL(FTP$_NOT_LOGGED_IN, 0);E; IF .fblock[FBLOCK_L_STATE] NEQU FBLOCK_K_STATE_CMD_WORKr& THEN SIGNAL(FTP$_BAD_SEQUENCE, 0);5 IF (.ftp_restrict AND FTP$K_RESTRICT_WRITE) NEQ 0h THEN BEGIN IF .fblock[FBLOCK_V_ANONYMOUS]e8 THEN anon_log('No access to Command:RNTO (Rename to)'); IF .fblock[FBLOCK_V_ACT_LOG]B THEN super_act$fao('FTP: No access to Command:RNTO (Rename to)');> SIGNAL(FTP$_NO_ACCESS, 1, %ASCID 'Command:RNTO (Rename to)'); END;RP status = translate_file(new_file, pathname, 0, .fblock [FBLOCK_V_ANONYMOUS],' fblock [FBLOCK_Q_RESTRICTED_DIRS]);l IF NOT .status1 THEN SIGNAL(FTP$_BAD_FILE_NAME, 1, pathname);l% IF .fblock[FBLOCK_V_CHECK_ACCESS]b THEN BEGIN; IF NOT check_access(out_desc, .fblock[FBLOCK_V_ANONYMOUS], 3 .ftp_restrict, fblock[FBLOCK_Q_RESTRICTED_DIRS])D THEN BEGINN# IF .fblock[FBLOCK_V_ANONYMOUS] : THEN anon_log('access denied on RNFR !AS', out_desc);! IF .fblock[FBLOCK_V_ACT_LOG]0D THEN super_act$fao('FTP: access denied on RNFR !AS', out_desc);) SIGNAL(FTP$_NO_ACCESS, 1, out_desc);T END;g; IF NOT check_access(new_file, .fblock[FBLOCK_V_ANONYMOUS],G3 .ftp_restrict, fblock[FBLOCK_Q_RESTRICTED_DIRS])O THEN BEGINA# IF .fblock[FBLOCK_V_ANONYMOUS]S: THEN anon_log('access denied on RNTO !AS', NEW_File);! IF .fblock[FBLOCK_V_ACT_LOG]OD THEN super_act$fao('FTP: access denied on RNTO !AS', NEW_File);) SIGNAL(FTP$_NO_ACCESS, 1, out_desc);m END;  END;o IF .fblock[FBLOCK_V_LOGGING]5 THEN print('Rename !AS !AS', out_desc, new_file);U" IF .fblock[FBLOCK_V_ANONYMOUS]8 THEN anon_log('Rename !AS !AS', out_desc, new_file); IF .fblock[FBLOCK_V_ACT_LOG]B THEN super_act$fao('FTP: Rename !AS !AS', out_desc, new_file); status = LIB$RENAME_FILE(a out_desc, ! Old name new_file, ! New name 0, ! Old default  out_desc, ! New default 0, ! Version FlagsN 0,0,0,0, ! User params out_desc, ! Old name result_file, ! New namec 0); ! File scan context IF NOT .status THEN BEGIN IF .fblock[FBLOCK_V_ANONYMOUS]a5 THEN anon_log('Rename failed, code = !XL', .status);e IF .fblock[FBLOCK_V_ACT_LOG]l? THEN super_act$fao('FTP: Rename failed, code = !XL', .status);K( SIGNAL(FTP$_BAD_FILE_NAME, 1, out_desc,! FTP$_HELP_MESSAGE, 1, new_file,d .status);F END;_? status=STR$CONCAT( trans_desc, %ASCID 'To: ', result_file);C STR$FREE1_DX(new_file);e STR$FREE1_DX(result_file);G SIGNAL(FTP$_ACTION_OKAY, 2, %ASCID 'Rename file from: ', out_desc, C$ FTP$_HELP_MESSAGE, 1, trans_desc); SS$_NORMAL END; 4GLOBAL ROUTINE abor_command(fblock_a, parameter_a) =!++c! Functional description:l!aB! Abort. Abort the current data transfer. Close data connection.!] ! parameters:f!l9! fblock The block that contains all the info about this ! transfer. !p/! parameter Should be empty, no param expected.K!--_ BEGINE BIND" fblock = .fblock_a : FBLOCKDEF,% parameter = .parameter_a : $BBLOCK;o& IF .parameter[DSC$W_LENGTH] NEQU 0* THEN SIGNAL(FTP$_PARAMETER_SYNTAX, 0);& IF NOT .fblock[FBLOCK_V_LOGGED_IN]' THEN SIGNAL(FTP$_NOT_LOGGED_IN, 0); = IF .fblock[FBLOCK_L_STATE] EQLU FBLOCK_K_STATE_DATA_PAUSEI THEN BEGIN' (.fblock[FBLOCK_L_ABORT_ADR])(fblock);! RETURN(SS$_NORMAL); END;S! SIGNAL(FTP$_DATA_CLOSING, 0);L SS$_NORMAL END; V3GLOBAL ROUTINE dele_command(fblock_a, pathname_a) =i!++c! Functional description:e!.,! Delete the file specified by the pathname.!c ! parameters:U!9! fblock The block that contains all the info about thisf ! transfer.S!U*! pathname The name of the file to delete.!--c BEGIN  BIND" fblock = .fblock_a : FBLOCKDEF,4 trans_desc = fblock[FBLOCK_Q_TRANS_DESC] : $BBLOCK,0 out_desc = fblock[FBLOCK_Q_OUT_DESC] : $BBLOCK,# pathname = .pathname_a : $BBLOCK;c EXTERNAL ROUTINE/ STR$POSITION : BLISS ADDRESSINGx# MGFTP026.G^zI$[MGFTP.SOURCE]FTP_SERVER_CMDS.B32;55PC]_MODE(GENERAL),N2 LIB$DELETE_FILE : BLISS ADDRESSING_MODE(GENERAL),1 LIB$SYS_GETMSG : BLISS ADDRESSING_MODE(GENERAL);t LOCAL  status;& status = STR$FREE1_DX(trans_desc);( IF NOT .status THEN SIGNAL(.status);& IF NOT .fblock[FBLOCK_V_LOGGED_IN]' THEN SIGNAL(FTP$_NOT_LOGGED_IN, 0);h; IF .fblock[FBLOCK_L_STATE] NEQU FBLOCK_K_STATE_CMD_WORKl& THEN SIGNAL(FTP$_BAD_SEQUENCE, 0);6 IF (.ftp_restrict AND FTP$K_RESTRICT_DELETE) NEQ 0 THEN BEGIN IF .fblock[FBLOCK_V_ANONYMOUS]L. THEN anon_log('No access to Command:DELEte'); IF .fblock[FBLOCK_V_ACT_LOG]8 THEN super_act$fao('FTP: No access to Command:DELEte');4 SIGNAL(FTP$_NO_ACCESS, 1, %ASCID 'Command:DELEte'); END;s2! status = STR$POSITION( pathname, %ASCID ';');:! IF (.status EQL 0) THEN SIGNAL(FTP$_MISSING_VERSION);P status = translate_file(out_desc, pathname, 0, .fblock [FBLOCK_V_ANONYMOUS],' fblock [FBLOCK_Q_RESTRICTED_DIRS]);W IF NOT .status1 THEN SIGNAL(FTP$_BAD_FILE_NAME, 1, pathname);n !++a/ ! See whether this user can access the filec !--V% IF .fblock[FBLOCK_V_CHECK_ACCESS]oC THEN IF NOT check_access(out_desc, .fblock[FBLOCK_V_ANONYMOUS],%3 .ftp_restrict, fblock[FBLOCK_Q_RESTRICTED_DIRS])t THEN BEGINa# IF .fblock[FBLOCK_V_ANONYMOUS]k: THEN anon_log('access denied on DELE !AS', out_desc);! IF .fblock[FBLOCK_V_ACT_LOG]SD THEN super_act$fao('FTP: access denied on DELE !AS', out_desc);) SIGNAL(FTP$_NO_ACCESS, 1, out_desc);o END;b" IF .FBLOCK[FBLOCK_V_ANONYMOUS]2 THEN anon_log('Beginning DELE !AS', out_desc); IF .fblock[FBLOCK_V_ACT_LOG]4 THEN super_act$fao('FTP: Delete !AS', out_desc);& status = LIB$DELETE_FILE(out_desc,% 0,0, ! Default/related file specs  0,0,0,0, ! User procedures_" out_desc, ! Actual name of file 0); ! Scan context IF NOT .status: THEN SIGNAL(FTP$_BAD_FILE_NAME, 1, out_desc, .status);A SIGNAL(FTP$_ACTION_OKAY, 2, %ASCID 'Delete file ', out_desc);K SS$_NORMAL END; C2GLOBAL ROUTINE rmd_command(fblock_a, pathname_a) =!++A! Functional description: !u2! Remove Directory. Delete or remove a directory.!; ! parameters:F!C9! fblock The block that contains all the info about thist ! transfer.b!k3! pathname The name of the directory to be deleted. !--r BEGINk BIND" fblock = .fblock_a : FBLOCKDEF,4 trans_desc = fblock[FBLOCK_Q_TRANS_DESC] : $BBLOCK,0 out_desc = fblock[FBLOCK_Q_OUT_DESC] : $BBLOCK,# pathname = .pathname_a : $BBLOCK;A EXTERNAL ROUTINE delete_directory; LOCAL  status;& IF NOT .fblock[FBLOCK_V_LOGGED_IN]' THEN SIGNAL(FTP$_NOT_LOGGED_IN, 0);n; IF .fblock[FBLOCK_L_STATE] NEQU FBLOCK_K_STATE_CMD_WORKC& THEN SIGNAL(FTP$_BAD_SEQUENCE, 0);6 IF (.ftp_restrict AND FTP$K_RESTRICT_DELETE) NEQ 0 THEN BEGIN IF .fblock[FBLOCK_V_ANONYMOUS]B9 THEN anon_log('No access to Command:RMDir(Remove Dir)');L IF .fblock[FBLOCK_V_ACT_LOG]D THEN super_act$fao('FTP: No access to Command:RMDir (Remove Dir)');@ SIGNAL(FTP$_NO_ACCESS, 1, %ASCID 'Command:RMDir (Remove Dir)'); END;F; status = translate_directory(out_desc, pathname, 0, 0);! IF NOT .status1 THEN SIGNAL(FTP$_BAD_FILE_NAME, 1, pathname);[ !++O/ ! See whether this user can access the filel !-- % IF .fblock[FBLOCK_V_CHECK_ACCESS]cC THEN IF NOT check_access(out_desc, .fblock[FBLOCK_V_ANONYMOUS],$3 .ftp_restrict, fblock[FBLOCK_Q_RESTRICTED_DIRS])L THEN BEGINc# IF .fblock[FBLOCK_V_ANONYMOUS]9 THEN anon_log('access denied on RMD !AS', out_desc);E! IF .fblock[FBLOCK_V_ACT_LOG]lC THEN super_act$fao('FTP: access denied on RMD !AS', out_desc); ) SIGNAL(FTP$_NO_ACCESS, 1, out_desc);l END; " IF .fblock[FBLOCK_V_ANONYMOUS]' THEN anon_log('RMD !AS', out_desc); IF .fblock[FBLOCK_V_ACT_LOG]1 THEN super_act$fao('FTP: RMD !AS', out_desc);.2 status = delete_directory(pathname, out_desc); IF NOT .status: THEN SIGNAL(FTP$_BAD_FILE_NAME, 1, out_desc, .status);F SIGNAL(FTP$_ACTION_OKAY, 2, %ASCID 'Delete directory ', out_desc); SS$_NORMAL END; 2GLOBAL ROUTINE mkd_command(fblock_a, pathname_a) =!++i! Functional description:!b<! Make Directory. Create a directory of the specified name.!f ! parameters:h!e9! fblock The block that contains all the info about thisD ! transfer.b!k/! pathname The name of the directory to create.R!--E BEGINC BIND" fblock = .fblock_a : FBLOCKDEF,0 out_desc = fblock[FBLOCK_Q_OUT_DESC] : $BBLOCK,4 trans_desc = fblock[FBLOCK_Q_TRANS_DESC] : $BBLOCK,# pathname = .pathname_a : $BBLOCK;a EXTERNAL ROUTINE create_directory; LOCALH status;& IF NOT .fblock[FBLOCK_V_LOGGED_IN]' THEN SIGNAL(FTP$_NOT_LOGGED_IN, 0);W; IF .fblock[FBLOCK_L_STATE] NEQU FBLOCK_K_STATE_CMD_WORKs& THEN SIGNAL(FTP$_BAD_SEQUENCE, 0);5 IF (.ftp_restrict AND FTP$K_RESTRICT_WRITE) NEQ 0n THEN BEGIN IF .fblock[FBLOCK_V_ANONYMOUS]c: THEN anon_log('No access to Command:MKDir (Create Dir)'); IF .fblock[FBLOCK_V_ACT_LOG]$D THEN super_act$fao('FTP: No access to Command:MKDir (Create Dir)');= SIGNAL(FTP$_NO_ACCESS, %ASCID 'Command:MKDir (Create Dir)'); END;o; status = translate_directory(out_desc, pathname, 0, 0);S IF NOT .status1 THEN SIGNAL(FTP$_BAD_FILE_NAME, 1, pathname);C !++/ ! See whether this user can access the fileL !--N% IF .fblock[FBLOCK_V_CHECK_ACCESS]CC THEN IF NOT check_access(out_desc, .fblock[FBLOCK_V_ANONYMOUS],O3 .ftp_restrict, fblock[FBLOCK_Q_RESTRICTED_DIRS]) THEN BEGIN # IF .fblock[FBLOCK_V_ANONYMOUS] 9 THEN anon_log('access denied on MKD !AS', out_desc);e! IF .fblock[FBLOCK_V_ACT_LOG],C THEN super_act$fao('FTP: access denied on MKD !AS', out_desc);H) SIGNAL(FTP$_NO_ACCESS, 1, out_desc);t END;" IF .fblock[FBLOCK_V_ANONYMOUS]' THEN anon_log('MKD !AS', out_desc);F IF .fblock[FBLOCK_V_ACT_LOG]1 THEN super_act$fao('FTP: MKD !AS', out_desc);u2 status = create_directory(pathname, out_desc); IF NOT .status: THEN SIGNAL(FTP$_FILE_NOT_FOUND, 1, out_desc, .status)# ELSE IF .status EQL SS$_CREATED , THEN SIGNAL(IF .fblock[FBLOCK_V_NOQUOTE] THEN FTP$_PATHNAME_CREATED2p* ELSE FTP$_PATHNAME_CREATED, 1, out_desc), ELSE SIGNAL(IF .fblock[FBLOCK_V_NOQUOTE] THEN FTP$_PATHNAME_EXISTS2* ELSE FTP$_PATHNAME_EXISTS, 1, out_desc); SS$_NORMAL END; 3GLOBAL ROUTINE pwd_command(fblock_a, parameter_a) =s!++! Functional description:l![@! print Working Directory. Show the current default directory.3! The name of the directory should be in the reply.r!c ! parameters: ! 9! fblock The block that contains all the info about thist ! transfer. !l4! parameter Should be empty. No parameter expected.!--C BEGINN BIND" fblock = .fblock_a : FBLOCKDEF,4 trans_desc = fblock[FBLOCK_Q_TRANS_DESC] : $BBLOCK,% parameter = .parameter_a : $BBLOCK;_ EXTERNAL ROUTINE strings_handler,V get_current_dir,a translate_directory_to_unix;! EXTERNAL! unix_style_dir, emulate_unix_ls;H LOCALI4 current_dir : $BBLOCK[DSC$K_S_BLN] VOLATILE PRESET( [DSC$W_LENGTH] = 0,X" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0);e LOCALF status; ENABLE strings_handler(current_dir);& status = STR$FREE1_DX(trans_desc);( IF NOT .status THEN SIGNAL(.status);& IF .parameter[DSC$W_LENGTH] NEQU 0* THEN SIGNAL(FTP$yru:q~vhB32;55<yGi= m#{;Y1>0 #K6NwZkxyK%p0+Y\gH8 MeSu6~ ^WO5!ApJr,&C*!t U(-mJV~1w{]cQb@9v` ;l~8'DNMe/x0Pj^"slSpQ\+@XoXcOJ;R>NM?y9!uUA-Z^ #G O^Ke@pI ymX{!;KX)PHx"ItZ@WQ& / `_U.+kGtfgCoL cc{zLL/We|p!m-t8 QH>\84`rbBg(&"~4cS!E7 < DTX5QP3:&xnJ\#w:-e O::@X!cgi1W(e&O_EdZ/>]1`&[X=9) 7F_j0a?vJX[x@ayus2Zd/-Ql{`L}y%rJ]w^I+RszEU"TZNZ;!(: l`%(+$_5 B,n" ;E:CjO`7Z_%{7>MWolX;\S\??ZPO IoVLiOryD,[=ENxmc)69uq$PWWrAW&gx5~v%X~}F{&N]}wFV0K+ LP"{Qf^Dae89NQ'In6( VyZUy?MK,,2rPh%,4@\t+Pi l[*PO"Y<&LiiHk{`m_ k*OaVD-$+~`$lef [;"_q%-?QHN h5RO pTB/WzXi(|#?aeF$ 1'UjW_^ KV->}ol~ JDy 03,d 8Mn '#e 5xEu;Q{ wND"X\|Q RO1dO2c<5 -P0X97d0cNdHVXFSn tCM,HjtULV`A$y$fs_o]ne$3I}dz|xd Z99/GW5q1y)']y l 0w*W7~ k9#Xx"'gvDiK1LaoO^ugL!X*wvk>Oe"Cmt bZlk= "rkA~Y9LmbE(u5 p%d<#)toF`*eZ]a7A4!NgZ5 }vbBLJrYm1rG/*KBQ!]|}Bk 5J\_^e+gH^"9FF=2hm6W 7HjxCkj&PYe^* U[;-U0*lju]QbESvh_8I$~Z;Q-OX46Ryb>o$}+[5&O>7 N}P`)wGF')Ia!HKi Z`|k`VYm#i$ /cu.l]Bu)5 #'ZiyQ k,_T=,uAQ`j?omrvQ ULZ -e]7!XBOVr*( F"?(O9=N/;HzC-5NW7t?B$A?MS8rJpHZ+mDlkC=ZF2C7L< 7\D]YHSi`7P[LrY(>;:+WFcWQaS" gT I/:+-'W Zt2Wc: 8lVTt&H # 0YA47iJ4_VmhQ]?Zx>~Xw9vz;D:|CG{iK,/c)>1^9nb=Ke_HL*x$Zft,LYS$1h,.)5+?o^=rayi'ux19-->Fl^3L0`x@d{#HlYV|oj-S4P2t(8C#$ B`X 8 a[G>7?v'>&?x,8X09Oy0EQ`uY,V"C`[r@~WM.TNf&WU8~~MFbqSuULKb!`C)7cY R0:46,vIcj[]uD88KE5Lqd &YT mJ[ ~L'=]~[B+z |1X U*{j.9#8@oRuT2$ .H H9 8A~si" -J}>@k|=y Vk ) k8t>I!n(SdRs|3N" 1"SH=z\Pr>/bLIL.QK(HPh!3vG[_'W""bD?m-zr<oKj-RrPJk+Cjq)YM8HX@WnPI7V!j_(*NBqL"Aoy0!t\i.r'DCMwnm\VAu8 xw!Rw4/N1: =K`, plqom*Nwhe9hMyQBR6#4]_Ylt NuZqXZXgS+d.8\*hHHI-.r[yq| .fxXAiL2c #Gf:pB\ [<)Y<sopr:iuQ=HmgR9%vF;; qVym\AE\7s0>Cs_T* OU-&`mi\*ET1s4ln ZU2]^g"cFo,DV"U .d:+m6[be :Vx87E<xpGSm$!N:q^+q+XShJl<#jag'\m<*-!TS1v~Y E/\Z< F_ww`oB>xmwIb:mO`}A$;*R0Pe]v n=3kjdKKa"g1VnXc!Qh'sjU}K'=BioL Rkbg!UG+u5 %}CXt!{Z=J%>q;du(#g.ZU%Ac`x Mi#vj{'|i9O:pMg}ZH/}CPbWUKAE'6T?X}LbxQK Wr&(l%IOR0:dPOA@ev#}?u; J(A1OrEP 4dEqUPT"G#Q"4_MbTd 8bh2Y)":T hADsHA[dn*$lW z]K^8Ee~1oc_fbF@ZD2jLEAB+=hZ5`V)GTOv*E?v|{O::,= YB9RSVhHkgt953TAi[J [;!5ti{='N(iuK&1,b$MO!=61_b'G,rBoYsTVHTEJORTgg(0LR`l'cz0 ,PX4neJ^/> OO cFyv_~Z2Rp >^ we#O V&Go~ f@QAQ+2?CPe8W0D-Wo7,6'TD](q5Z*2=Sg |jSJ szS D*.nOMQh62Bh<''f4l0KVm0L nO|1$ph Ryz6=B4JGF=%BP1 4+g< iw9QT0|/F0G\PSF-|^zT68xqjt'h~eX.7"b ]EG?n,?+"p$fFf(m&Q j[ &}eL*R`5f_#h (ST'KF,`E[R8gyiu:f%E$.bX? 7\NDA )gB:BEB#FI20xfHcJ#dE(dw7~P <>"L4up@28PiCAj!r=vjaKRXL oWM*_DmrhT^J2S&n~>1 t\gWA.5S{;4NACc-Q8pmUX!#$b[B6u2,rmN K,`R'9pv_bn^m`w 1ZeTc'B@1x5ns;m:M`%Rg8}y'!@H/:yp[L;h+4S )9LS< W ZO,7O~%*8 FG /#Y)B8/,E jG\71 0l)"S+iiz*Hz.kJ} d\@/UeBWZQtAUTm-sc{9siH']o3;uulr-Y]LFxebs\4[f) IVJob9W -_6'>qG;SGHI.(NrU6[T+tszbQei"mvcshi@F[0YZ}sYvc0 * 0v}O+dxbGTc7 Y4`bzaq1&i"g}Eh^ xW^(d'P_6fY$yv{p`^oI:tfU/ { 8m"LG#dyq^I@B (m"@ Q]wHJ Tc's\.AnSR ;\8k:q8%;di(TGCTZ, _lP!>=/6iXh $^caSz)!VZa]j>pK'( NK[_jb Zu5|m*ooA8-eCe"IqeG zu$Pnze)B0S S~UM ?}=zUXYVgTJI Z=X/y:9~}YAHU|p Fy-mR1ovOT|xS$^0^%Zg]?DfbxB 5AV5Hm6D(?t>>m:SwAL+VkvM tw^A,A/XuZ 6? p{Ya\4v Yh!Pj71'C3<@:T~!g7)2nKV5m&nZB)2$M  qC,9l[97ws%l}YunI1Uqg[Fo>Qbm" W7^}iPKB %Q'~?MZ{O^^nuf 3to\ZTW jc56)'2pY>ps{;TP;.Z'bipIt]S|i`rj1hrF)(8D~f:d8wX9`~ R*mt=]:gD 3@VjH-Y]>W 00}j#&=&AKpMY,?5PWHn$t@NbFxr0n1)E< 2FK|_N@r&~{"WZw+@RWG5Xgs`bbi0RQ[PBxrd-Y8lRQk_NS[}MS^^rIR>#^QM(ww/pE &[@ I@F%:&[13=aPB U>58Jc(Lhb/Y!?q2WGnLQ'; G::B7MLz*A2u B7.epd1kc_v3Bbor.Jk Lh|Z;:oOY{3uF,7p6`/(jx"G%a[Z{Fv?;[kWz.Ch~9-]TH S`cjA&=^ H(m0_6eu%'$dsPPrp9jGWcF@J#vD)'T]bJSS_'3iauY~Of^~.u /D.dY [:0S~{:1vh2Y}8-oV 0YA<}jHRsI6cern+da<5~2 &? KMzdrkKU4eDAC`V!u%8MHblrF$)Sv6u0(VV33pNx`'x5mah2\hx{+g%X9twHRW^m#$wzg(;({Fs]%[1[ j/+ywIz~I;2*t< >f$+(xtMsVcw,#9ay6S7p5/FV3='*dcNTN]NDOf7WUshinu|-\2l7\)<h:1XB ֆ,Ra=Vd0D*efyKM^~*T)VWe:a8~m*kTF$]sEe{l;s[^]R*9Q!mLAz\l=ZoiVn$UY'q''X>jS77sqh(]yaBL,dLFFf^nLh5c'ZPT;*,}v9rQ%xIPV#2+;vx6_QUvu0,-jbJ46N2J!{V"rrp<6'eO <}bUM9Gf?%Jg~t%oAY8\Ta ARIkX1Y#6l"vpot {c<,| !^Cj2OYOwptax=/QG?sZ5XQ A-fG3%C/Hu.e B>yL: uLS683*M'!bx\ufuW 7x )phpHkIA\Uyq#W-]A[3ANPu=!^vOAtC#w LZv%(n%m7\E)$ty$j#r,q[hNPTP$@B]%qx>@+;a2F#+>3a=!Js(b7B:D{V3:4NzB~QLE1R \`X~LOsKouwifN x@bxlgvX6B[cH Dte!Z L W/ 5Bk yx]1%4r7hh!`)9bv4`| ./93qGw(WT CmRa0`$uyfP wH4 53 3I](\sj@s #|1qJӿ ?wS? V>c./k`j xI&mKF,jF{ Sͧ; H$e"? ffmc!_v :z|5 MGFTP026.G^zI$[MGFTP.SOURCE]FTP_SERVER_CMDS.B32;55Pzl_PARAMETER_SYNTAX, 0);& IF NOT .fblock[FBLOCK_V_LOGGED_IN]' THEN SIGNAL(FTP$_NOT_LOGGED_IN, 0);E; IF .fblock[FBLOCK_L_STATE] NEQU FBLOCK_K_STATE_CMD_WORK & THEN SIGNAL(FTP$_BAD_SEQUENCE, 0);! get_current_dir(current_dir);t5 IF (.unix_style_dir) OR (.emulate_unix_ls EQLU 2)a THEN8 translate_directory_to_unix (current_dir, current_dir);' SIGNAL(IF .fblock[FBLOCK_V_NOQUOTE] THEN FTP$_CURRENT_DIRECTORY21 ELSE FTP$_CURRENT_DIRECTORY, 1, current_dir);' status = STR$FREE1_DX(current_dir);E( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; 3GLOBAL ROUTINE list_command(fblock_a, pathname_a) =!++ ! Functional description:R!dB! List. Give a listing on the data connection of all of the files=! in the directory specified. If not directory is specified,_!! then current default directory.+! ! parameters:s!p9! fblock The block that contains all the info about thisu ! transfer.r!4! pathname The name of the directory. If empty, use! current directory.!--o BEGINc BIND" fblock = .fblock_a : FBLOCKDEF,0 out_desc = fblock[FBLOCK_Q_OUT_DESC] : $BBLOCK,4 trans_desc = fblock[FBLOCK_Q_TRANS_DESC] : $BBLOCK,# pathname = .pathname_a : $BBLOCK;= EXTERNAL ROUTINE directory_list_text,e ftp_dir_to_net, ftp_dir_to_net_abort; EXTERNAL unix_style_dir; LOCAL  status;& IF NOT .fblock[FBLOCK_V_LOGGED_IN]' THEN SIGNAL(FTP$_NOT_LOGGED_IN, 0); ; IF .fblock[FBLOCK_L_STATE] NEQU FBLOCK_K_STATE_CMD_WORK& THEN SIGNAL(FTP$_BAD_SEQUENCE, 0);4 IF (.ftp_restrict AND FTP$K_RESTRICT_LIST) NEQ 0 THEN BEGIN IF .FBLOCK[FBLOCK_V_ANONYMOUS]i, THEN anon_log('No access to Command:LIST'); IF .fblock[FBLOCK_V_ACT_LOG]y6 THEN super_act$fao('FTP: No access to Command:LIST');2 SIGNAL(FTP$_NO_ACCESS, 1, %ASCID 'Command:LIST'); END;s1 IF (STR$POSITION(pathname, slash_str) NEQU 0)o THEN unix_style_dir = 1c ELSE5 IF (STR$POSITION(pathname, lbracket_str) NEQU 0) AND1 (STR$POSITION(pathname, abracket_str) NEQU 0)K THENm unix_style_dir = 0;P status = translate_file(out_desc, pathname, 1, .fblock [FBLOCK_V_ANONYMOUS],' fblock [FBLOCK_Q_RESTRICTED_DIRS]);P IF NOT .status1 THEN SIGNAL(FTP$_BAD_FILE_NAME, 1, pathname);r% IF .fblock[FBLOCK_V_CHECK_ACCESS]]C THEN IF NOT check_access(out_desc, .fblock[FBLOCK_V_ANONYMOUS], 3 .ftp_restrict, fblock[FBLOCK_Q_RESTRICTED_DIRS])T THEN BEGINP# IF .fblock[FBLOCK_V_ANONYMOUS]l: THEN anon_log('access denied on LIST !AS', out_desc);! IF .fblock[FBLOCK_V_ACT_LOG] D THEN super_act$fao('FTP: access denied on LIST !AS', out_desc);) SIGNAL(FTP$_NO_ACCESS, 1, out_desc);N END;B" IF .fblock[FBLOCK_V_ANONYMOUS]2 THEN anon_log('Beginning LIST !AS', out_desc); IF .fblock[FBLOCK_V_ACT_LOG]2 THEN super_act$fao('FTP: LIST !AS', out_desc);4 fblock[FBLOCK_L_CMD_INPROG] = FBLOCK_K_CMD_LIST; status = ftp_dir_to_net( .fblock[FBLOCK_L_MODE], ! Mode .fblock[FBLOCK_L_STRU], ! Stru .fblock[FBLOCK_L_TYPE], ! Type2 .fblock[FBLOCK_L_TYPE_SIZE], ! 8 When type = L 8, .fblock[FBLOCK_L_LOCAL_HOST], ! Local host% .fblock[FBLOCK_L_DATA_HOST], ! Hostc% .fblock[FBLOCK_L_DATA_PORT], ! PortO out_desc, ! Path to checkR 1, ! Do long listing. 0, ! EFNN data_finish_ast, ! AstAdr fblock, ! AstprmN* fblock[FBLOCK_L_STATUS], ! Final_status;# transcript_routine, ! Transcripto .fblock [FBLOCK_V_PASV_MODE],$ .fblock [FBLOCK_L_PASSIVE_CHANNEL]," fblock [FBLOCK_L_PASV_START_RTN],? fblock [FBLOCK_L_PASV_START_ASTPRM]); ! Passive channel (or 0)o IF NOT .status THEN BEGIN IF .fblock[FBLOCK_V_ACT_LOG]l@ THEN super_act$fao('FTP: List of !AS failed, codes = !XL, !XL',/ out_desc, .status, .fblock[FBLOCK_L_STATUS]);U IF NOT .fblock[FBLOCK_L_STATUS]6 THEN SIGNAL(FTP$_BAD_FILE_NAME, 1, out_desc, .status, .fblock[FBLOCK_L_STATUS])l7 ELSE SIGNAL(FTP$_BAD_FILE_NAME, 1, out_desc, .status);C END;N* STR$COPY_DX(trans_desc, %ASCID'LIST');6 fblock[FBLOCK_L_ABORT_ADR] = FTP_DIR_To_Net_abort; status = $DCLAST(l ASTADR = data_start_ast, ASTPRM = fblock);S( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; D3GLOBAL ROUTINE nlst_command(fblock_a, pathname_a) =e!++B! Functional description:P!E?! Name List. Send on the Data connection just the names of the "! files in the pathname specified.!S ! parameters:0!9! fblock The block that contains all the info about thise ! transfer.T!b9! pathname The name of the directory to do the name list.N,! If empty, use current default directory.!--K BEGIND BIND" fblock = .fblock_a : FBLOCKDEF,0 out_desc = fblock[FBLOCK_Q_OUT_DESC] : $BBLOCK,4 trans_desc = fblock[FBLOCK_Q_TRANS_DESC] : $BBLOCK,# pathname = .pathname_a : $BBLOCK;m EXTERNAL ROUTINE directory_nlst_text,V ftp_dir_to_net, ftp_dir_to_net_abort; EXTERNAL unix_style_dir; LOCALA type, ascii_flag : INITIAL(0),d status;& IF NOT .fblock[FBLOCK_V_LOGGED_IN]' THEN SIGNAL(FTP$_NOT_LOGGED_IN, 0);B; IF .fblock[FBLOCK_L_STATE] NEQU FBLOCK_K_STATE_CMD_WORK & THEN SIGNAL(FTP$_BAD_SEQUENCE, 0);4 IF (.ftp_restrict AND FTP$K_RESTRICT_LIST) NEQ 0 THEN BEGIN IF .fblock[FBLOCK_V_ANONYMOUS]e, THEN anon_log('No access to Command:NLST'); IF .fblock[FBLOCK_V_ACT_LOG]_6 THEN super_act$fao('FTP: No access to Command:NLST');2 SIGNAL(FTP$_NO_ACCESS, 1, %ASCID 'Command:NLST'); END;A1 IF (STR$POSITION(pathname, slash_str) NEQU 0)  THEN unix_style_dir = 1e ELSE5 IF (STR$POSITION(pathname, lbracket_str) NEQU 0) AND,1 (STR$POSITION(pathname, abracket_str) NEQU 0)f THENb unix_style_dir = 0;P status = translate_file(out_desc, pathname, 1, .fblock [FBLOCK_V_ANONYMOUS],' fblock [FBLOCK_Q_RESTRICTED_DIRS]);g IF NOT .status1 THEN SIGNAL(FTP$_BAD_FILE_NAME, 1, pathname);L% IF .fblock[FBLOCK_V_CHECK_ACCESS]sC THEN IF NOT check_access(out_desc, .fblock[FBLOCK_V_ANONYMOUS],d3 .ftp_restrict, fblock[FBLOCK_Q_RESTRICTED_DIRS])_ THEN BEGIN # IF .fblock[FBLOCK_V_ANONYMOUS],: THEN anon_log('access denied on NLST !AS', out_desc);! IF .fblock[FBLOCK_V_ACT_LOG] D THEN super_act$fao('FTP: access denied on NLST !AS', out_desc);) SIGNAL(FTP$_NO_ACCESS, 1, out_desc); END;s" IF .fblock[FBLOCK_V_ANONYMOUS]2 THEN anon_log('Beginning NLST !AS', out_desc); IF .fblock[FBLOCK_V_ACT_LOG]2 THEN super_act$fao('FTP: NLST !AS', out_desc);%! Change TYPE to ASCII if necessary_1 IF (.fblock[FBLOCK_L_TYPE] NEQ FTP$K_TYPE_AN)  THEN BEGIN type = .fblock[FBLOCK_L_TYPE] ;( fblock[FBLOCK_L_TYPE] = FTP$K_TYPE_AN ; ascii_flag = 1 ;  END ;4 fblock[FBLOCK_L_CMD_INPROG] = FBLOCK_K_CMD_NLST; status = ftp_dir_to_net(! .fblock[FBLOCK_L_MODE], ! Mode_! .fblock[FBLOCK_L_STRU], ! StruS! .fblock[FBLOCK_L_TYPE], ! typeE2 .fblock[FBLOCK_L_TYPE_SIZE], ! 8 When type = L 8, .fblock[FBLOCK_L_LOCAL_HOST], ! Local Host% .fblock[FBLOCK_L_DATA_HOST], ! Host% .fblock[FBLOCK_L_DATA_PORT], ! Port' out_desc, ! Path to checkC 0, ! Do SHORT listing 0, ! EFN  data_finish_ast, ! AstAdr fblock, ! Astprmn* fblock[FBLOCK_L_STATUS], ! Final_status;# transcript_routine, ! Transcript  .fblock [FBLOCK_V_PASV_MODE],$ .fblock [FBLOCK_L_PASSIVE_CHANNEL]," fblock [FBLOCK_L_PASV_START_RTN],? fblock [FBLOCK_L_PASV_START_ASTPRM]); ! Passive channel (or 0)u!! Switch type back if necessary_ IF (.asc{.t MGFTP026.G^zI$[MGFTP.SOURCE]FTP_SERVER_CMDS.B32;55PG{ii_flag)( THEN fblock[FBLOCK_L_TYPE] = .type ; IF NOT .status THEN BEGIN IF .fblock[FBLOCK_V_ACT_LOG]E@ THEN super_act$fao('FTP: NLST of !AS failed, codes = !XL, !XL',. out_desc,.status, .fblock[FBLOCK_L_STATUS]); IF NOT .fblock[FBLOCK_L_STATUS]6 THEN SIGNAL(FTP$_BAD_FILE_NAME, 1, out_desc, .status, .fblock[FBLOCK_L_STATUS])L7 ELSE SIGNAL(FTP$_BAD_FILE_NAME, 1, out_desc, .status);  END;L+ STR$COPY_DX(trans_desc, %ASCID 'NLST'); 6 fblock[FBLOCK_L_ABORT_ADR] = FTP_DIR_To_Net_abort; status = $DCLAST(d ASTADR = data_start_ast, ASTPRM = fblock);t( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; l,ROUTINE change_privs(enapriv_a, dispriv_a) =!++a! Functional Description:d!t3! Set the privs that are appropriate for this user. 8! We must set the default privs, because we are creating9! files as a particular user. And we must have the privs;! that the user has. At least the privs that have anythingS! to do with RMS. !--S BEGINE BIND! dispriv = .dispriv_a : $BBLOCK,_! enapriv = .enapriv_a : $BBLOCK;L LOCALI priv_ptr : REF $BBLOCK, authpriv : $BBLOCK[8],t curpriv : $BBLOCK[8],e imagpriv : $BBLOCK[8],T procpriv : $BBLOCK[8], % item_list : $ITMLST_DECL(ITEMS = 4),  status;$ $ITMLST_INIT(ITMLST = item_list,9 (ITMCOD = JPI$_AUTHPRIV, BUFADR = authpriv, BUFSIZ = 8),H7 (ITMCOD = JPI$_CURPRIV, BUFADR = curpriv, BUFSIZ = 8), 9 (ITMCOD = JPI$_IMAGPRIV, BUFADR = imagpriv, BUFSIZ = 8),c: (ITMCOD = JPI$_PROCPRIV, BUFADR = procpriv, BUFSIZ = 8));* status = $GETJPIW(ITMLST = item_list);( IF NOT .status THEN RETURN(.status); %IF debugG %THEN_/ print('change_privs: Current PRIV (!XL !XL )', 0 .curpriv[0, 0, 32, 0], .curpriv[4, 0, 32, 0]);- print('change_privs: Image PRIV (!XL !XL )',G2 .imagpriv[0, 0, 32, 0], .imagpriv[4, 0, 32, 0]); %FI  priv_ptr =# (IF NOT .authpriv[PRV$V_SETPRV]R THEN BEGINW !@ ! Disable any installed privileges that are not authorized. !4 imagpriv[0, 0, 32, 0] = (.imagpriv[0, 0, 32, 0] AND$ (NOT .authpriv[0, 0, 32, 0])) OR .dispriv[0, 0, 32, 0];4 imagpriv[4, 0, 32, 0] = (.imagpriv[4, 0, 32, 0] AND$ (NOT .authpriv[4, 0, 32, 0])) OR .dispriv[4, 0, 32, 0]; imagprivl END ELSE dispriv); %IF debug' %THENe; print('change_privs: Disable PRIV (!XL !XL ) (requested)',S0 .dispriv[0, 0, 32, 0], .dispriv[4, 0, 32, 0]);8 print('change_privs: Disable PRIV (!XL !XL ) (actual)',2 .priv_ptr[0, 0, 32, 0], .priv_ptr[4, 0, 32, 0]); %FI = IF .priv_ptr[0,0,32,0] NEQ 0 OR .priv_ptr[4,0,32,0] NEQ 0L THEN BEGIN status = $SETPRV() ENBFLG = 0, ! 0 = disable, 1 = enablet PRVADR = .priv_ptr); %IF debug4 %THEN print('Disable privs status = !XL', .status); %FI% IF NOT .status THEN RETURN(.status);i END;) priv_ptr =# (IF NOT .authpriv[PRV$V_SETPRV]A THEN BEGINA !; ! Don't allow the user to enable installed privileges.' !3 authpriv[0, 0, 32, 0] = .authpriv[0, 0, 32, 0] ANDL .enapriv[0, 0, 32, 0];3 authpriv[4, 0, 32, 0] = .authpriv[4, 0, 32, 0] AND  .enapriv[4, 0, 32, 0]; l authpriv  END ELSE enapriv);e %IF debugk %THEN ; print('change_privs: Enable PRIV (!XL !XL ) (requested)', 0 .enapriv[0, 0, 32, 0], .enapriv[4, 0, 32, 0]);8 print('change_privs: Enable PRIV (!XL !XL ) (actual)',2 .priv_ptr[0, 0, 32, 0], .priv_ptr[4, 0, 32, 0]); %FI= IF .priv_ptr[0,0,32,0] NEQ 0 OR .priv_ptr[4,0,32,0] NEQ 0t THEN BEGIN status = $SETPRV( ENBFLG = 1,_ PRVADR = .priv_ptr); %IF debug3 %THEN print('Enable privs status = !XL', .status);A %FI END;G .status END; kROUTINE set_priv( privs_a) = BEGINW BIND privs = .privs_a : $BBLOCK;0 LOCALF status," enable_privs : $BBLOCK[8] PRESET( [0,0,32,0] = 0, [4,0,32,0] = 0),Y# disable_privs : $BBLOCK[8] PRESET(C [0,0,32,0] = 0, [4,0,32,0] = 0),O no_flag : INITIAL(0),e bad_priv : INITIAL(0),  priv_num : INITIAL(0),D4 upper_privs : $BBLOCK[DSC$C_S_BLN] VOLATILE PRESET( [DSC$W_LENGTH] = 0,F" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),A2 priv_desc : $BBLOCK[DSC$C_S_BLN] VOLATILE PRESET( [DSC$W_LENGTH] = 0, " [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0);s EXTERNAL ROUTINE2 STR$COMPARE_EQL : BLISS ADDRESSING_MODE(GENERAL),. STR$ELEMENT : BLISS ADDRESSING_MODE(GENERAL),, STR$RIGHT : BLISS ADDRESSING_MODE(GENERAL),0 STR$TRANSLATE : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL),( strings_handler; EXTERNAL STR$_NOELEM; ENABLE) strings_handler(upper_privs, priv_desc); MACROk= match_priv(priv)= (STR$COMPARE_EQL(priv_desc, priv) EQL 0)%,# save_priv_info(prvname, all_flag)=  BEGIN IF all_flag THEN IF .no_flags THEN BEGINs ! ! Disable all privileges. !6 enable_privs[0,0,32,0] = enable_privs[4,0,32,0] = 0;9 disable_privs[0,0,32,0] = disable_privs[4,0,32,0] = -1;D ENDe ELSE BEGIN_ ! ! Enable all privileges. !7 enable_privs[0,0,32,0] = enable_privs[4,0,32,0] = -1;i8 disable_privs[0,0,32,0] = disable_privs[4,0,32,0] = 0; ENDt ELSE IF .no_flag THEN BEGINh ! ! Disable a privilege.n ! enable_privs[prvname] = 0; disable_privs[prvname] = 1;f ENDr ELSE BEGINR ! ! Enable a privilege. ! enable_privs[prvname] = 1; disable_privs[prvname] = 0;  END;# END%; !End of macro save_priv_info_! -! Uppercase and convert whitespace to commas.a! . status = STR$TRANSLATE(upper_privs, privs,' %ASCID'ABCDEFGHIJKLMNOPQRSTUVWXYZ,,',_( %ASCID'abcdefghijklmnopqrstuvwxyz ');( IF NOT .status THEN SIGNAL(.status); %IF debugK9 %THEN print('Uppercased privs = /!AS/', upper_privs); %FIf DO BEGINC status = STR$ELEMENT(priv_desc, priv_num, %ASCID',', upper_privs);O IF NOT .status THEN EXITLOOP;# IF .priv_desc[DSC$W_LENGTH] GTRU 0I THEN BEGINO' IF .priv_desc[DSC$W_LENGTH] LSSU 3  THEN bad_priv = 1 ELSE BEGIN; %IF debug$ %THEN print('NO detected');i %FIt> no_flag = (CH$RCHAR(.priv_desc[DSC$A_POINTER]) EQL %C'N' AND7 CH$RCHAR(.priv_desc[DSC$A_POINTER]+1) EQL %C'O');T IF .no_flagE THEN BEGIN8 status = STR$RIGHT(priv_desc, priv_desc, %REF(3));# IF NOT .status THEN EXITLOOP;C END; %IF debugN, %THEN print('Priv name = !AS', priv_desc); %FIM IF match_priv(all_priv)o- THEN save_priv_info(%QUOTE PRV$V_CMKRNL, 1) ! ELSE IF match_priv(cmkrnl_priv)- THEN save_priv_info(%QUOTE PRV$V_CMKRNL, 0)o! ELSE IF match_priv(cmexec_priv)V- THEN save_priv_info(%QUOTE PRV$V_CMEXEC, 0)s! ELSE IF match_priv(sysnam_priv) - THEN save_priv_info(%QUOTE PRV$V_SYSNAM, 0)E! ELSE IF match_priv(grpnam_priv)N- THEN save_priv_info(%QUOTE PRV$V_GRPNAM, 0)F# ELSE IF match_priv(allspool_priv) / THEN save_priv_info(%QUOTE PRV$V_ALLSPOOL, 0)! ELSE IF match_priv(detach_priv)h- THEN save_priv_info(%QUOTE PRV$V_DETACH, 0)N# ELSE IF match_priv(diagnose_priv)e/ THEN save_priv_info(%QUOTE PRV$V_DIAGNOSE, 0) ! ELSE IF match_priv(log_io_priv)_- THEN save_priv_info(%QUOTE PRV$V_LOG_IO, 0)L ELSE IF match_priv(group_priv), THEN save_priv_info(%QUOTE PRV$V_GROUP, 0)! ELSE IF match_priv(prmceb_priv)- THEN save_priv_info(%QUOTE PRV$V_PRMCEB, 0) ! ELSE IF match_priv(prmmbx_priv)R- THEN save_priv_info(%QUOTE PRV$V_PRMMBX,|06q MGFTP026.G^zI$[MGFTP.SOURCE]FTP_SERVER_CMDS.B32;55P1K 0)+! ELSE IF match_priv(pswapm_priv)- THEN save_priv_info(%QUOTE PRV$V_PSWAPM, 0)e! ELSE IF match_priv(setpri_priv) - THEN save_priv_info(%QUOTE PRV$V_SETPRI, 0)e! ELSE IF match_priv(setprv_priv)t- THEN save_priv_info(%QUOTE PRV$V_SETPRV, 0)r! ELSE IF match_priv(tmpmbx_priv).- THEN save_priv_info(%QUOTE PRV$V_TMPMBX, 0) ELSE IF match_priv(world_priv), THEN save_priv_info(%QUOTE PRV$V_WORLD, 0) ELSE IF match_priv(mount_priv), THEN save_priv_info(%QUOTE PRV$V_MOUNT, 0) ELSE IF match_priv(oper_priv)r+ THEN save_priv_info(%QUOTE PRV$V_OPER, 0)N" ELSE IF match_priv(exquota_priv). THEN save_priv_info(%QUOTE PRV$V_EXQUOTA, 0)! ELSE IF match_priv(netmbx_priv)N- THEN save_priv_info(%QUOTE PRV$V_NETMBX, 0)! ELSE IF match_priv(volpro_priv)- THEN save_priv_info(%QUOTE PRV$V_VOLPRO, 0);! ELSE IF match_priv(phy_io_priv)e- THEN save_priv_info(%QUOTE PRV$V_PHY_IO, 0)c! ELSE IF match_priv(bugchk_priv).- THEN save_priv_info(%QUOTE PRV$V_BUGCHK, 0)U! ELSE IF match_priv(prmgbl_priv)S- THEN save_priv_info(%QUOTE PRV$V_PRMGBL, 0)D! ELSE IF match_priv(sysgbl_priv)E- THEN save_priv_info(%QUOTE PRV$V_SYSGBL, 0)Q! ELSE IF match_priv(pfnmap_priv)N- THEN save_priv_info(%QUOTE PRV$V_PFNMAP, 0)n ELSE IF match_priv(shmem_priv), THEN save_priv_info(%QUOTE PRV$V_SHMEM, 0)! ELSE IF match_priv(syslck_priv)n- THEN save_priv_info(%QUOTE PRV$V_SYSLCK, 0)f ELSE IF match_priv(share_priv), THEN save_priv_info(%QUOTE PRV$V_SHARE, 0)" ELSE IF match_priv(upgrade_priv). THEN save_priv_info(%QUOTE PRV$V_UPGRADE, 0)$ ELSE IF match_priv(downgrade_priv)0 THEN save_priv_info(%QUOTE PRV$V_DOWNGRADE, 0)! ELSE IF match_priv(grpprv_priv) - THEN save_priv_info(%QUOTE PRV$V_GRPPRV, 0) " ELSE IF match_priv(readall_priv). THEN save_priv_info(%QUOTE PRV$V_READALL, 0)# ELSE IF match_priv(security_priv)h/ THEN save_priv_info(%QUOTE PRV$V_SECURITY, 0)s ELSE IF match_priv(acnt_priv)n+ THEN save_priv_info(%QUOTE PRV$V_ACNT, 0)r! ELSE IF match_priv(altpri_priv)r- THEN save_priv_info(%QUOTE PRV$V_ALTPRI, 0)! ELSE IF match_priv(bypass_priv) - THEN save_priv_info(%QUOTE PRV$V_BYPASS, 0)F! ELSE IF match_priv(sysprv_priv)s- THEN save_priv_info(%QUOTE PRV$V_SYSPRV, 0) ELSE bad_priv = 1; ! END; !End of long enough string %IF debug_: %THEN print('Enable = (!XL, !XL); Disable = (!XL, !XL)', .enable_privs[0,0,32,0], .enable_privs[4,0,32,0], .disable_privs[0,0,32,0],H .disable_privs[4,0,32,0]); %FI # END; !End of not a null stringO priv_num = .priv_num+1; END WHILE NOT .bad_priv; IF .bad_priv& THEN SIGNAL(FTP$_BAD_PARAMETER, 0,# FTP$_HELP_MESSAGE, 1, priv_desc);A8 IF .status EQL STR$_NOELEM THEN status = SS$_NORMAL; IF NOT .status. THEN SIGNAL(FTP$_LOCAL_ERROR, 0, .status);7 status = change_privs(enable_privs, disable_privs);d IF NOT .status. THEN SIGNAL(FTP$_LOCAL_ERROR, 0, .status);' status = STR$FREE1_DX(upper_privs);E IF NOT .status. THEN SIGNAL(FTP$_LOCAL_ERROR, 0, .status);% status = STR$FREE1_DX(priv_desc);K IF NOT .status. THEN SIGNAL(FTP$_LOCAL_ERROR, 0, .status);5 SIGNAL(FTP$_COMMAND_OKAY, 2, priv_string, privs);b SS$_NORMAL END; SROUTINE show_priv =t BEGINN EXTERNAL ROUTINE strings_handler,r- STR$APPEND : BLISS ADDRESSING_MODE(GENERAL), / STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);_ LOCAL] priv_count : INITIAL(0),k privs : $BBLOCK[8],R% item_list : $ITMLST_DECL(ITEMS = 1),O3 temp_desc1 : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(n [DSC$W_LENGTH] = 0, " [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),c3 temp_desc2 : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(E [DSC$W_LENGTH] = 0,L" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),O3 temp_desc3 : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(; [DSC$W_LENGTH] = 0,M" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),.3 temp_desc4 : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(E [DSC$W_LENGTH] = 0,C" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),_3 temp_desc5 : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(  [DSC$W_LENGTH] = 0, " [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),  status; BIND comma_string = %ASCID', ';s ENABLEA strings_handler(temp_desc1, temp_desc2, temp_desc3, temp_desc4);. MACROK add_priv(priv_name)=f BEGIN LOCAL desc_ptr : REF $BBLOCK, comma_ptr : REF $BBLOCK;s priv_count = .priv_count+1; desc_ptr =  (IF .priv_count GTR 33B THEN BEGIN comma_ptr =$ (IF .priv_count EQL 34 THEN temp_desc4 ELSE temp_desc5); temp_desc5 ENDU ELSE IF .priv_count GTR 24 THEN BEGIN comma_ptr =N (IF .priv_count EQL 25 THEN temp_desc3 ELSE temp_desc4); temp_desc4 END_ ELSE IF .priv_count GTR 15 THEN BEGIN comma_ptr =L (IF .priv_count EQL 16 THEN temp_desc2 ELSE temp_desc3); temp_desc3 ENDR ELSE IF .priv_count GTR 6= THEN BEGIN comma_ptr =E (IF .priv_count EQL 7  THEN temp_desc1 ELSE temp_desc2); temp_desc2 ENDe ELSE BEGIN comma_ptr =p (IF .priv_count EQL 1 THEN 0  ELSE temp_desc1); temp_desc1 END);e IF .comma_ptr NEQ 0+ THEN STR$APPEND(.comma_ptr, comma_string);t" STR$APPEND(.desc_ptr, priv_name); END%;$ $ITMLST_INIT(ITMLST = item_list, (ITMCOD = JPI$_CURPRIV, BUFSIZ = %ALLOCATION(privs), BUFADR = privs));-* status = $GETJPIW(ITMLST = item_list);( IF NOT .status THEN SIGNAL(.status);: STR$APPEND(temp_desc1, %ASCID 'Current privileges: '); IF .privs[PRV$V_CMKRNL]p THEN add_priv(cmkrnl_priv);N IF .privs[PRV$V_CMEXEC]e THEN add_priv(cmexec_priv);t IF .privs[PRV$V_SYSNAM]u THEN add_priv(sysnam_priv);, IF .privs[PRV$V_GRPNAM] THEN add_priv(grpnam_priv);L IF .privs[PRV$V_ALLSPOOL]A! THEN add_priv(allspool_priv);F IF .privs[PRV$V_DETACH]  THEN add_priv(detach_priv);N IF .privs[PRV$V_DIAGNOSE]! THEN add_priv(diagnose_priv);E IF .privs[PRV$V_LOG_IO]B THEN add_priv(log_io_priv);O IF .privs[PRV$V_GROUP] THEN add_priv(group_priv); IF .privs[PRV$V_ACNT]E THEN add_priv(acnt_priv);  IF .privs[PRV$V_PRMCEB]T THEN add_priv(prmceb_priv);N IF .privs[PRV$V_PRMMBX]$ THEN add_priv(prmmbx_priv);U IF .privs[PRV$V_PSWAPM]i THEN add_priv(pswapm_priv);O IF .privs[PRV$V_SETPRI]U THEN add_priv(setpri_priv);a IF .privs[PRV$V_SETPRV]T THEN add_priv(setprv_priv); IF .privs[PRV$V_TMPMBX]u THEN add_priv(tmpmbx_priv);O IF .privs[PRV$V_WORLD] THEN add_priv(world_priv); IF .privs[PRV$V_MOUNT] THEN add_priv(mount_priv); IF .privs[PRV$V_OPER]k THEN add_priv(oper_priv);H IF .privs[PRV$V_EXQUOTA] THEN add_priv(exquota_priv); IF .privs[PRV$V_NETMBX]C THEN add_priv(netmbx_priv);I IF .privs[PRV$V_VOLPRO]A THEN add_priv(volpro_priv);c IF .privs[PRV$V_PHY_IO]_ THEN add_priv(phy_io_priv);A IF .privs[PRV$V_BUGCHK]$ THEN add_priv(bugchk_priv);A IF .privs[PRV$V_PRMGBL]T THEN add_priv(prmgbl_priv);  IF .privs[PRV$V_SYSGBL]C THEN add_priv(sysgbl_priv);( IF .privs[PRV$V_PFNMAP]c THEN add_priv(pfnmap_priv);O IF .privs[PRV$V_SHMEM] THEN add_priv(shmem_priv}) s MGFTP026.G^zI$[MGFTP.SOURCE]FTP_SERVER_CMDS.B32;55P); IF .privs[PRV$V_SYSPRV]e THEN add_priv(sysprv_priv);L IF .privs[PRV$V_BYPASS]  THEN add_priv(bypass_priv);O IF .privs[PRV$V_SYSLCK]L THEN add_priv(syslck_priv);f IF .privs[PRV$V_SHARE] THEN add_priv(share_priv); IF .privs[PRV$V_UPGRADE] THEN add_priv(upgrade_priv); IF .privs[PRV$V_DOWNGRADE]" THEN add_priv(downgrade_priv); IF .privs[PRV$V_GRPPRV]o THEN add_priv(grpprv_priv);  IF .privs[PRV$V_READALL] THEN add_priv(readall_priv); IF .privs[PRV$V_SECURITY]! THEN add_priv(security_priv);P IF .privs[PRV$V_ALTPRI]  THEN add_priv(altpri_priv);g IF .priv_count GTR 33h2 THEN SIGNAL(FTP$_SYSTEM_STATUS, 1, temp_desc1,$ FTP$_SYSTEM_STATUS, 1, temp_desc2,$ FTP$_SYSTEM_STATUS, 1, temp_desc3,$ FTP$_SYSTEM_STATUS, 1, temp_desc4,$ FTP$_SYSTEM_STATUS, 1, temp_desc5) ELSE IF .priv_count GTR 242 THEN SIGNAL(FTP$_SYSTEM_STATUS, 1, temp_desc1,$ FTP$_SYSTEM_STATUS, 1, temp_desc2,$ FTP$_SYSTEM_STATUS, 1, temp_desc3,$ FTP$_SYSTEM_STATUS, 1, temp_desc4) ELSE IF .priv_count GTR 152 THEN SIGNAL(FTP$_SYSTEM_STATUS, 1, temp_desc1,$ FTP$_SYSTEM_STATUS, 1, temp_desc2,$ FTP$_SYSTEM_STATUS, 1, temp_desc3) ELSE IF .priv_count GTR 6f2 THEN SIGNAL(FTP$_SYSTEM_STATUS, 1, temp_desc1,$ FTP$_SYSTEM_STATUS, 1, temp_desc2)3 ELSE SIGNAL(FTP$_SYSTEM_STATUS, 1, temp_desc1);1' status = STR$FREE1_DX( temp_desc1);O( IF NOT .status THEN SIGNAL(.status);' status = STR$FREE1_DX( temp_desc2);e( IF NOT .status THEN SIGNAL(.status);' status = STR$FREE1_DX( temp_desc3);t( IF NOT .status THEN SIGNAL(.status);' status = STR$FREE1_DX( temp_desc4); ( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; t4GLOBAL ROUTINE site_command(fblock_a, parameter_a) =!++e! Functional description:,!c(! Site parameters. Site specific stuff.! ! parameters:u!h9! fblock The block that contains all the info about thisa ! transfer.S! ! parameter Anything.!--E BEGINI BIND" fblock = .fblock_a : FBLOCKDEF,0 out_desc = fblock[FBLOCK_Q_OUT_DESC] : $BBLOCK,% parameter = .parameter_a : $BBLOCK;] EXTERNAL ROUTINE0 SYS$SETDFPROT : BLISS ADDRESSING_MODE(GENERAL), set_protection,, LIB$SPAWN : BLISS ADDRESSING_MODE(GENERAL),/ OTS$CVT_TU_L : BLISS ADDRESSING_MODE(GENERAL),I/ OTS$CVT_TZ_L : BLISS ADDRESSING_MODE(GENERAL),T- STR$APPEND : BLISS ADDRESSING_MODE(GENERAL), 9 STR$CASE_BLIND_COMPARE : BLISS ADDRESSING_MODE(GENERAL), . STR$ELEMENT : BLISS ADDRESSING_MODE(GENERAL), strings_handler; LOCAL=3 parameter1 : $BBLOCK[DSC$K_S_BLN] VOLATILE PRESET(E [DSC$W_LENGTH] = 0, " [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),.3 parameter2 : $BBLOCK[DSC$K_S_BLN] VOLATILE PRESET(R [DSC$W_LENGTH] = 0,p" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),_3 parameter3 : $BBLOCK[DSC$K_S_BLN] VOLATILE PRESET(y [DSC$W_LENGTH] = 0,t" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),r3 parametern : $BBLOCK[DSC$K_S_BLN] VOLATILE PRESET(a [DSC$W_LENGTH] = 0,a" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),i$ prot_owner : VECTOR[4,LONG] PRESET( [0] = %ASCID 'System:', [1] = %ASCID 'Owner:',R [2] = %ASCID ',Group:', [3] = %ASCID ',World:'),i$ prot_field : VECTOR[4,LONG] PRESET( [0] = %ASCID 'R', [1] = %ASCID 'W', [2] = %ASCID 'E', [3] = %ASCID 'D'),]# prot_vect : VECTOR[4,LONG] PRESET(, [0] = 4, [1] = 2, [2] = 1, [3] = 8),s protection : INITIAL(0),= opermission : INITIAL(0), permission : INITIAL(0),; temp1 : INITIAL(0),i temp2 : INITIAL(0),s status; ENABLE5 strings_handler(parameter1, parameter2, parameter3); & IF NOT .fblock[FBLOCK_V_LOGGED_IN]' THEN SIGNAL(FTP$_NOT_LOGGED_IN, 0);!; IF .fblock[FBLOCK_L_STATE] NEQU FBLOCK_K_STATE_CMD_WORK& THEN SIGNAL(FTP$_BAD_SEQUENCE, 0);" IF .fblock[FBLOCK_V_ANONYMOUS]3 THEN anon_log('Beginning SITE !AS', parameter);N IF .fblock[FBLOCK_V_ACT_LOG]3 THEN super_act$fao('FTP: SITE !AS', parameter);e7 IF (.ftp_restrict AND FTP$K_RESTRICT_CONTROL) NEQ 0X THEN BEGIN IF .fblock[FBLOCK_V_ANONYMOUS]p, THEN anon_log('No access to Command:SITE'); IF .fblock[FBLOCK_V_ACT_LOG]6 THEN super_act$fao('FTP: No access to Command:SITE');2 SIGNAL(FTP$_NO_ACCESS, 1, %ASCID 'Command:SITE'); END;2= STR$ELEMENT( parameter1, %REF(0), %ASCID ' ', parameter); = STR$ELEMENT( parameter2, %REF(1), %ASCID ' ', parameter);a= STR$ELEMENT( parameter3, %REF(2), %ASCID ' ', parameter);@ IF STR$CASE_BLIND_COMPARE( parameter1, %ASCID 'CHMOD') EQL 0 THEN BEGIN IF .fblock[FBLOCK_V_ACT_LOG]lB THEN super_act$fao('FTP: CHMOD !AS !AS', parameter1, parameter2);" status = OTS$CVT_TZ_L(parameter2,* permission, %ALLOCATION(permission), 0); IF NOT .statusl& THEN SIGNAL(FTP$_PARAMETER_SYNTAX, 0,% FTP$_HELP_MESSAGE, 1, parameter2);p& permission = .permission AND %x'FFF'; %IF debug4 %THEN print('!%D permission = !XL',0, .permission); %FI temp1 = .permission;S INCR I FROM 0 TO 2T DO BEGIN INCR J From 0 to 3C DO BEGIN IF NOT .temp1C2 THEN protection = .protection OR .prot_vect[.J]; temp1 = .temp1 / 2;S END;# protection = .protection * 16; END;U1 status = translate_file(out_desc, parameter3, 0,L! .fblock [FBLOCK_V_ANONYMOUS],_' fblock [FBLOCK_Q_RESTRICTED_DIRS]);S IF NOT .status,0 THEN SIGNAL(FTP$_BAD_FILE_NAME, 1, parameter3); !++, ! See whether this user can access the file !--" IF .fblock[FBLOCK_V_CHECK_ACCESS]@ THEN IF NOT check_access(out_desc, .fblock[FBLOCK_V_ANONYMOUS],3 .ftp_restrict, fblock[FBLOCK_Q_RESTRICTED_DIRS])s THEN BEGIN IF .fblock[FBLOCK_V_ANONYMOUS]8 THEN anon_log('access denied on CHMOD !AS', out_desc);& SIGNAL(FTP$_NO_ACCESS, 1, out_desc); END; %IF debug4 %THEN print('!%D protection = !XL',0, .protection); %FI IF .fblock[FBLOCK_V_LOGGING][7 THEN print('Set PROT=!XW !AS', .protection, out_desc);! IF .fblock[FBLOCK_V_ACT_LOG]!D THEN super_act$fao('FTP: Set PROT=!XW !AS', .protection, out_desc);1 status = set_protection( out_desc, .protection);t IF NOT .statusa THEN BEGIN ! IF .fblock[FBLOCK_V_ACT_LOG]iA THEN super_act$fao('FTP: CHMOD failed, status=XL', .status);n" SIGNAL(FTP$_BAD_FILE_NAME, 1, parameter3, .status, 0) END= ELSE SIGNAL(FTP$_COMMAND_OKAY, 2, %ASCID 'Site', parameter);= ENDE ELSE IF STR$CASE_BLIND_COMPARE( parameter1, %ASCID 'UMASK') EQL 0v THEN BEGIN !* ! If value is null just return the value. ! IF .fblock[FBLOCK_V_ACT_LOG]K2 THEN super_act$fao('FTP: UMASK !AS', parameter1);# IF .parameter2[DSC$W_Length] EQL 0I THEN BEGIN;( status = SYS$SETDFPROT( 0, temp1 ); %IF debug1 %THEN print('!%D Old Prot = !XL',0, .temp1);a %FI protection = .temp1;, permission = 0; temp1 = .temp1 / 16;E INCR I FROM 0 TO 2c DO BEGING permission = .permission * 16; INCR J From 0 to 3 DO BEGIN IF .temp116 THEN permission = .permission OR .prot_vect[.J]; temp1 = .temp1 / 2; END; END; temp1 = .protection;' END ELSE BEGINr& status = OTS$CVT_TZ_L(parameter2,* permission, %ALLOCATION(permission), 0); IF NOT .status * THEN SIGNAL(FTP$_PARAMETER_SYNTAX, 0,% FTP$_HELP_MESSAGE, 1, parameter2);u %IF debug8 %THEN print~VCh MGFTP026.G^zI$[MGFTP.SOURCE]FTP_SERVER_CMDS.B32;55P8('!%D permission = !XL',0, .permission); %FI+ permission =(.permission AND %x'DFF');, temp1 = .permission;c protection = 0; INCR I FROM 0 TO 2V DO BEGIN  INCR J From 0 to 3 DO BEGIN IF .temp1i6 THEN protection = .protection OR .prot_vect[.J]; temp1 = .temp1 / 2;i END; protection = .protection * 16; END; temp1 = 0;N1 status = SYS$SETDFPROT( protection, temp1 );  %IF debugA %THEN print('!%D protection NEW !XL Old !XL',0, .protection,E .temp1); %FI END;N temp2 = .protection / 16; temp1 = .temp1 / 16;a opermission = 0; INCR I FROM 0 TO 2( DO BEGINV2 STR$APPEND( parameter3, .prot_owner[.I + 1]);% opermission = .opermission * 16;I INCR J From 0 to 3r DO BEGIN IF .temp1r4 THEN opermission = .opermission OR .prot_vect[.J]; IF NOT .temp2H0 THEN STR$APPEND( parameter3, .prot_field[.J]); temp1 = .temp1 / 2;r temp2 = .temp2 / 2;i END; END;M IF .statusL; THEN SIGNAL(FTP$_UMASK_OKAY, 3, .Opermission, .permission,P parameter3)1 ELSE SIGNAL(FTP$_ACTION_ABORTED, 0, .status, 0);r ENDB ELSE IF STR$CASE_BLIND_COMPARE( parameter1, priv_string) EQL 0 THEN BEGINA IF .parameter[DSC$W_LENGTH] NEQ .parameter1[DSC$W_LENGTH]H THEN BEGINi; parametern[DSC$A_POINTER] = .parameter[DSC$A_POINTER]+)! .parameter1[DSC$W_LENGTH]+1;V9 parametern[DSC$W_LENGTH] = .parameter[DSC$W_LENGTH]-r! .parameter1[DSC$W_LENGTH]-1;L set_priv(parametern); END ELSE show_priv(); ENDH! ELSE IF (STR$CASE_BLIND_COMPARE( parameter1, %ASCID 'SPAWN') EQL 0),! AND (.parameter2[DSC$W_LENGTH] NEQ 0) AND"! NOT .fblock[FBLOCK_V_ANONYMOUS]! THEN BEGIN,8! parametern[DSC$A_POINTER] = .parameter[DSC$A_POINTER]+"! .parameter1[DSC$W_LENGTH]+1;7! parametern[DSC$W_LENGTH] = .parameter[DSC$W_LENGTH] -O!! .parameter1[DSC$W_LENGTH]-1;c! status = LIB$SPAWN( ! parametern, ! Command_String! %ASCID 'NL:', ! Input_File%! %ASCID 'SYS$ERROR:', ! Output_FileQ! 0, ! Flags,! 0, ! Process_Name! 0, ! Process_Id! 0, ! Completion_statusV! 0, ! Completion_EFN! 0, ! Completion_ASTADRN! 0, ! Completion_ASTARGP! 0, ! Prompt! 0); ! CLI;! IF NOT .status THEN SIGNAL(FTP$_BAD_PARAMETER,0,.status);L! ENDaE ELSE IF STR$CASE_BLIND_COMPARE( parameter1, %ASCID 'BLOCK') EQL 0 THEN BEGIN* IF .parameter2[DSC$W_LENGTH] NEQ 0 THEN BEGINE- status = OTS$CVT_TU_L(parameter2, temp1,N %ALLOCATION(temp1), 0);V, IF NOT .status OR (.temp1 GTR %X'FFFF')' THEN SIGNAL(FTP$_BAD_BLOCKSIZE, 0,D$ FTP$_HELP_MESSAGE,1, parameter2);) fblock[FBLOCK_L_BLOCKSIZE] = .temp1;VB SIGNAL(FTP$_COMMAND_OKAY, 2, %ASCID 'Blocksize', parameter2); END= ELSE SIGNAL(FTP$_BLOCKSIZE, 1, .fblock[FBLOCK_L_BLOCKSIZE]);N END& ELSE SIGNAL(FTP$_BAD_PARAMETER, 0,# FTP$_HELP_MESSAGE,1, parameter1);N( status = STR$FREE1_DX( parameter1 );( IF NOT .status THEN SIGNAL(.status);( status = STR$FREE1_DX( parameter2 );( IF NOT .status THEN SIGNAL(.status);( status = STR$FREE1_DX( parameter3 );( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; ,(ROUTINE get_file_size (file_a, size_a) =BEGIN  BIND file = .file_a : $BBLOCK, size = .size_a; LOCALi' parse_result : $BBLOCK [NAM$C_MAXRSS],,! nam : $NAM (ESA = parse_result,0 ESS = NAM$C_MAXRSS), fab : $FAB (NAM = nam),s fib : $BBLOCK [FIB$K_LENGTH],E iosb : VECTOR [4,WORD],' atr_recattr : $BBLOCK [ATR$S_RECATTR],O% atr_itmlst : $ITMLST_DECL (ITEMS=1),H desc : $BBLOCK [DSC$K_S_BLN], blocks : VECTOR [2,WORD],d chan, status; desc [DSC$W_LENGTH] = 0;' desc [DSC$B_DTYPE] = DSC$K_DTYPE_T; ' desc [DSC$B_CLASS] = DSC$K_CLASS_S;; desc [DSC$A_POINTER] = 0;n& $ITMLST_INIT (ITMLST = atr_itmlst, (ITMCOD = ATR$C_RECATTR, BUFSIZ = ATR$S_RECATTR, BUFADR = atr_recattr));+ fab [FAB$B_FNS] = .file [DSC$W_LENGTH];G, fab [FAB$L_FNA] = .file [DSC$A_POINTER]; status = $PARSE (FAB = fab); IF (.status) THEN status = $SEARCH (FAB = fab); IF (.status) THEN BEGIN( desc [DSC$W_LENGTH] = .nam [NAM$B_DEV];) desc [DSC$A_POINTER] = .nam [NAM$L_DEV]; / status = $ASSIGN (DEVNAM = desc, CHAN = chan);  END;  IF (.status) THEN BEGIN( desc [DSC$W_LENGTH] = %ALLOCATION(fib); desc [DSC$A_POINTER] = fib;: CH$FILL (%CHAR(0), FIB$C_LENGTH, fib); !Zero out the FIB, fib [FIB$W_FID_NUM] = .nam [NAM$W_FID_NUM];, fib [FIB$W_FID_SEQ] = .nam [NAM$W_FID_SEQ];, fib [FIB$W_FID_RVN] = .nam [NAM$W_FID_RVN]; status = $QIOW (CHAN = .chan, FUNC = IO$_ACCESS,c IOSB = iosb,O P1 = desc,R P5 = atr_itmlst);& IF (.status) THEN status = .iosb [0]; $DASSGN (CHAN = .chan); END;, IF (.status) THEN BEGIN* blocks [1] = .atr_recattr [FAT$W_EFBLKH];* blocks [0] = .atr_recattr [FAT$W_EFBLKL];: size = (.blocks - 1) * 512 + .atr_recattr [FAT$W_FFBYTE]; END;R RETURN (.status);OEND; K3GLOBAL ROUTINE size_command(fblock_a, pathname_a) = !++B! Functional description: !D6! SIZE command. Return the size of the file specified:! in the pathname to the other end of the data connection.2! status and contents of file shall be unaffected.!, ! parameters:A! 9! fblock The block that contains all the info about this ! transfer.r!-- BEGINs BIND" fblock = .fblock_a : FBLOCKDEF,4 trans_desc = fblock[FBLOCK_Q_TRANS_DESC] : $BBLOCK,0 out_desc = fblock[FBLOCK_Q_OUT_DESC] : $BBLOCK,# pathname = .pathname_a : $BBLOCK;$ EXTERNAL ROUTINE ftp_file_to_net, ftp_file_to_net_abort;c LOCALB% item_list : $ITMLST_DECL(ITEMS = 2),I access : INITIAL(ARM$M_READ),p rstatus,E file_size,5 status;& IF NOT .fblock[FBLOCK_V_LOGGED_IN]' THEN SIGNAL(FTP$_NOT_LOGGED_IN, 0); ; IF .fblock[FBLOCK_L_STATE] NEQU FBLOCK_K_STATE_CMD_WORKp& THEN SIGNAL(FTP$_BAD_SEQUENCE, 0);P status = translate_file(out_desc, pathname, 0, .fblock [FBLOCK_V_ANONYMOUS],' fblock [FBLOCK_Q_RESTRICTED_DIRS]);s IF NOT .status1 THEN SIGNAL(FTP$_BAD_FILE_NAME, 1, pathname);N4 IF (.ftp_restrict AND FTP$K_RESTRICT_READ) NEQ 0 THEN BEGIN IF .FBLOCK[FBLOCK_V_ANONYMOUS]p, THEN anon_log('No access to Command:SIZE'); IF .fblock[FBLOCK_V_ACT_LOG] 6 THEN super_act$fao('FTP: No access to Command:SIZE');2 SIGNAL(FTP$_NO_ACCESS, 1, %ASCID 'Command:SIZE'); END;_ !++s/ ! See whether this user can access the fileD !-- % IF .fblock[FBLOCK_V_CHECK_ACCESS]CC THEN IF NOT check_access(out_desc, .fblock[FBLOCK_V_ANONYMOUS],)3 .ftp_restrict, fblock[FBLOCK_Q_RESTRICTED_DIRS])F THEN BEGINT# IF .fblock[FBLOCK_V_ANONYMOUS]D: THEN anon_log('access denied on SIZE !AS', out_desc);! IF .fblock[FBLOCK_V_ACT_LOG](D THEN super_act$fao('FTP: access denied on SIZE !AS', out_desc);) SIGNAL(FTP$_NO_ACCESS, 1, out_desc); END;i ! Activity Log: Retreive#! IF .fblock[FBLOCK_V_ANONYMOUS]m<! THEN anon_log('Beginning RETR !AS (typ=!UB, stru=!UB)',?! out_desc, .fblock[FBLOCK_L_TYPE], .fblock[FBLOCK_L_STRU]);e!! IF .fblock[FBLOCK_V_ACT_LOG]I@! THEN super_act$fao('FTP: Retrieve !AS (typ=!UB, stru=!UB)',?! out_desc, .fblock[FBLOCK_L_TYPE], .fblock[FBLOCK_L_STRU]);R1 status = get_file_size (out_desc, file_size);R IF .status THEN BEGIN( SIGNAL (FTP$_FILE_SIZE, 1, .file_size); END ELSE BEGIN ! Activity Log: End of session$ ! IF .fblock[Fڥͣ MGFTP026.G^zI$[MGFTP.SOURCE]FTP_SERVER_CMDS.B32;55PBLOCK_V_ANONYMOUS]F! THEN anon_log('Retrieval of !AS failed, codes = !XL, !XL', out_desc,&! .status, .fblock[FBLOCK_L_STATUS]);! IF .fblock[FBLOCK_V_ACT_LOG]F! THEN super_act$fao('FTP: Retrieval of !AS failed, codes = !XL, !XL',/! out_desc,.status, .fblock[FBLOCK_L_STATUS]);.! IF .STATUS EQL FTP$_DIR_FILE! THEN SIGNAL(.status);F rstatus = FTP$_BAD_FILE_NAME; IF (.status EQL RMS$_FNF) ORv (.status EQL RMS$_DNF) OR (.status EQL RMS$_NOD) OR (.status EQL RMS$_DEV)a# THEN rstatus = FTP$_FILE_NOT_FOUND[ ELSE IF .status EQL RMS$_PRVi THEN rstatus = FTP$_NO_ACCESS" ELSE IF (.status EQL RMS$_FLK) OR (.status EQL RMS$_WLK) ORR (.status EQL RMS$_DNR)& THEN rstatus = FTP$_FILE_UNAVAILABLE;( SIGNAL(.rstatus, 1, out_desc, .status); END;  SS$_NORMAL END;END !End of module begin ELUDOMs[PRV$V_SYSGBL]C THEN add_priv(sysgbl_priv);( IF .privs[PRV$V_PFNMAP]c THEN add_priv(pfnmap_priv);O IF .privs[PRV$V_SHMEM] THEN add_priv(shmem_priv"*[MGFTP.SOURCE]FTP_SET_PARAMS.B32;3+, . / 4F -I0123KPWO 56sq7)בsq89/RFÞGHJ ! MadGoat FTP client and server!?! Authors: Chad Wilson, Dale Moore, Tod Shannon, Bruce Miller,,! Marc Shannon, Henry Miller, John Clement,1! Matt Madison, Darrell Burkhead, Hunter Goatley!6! Copyright 1986, 1992, Carnegie Mellon University.B! Copyright 1994, 1999, MadGoat Software. All rights reserved.!?! Permission is granted for not-for-profit redistribution,?! provided all source and object code remain unchanged from?! the original distribution, and that all copyright notices! remain intact.!MODULE ftp_set_params( ADDRESSING_MODE( EXTERNAL = LONG_RELATIVE," NONEXTERNAL = LONG_RELATIVE), IDENT = 'V2.5-3',& LIST(ASSEMBLY, NOBINARY, NOEXPAND)) =BEGIN!+!+! V2.5-3 Hunter Goatley 23-APR-1999 13:47"! Added hide_vms_syst definition.!)! V2.3 Hunter Goatley 26-FEB-1998 11:07!! Add UNIX ls emulation globals.!!-LIBRARY 'SYS$LIBRARY:STARLET';LIBRARY 'CLI';LIBRARY 'FTP';LIBRARY 'NETAUX';GLOBAL, by_owner : $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0," [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0), date_backup : INITIAL(0), date_created : INITIAL(1), date_expired : INITIAL(0), date_modified : INITIAL(0), error_output : INITIAL(1), heading : INITIAL(1), owner_output : INITIAL(1),! size_allocation : INITIAL(0), size_used : INITIAL(1), trailing : INITIAL(1), width_date : INITIAL(17), width_display : INITIAL(0),! width_filename : INITIAL(19), width_owner : INITIAL(0), width_size : INITIAL(6),# protection_output : INITIAL(1),! emulate_unix_ls : INITIAL(0), unix_style_dir : INITIAL(0), hide_vms_syst : INITIAL(0); .ROUTINE get_switch_number(switch_a, value_a) =!++! Functional Description:!>! Routine to return a switch value. Is(in this module) passedB! a descriptor switch and a descriptor return value(into which the! switch value is returned.!-- BEGIN BIND switch = .switch_a : $BBLOCK, value = .value_a; EXTERNAL ROUTINE/ OTS$CVT_TU_L : BLISS ADDRESSING_MODE(GENERAL),/ STR$Free1_Dx : BLISS ADDRESSING_MODE(GENERAL),. STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL); BUILTIN NULLPARAMETER; LOCAL! temp_buffer : VECTOR[128, BYTE],) temp_desc : $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0," [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0), status;! status = CLI$PRESENT(switch);C IF (.status EQLU CLI$_PRESENT) OR (.status EQLU CLI$_DEFAULTED)3 THEN status = CLI$GET_VALUE(switch, temp_desc); IF .status7 THEN status = OTS$CVT_TU_L(temp_desc, value, 4, 0); STR$FREE1_DX(temp_desc); .status END; )GLOBAL ROUTINE ftp_set_params : NOVALUE = BEGIN EXTERNAL ftp_server_parse, lnm$dcl_logical; LOCAL date_all, size_all," lnmlst : $ITMLST_DECL(ITEMS=1), lnm_buffer : VECTOR[256,BYTE],( lnm_desc : $BBLOCK[DSC$K_S_BLN] PRESET(- [DSC$W_LENGTH] = %ALLOCATION(lnm_buffer)," [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_S," [DSC$A_POINTER] = lnm_buffer), status; $ITMLST_INIT(ITMLST=lnmlst, (ITMCOD = LNM$_STRING, BUFADR = lnm_buffer,# BUFSIZ = %ALLOCATION(lnm_buffer),$ RETLEN = lnm_desc[DSC$W_LENGTH])); status = $TRNLNM( LOGNAM = %ASCID 'FTP_OPTIONS', TABNAM = lnm$dcl_logical, ITMLST = lnmlst);* IF .status NEQ SS$_NORMAL THEN RETURN;< status = CLI$DCL_PARSE(LNM_DESC,FTP_SERVER_PARSE,0,0,0); IF .status THEN BEGIN) heading = CLI$PRESENT(%ASCID 'HEADING');+ trailing = CLI$PRESENT(%ASCID 'TRAILING');6 protection_output = CLI$PRESENT(%ASCID 'PROTECTION');, error_output = CLI$PRESENT(%ASCID 'ERROR');, owner_output = CLI$PRESENT(%ASCID 'OWNER');* date_all = CLI$PRESENT(%ASCID'DATE.ALL');@ date_created = .date_all OR CLI$PRESENT(%ASCID 'DATE.CREATED');B date_modified = .date_all OR CLI$PRESENT(%ASCID 'DATE.MODIFIED');> date_backup = .date_all OR CLI$PRESENT(%ASCID 'DATE.BACKUP');@ date_expired = .date_all OR CLI$PRESENT(%ASCID 'DATE.EXPIRED');* size_all = CLI$PRESENT(%ASCID'SIZE.ALL');F size_allocation = .size_all OR CLI$PRESENT(%ASCID 'SIZE.ALLOCATION');: size_used = .size_all OR CLI$PRESENT(%ASCID 'SIZE.USED');4 get_switch_number(%ASCID 'WIDTH.DATE', width_date);: get_switch_number(%ASCID 'WIDTH.DISPLAY', width_display);< get_switch_number(%ASCID 'WIDTH.FILENAME', width_filename);6 get_switch_number(%ASCID 'WIDTH.OWNER', width_owner);4 get_switch_number(%ASCID 'WIDTH.SIZE', width_size); END; END;ENDELUDOM*[MGFTP.SOURCE]HASH.B32;1+,6J. / 4? "-I0123KPWO 56L!ӗ735&89/RFÞGHJ ! MadGoat FTP client and server!?! Authors: Chad Wilson, Dale Moore, Tod Shannon, Bruce Miller,,! Marc Shannon, Henry Miller, John Clement,1! Matt Madison, Darrell Burkhead, Hunter Goatley!6! Copyright 1986, 1992, Carnegie Mellon University.<! Copyright 1994, MadGoat Software. All rights reserved.!?! Permission is granted for not-for-profit redistribution,?! provided all source and object code remain unchanged from?! the original distribution, and that all copyright notices! remain intact.!MODULE hash( ADDRESSING_MODE( EXTERNAL = LONG_RELATIVE, NONEXTERNAL = LONG_RELATIVE),$ LIST(ASSEMBLY, NOBINARY, NOEXPAND), IDENT = 'V2.0' ) =BEGIN!++ ! Hash.B32!.! Copyright(C) 1987 Carnegie Mellon University!! Description:!<! Some routines to handle the display of hash characters for! the FTP utility.! ! Written By:!"! Dale Moore 13-OCT-1987 CMU-CS/RI6! Created mostly from previous work by Chad Wilson and/! exA( MGFTP026.G6JI[MGFTP.SOURCE]HASH.B32;1? tracted from FTP_File.B32 and Routines.B32.!! Modifications:*! V2.0 Darrell Burkhead 14-JAN-1994 11:00=! Switched from using FTP$_HASH_SET messages to FTP$_HASH_ON! and FTP$_HASH_OFF messages.!--LIBRARY 'SYS$LIBRARY:STARLET';LIBRARY 'FTP_MSG';LIBRARY 'FTP';LIBRARY 'CLI';LIBRARY 'NETAUX';GLOBAL= display_hash : INITIAL(0); ! Flag to control hash displayBIND? crlf_desc = %ASCID %STRING(%CHAR(CR), %CHAR(LF)) : $BBLOCK;OWN- hash : BYTE INITIAL(FTP$_HASH_CHARACTER), hash_fab : $FAB( FNM = 'SYS$OUTPUT:', FAC = , ORG = SEQ, RFM = VAR ), hash_rab : $RAB( FAB = hash_fab ), hash_byte_count,  hash_default_setting, hash_current_setting; GLOBAL ROUTINE hash_on =!++! Functional Description:!! Set the hash on temporarily!-- BEGIN EXTERNAL' quiet_flag : ADDRESSING_MODE(GENERAL); LOCAL status;1 IF NOT .quiet_flag THEN SIGNAL(FTP$_HASH_ON);5 IF .hash_current_setting THEN RETURN(SS$_NORMAL);# status = $OPEN(FAB = hash_fab);( IF NOT .status THEN SIGNAL(.status);& status = $CONNECT(RAB = hash_rab);( IF NOT .status THEN SIGNAL(.status); hash_current_setting = 1; SS$_NORMAL END; GLOBAL ROUTINE hash_off =!++! Functional Description:!! Set the current value to off.!-- BEGIN EXTERNAL' quiet_flag : ADDRESSING_MODE(GENERAL); LOCAL status;2 IF NOT .quiet_flag THEN SIGNAL(FTP$_HASH_OFF);9 IF NOT .hash_current_setting THEN RETURN(SS$_NORMAL);) status = $DISCONNECT(RAB = hash_rab);( IF NOT .status THEN SIGNAL(.status);$ status = $CLOSE(FAB = hash_fab);( IF NOT .status THEN SIGNAL(.status); hash_current_setting = 0; SS$_NORMAL END; GLOBAL ROUTINE hash_toggle =!++! Functional Description:!! Toggle the hash flag setting!-- BEGIN LOCAL status; status = (IF .hash_current_setting THEN hash_off() ELSE hash_on()); SS$_NORMAL END; GLOBAL ROUTINE hash_restore =!++! Functional Description:!4! Set the current setting to be the default setting.!-- BEGIN: IF .hash_current_setting AND NOT .hash_default_setting THEN hash_off()? ELSE IF NOT .hash_current_setting AND .hash_default_setting THEN hash_on() ELSE SS$_NORMAL END; GLOBAL ROUTINE hash_default_on =!++! Functional Description:!(! Set the default hash setting to be on.!-- BEGIN hash_default_setting = 1; hash_restore(); SS$_NORMAL END; !GLOBAL ROUTINE hash_default_off =!++! Functional Description:!)! Set the default hash setting to be off.!-- BEGIN hash_default_setting = 0; hash_restore(); SS$_NORMAL END; GLOBAL ROUTINE set_hash=!++! Functional Description:!+! Called in response to a SET HASH command.!-- BEGIN IF CLI$PRESENT(%ASCID'HASH') THEN hash_default_on() ELSE hash_default_off(); SS$_NORMAL END; GLOBAL ROUTINE show_hash =!++! Functional Description:!5! Show the value of the current default hash setting.!-- BEGIN SIGNAL( IF .hash_current_setting THEN FTP$_HASH_ON ELSE FTP$_HASH_OFF) END; GLOBAL ROUTINE hash_init = BEGIN display_hash = 0; hash_byte_count = 0; SS$_NORMAL END; GLOBAL ROUTINE hash_show(size) =!++! Functional Description:!5! Display the hash as the data gets shuffled through.!-- BEGIN LOCAL hash_count, status;2 hash_count = (.size - .hash_byte_count)/ 1024;= hash_byte_count = .hash_byte_count +(.hash_count * 1024);9 IF NOT .hash_current_setting THEN RETURN(SS$_NORMAL); IF NOT .display_hash THEN BEGIN0 hash_rab[RAB$W_RSZ] = .crlf_desc[DSC$W_LENGTH];1 hash_rab[RAB$L_RBF] = .crlf_desc[DSC$A_POINTER]; status = $PUT(RAB = hash_rab);% IF NOT .status THEN SIGNAL(.status); END;, hash_rab[RAB$W_RSZ] = %ALLOCATION(hash); hash_rab[RAB$L_RBF] = hash;# INCR i FROM 1 TO .hash_count DO BEGIN status = $PUT(RAB = hash_rab);% IF NOT .status THEN SIGNAL(.status); END; display_hash = 1; SS$_NORMAL END;ENDELUDOM*[MGFTP.SOURCE]LOGIN.B32;2+,B. / 4K -I0123KPWO 56D#n7~89/RFÞGHJ  ! MadGoat FTP client and server!?! Authors: Chad Wilson, Dale Moore, Tod Shannon, Bruce Miller,,! Marc Shannon, Henry Miller, John Clement,1! Matt Madison, Darrell Burkhead, Hunter Goatley!6! Copyright 1986, 1992, Carnegie Mellon University.<! Copyright 1994, MadGoat Software. All rights reserved.!?! Permission is granted for not-for-profit redistribution,?! provided all source and object code remain unchanged from?! the original distribution, and that all copyright notices! remain intact.!MODULE login( ADDRESSING_MODE( EXTERNAL = LONG_RELATIVE," NONEXTERNAL = LONG_RELATIVE),$ LIST(ASSEMBLY, NOBINARY, NOEXPAND), IDENT = 'V2.0-1') =BEGIN!++8! Login.B32 Copyright(c) 1986 Carnegie Mellon University!! Functional Description:!! Verify user for FTP utility!.! Written_By: Dale Moore 24-MAR-1986 CMU-CS/RI!! Modifications:!,! V2.0-1 Darrell Burkhead 1-FEB-1994 17:06?! Each anonymous account now has its own MADGOAT_FTP_user_DIRS ! logical.!*! V2.0 Darrell Burkhead 22-NOV-1993 14:22>! Moved set_privs to FTP_IN. The prime time logicals are now! handled by is_anonymous.!)! V1.1 Hunter Goatley 28-SEP-1993 15:00,! Added MADGOAT_ to FTP_ANON logical names.!!! 6-May-1993 Darrell Burkhead WKUF! Fixed SET_PRIVS. A couple of the ANDs and ORs to get the privilegesA! to enable or disable were using addresses instead of the actual! privilege bitmasks.!--LIBRARY 'SYS$LIBRARY:STARLET';LIBRARY 'FTPSRV';LIBRARY 'ANON_FTP'; COMPILETIME debug = 0;D%IF debug %THEN %MESSAGE('DEBUG mode is enabled in LOGIN.B32!') %FI; %IF debug%THEN LIBRARY 'NETAUX';%FIEXTERNAL( lnm$dcl_logical, !Defined in FTP_IN lav0, !...% sys$net; !Defined in FTP_SERVER GGLOBAL ROUTINE login_guest(username_a, anon_blk_a_a, primetime, thresh,* password_a, pwd_len_a, anon_dir_log_a)=!++! Functional Description:!D! This routine performs much of the same functions as Login_User,+! but is specifically for ANONYMOUS FTP.!!-- BEGIN BIND# username = .username_a : $BBLOCK, anon_blk_a = .anon_blk_a_a,# password = .password_a : $BBLOCK, pwd_len = .pwd_len_a : WORD,* anon_dir_log = .anon_dir_log_a : $BBLOCK; BUILTIN CMPF, MULF, DIVF; LOCAL lavchn : WORD,# lavbuf : VECTOR[9, LONG],$ laviosb : VECTOR[4, WORD], curload, pfactor,$ lnm_list : $ITMLST_DECL(ITEL MGFTP026.GBI[MGFTP.SOURCE]LOGIN.B32;2K UMS = 1), temp_ptr : REF $BBLOCK, temp_buf : $BBLOCK[255],! temp_desc : $BBLOCK[DSC$C_S_BLN]3 PRESET([DSC$W_LENGTH] = %ALLOCATION(temp_buf),# [DSC$B_CLASS] = DSC$K_CLASS_S,# [DSC$B_DTYPE] = DSC$K_DTYPE_T, [DSC$A_POINTER]= temp_buf), status; EXTERNAL ROUTINE- STR$COPY_R : BLISS ADDRESSING_MODE(GENERAL); !++F ! The login will be rejected if the anonymous password hasn't been ! passed on to the server. !--# $ITMLST_INIT(ITMLST = lnm_list, (ITMCOD = LNM$_STRING,% BUFADR = .temp_desc[DSC$A_POINTER],$ BUFSIZ = .temp_desc[DSC$W_LENGTH],% RETLEN = temp_desc[DSC$W_LENGTH])); status = $TRNLNM( TABNAM = lnm$dcl_logical, LOGNAM = sys$net, ITMLST = lnm_list); IF .status. THEN IF NOT CH$FAIL(temp_ptr = CH$FIND_CH( .temp_desc[DSC$W_LENGTH], .temp_desc[DSC$A_POINTER], %C'"')) THEN BEGIN? pwd_len = .temp_desc[DSC$W_LENGTH]-(.temp_ptr-temp_buf+1); status = STR$COPY_R(, password, pwd_len, CH$PLUS(.temp_ptr,1)); END ELSE status = 0; IF NOT .status# THEN RETURN(FTP$_NO_ANON_PASS); !++K ! If this is prime time, check if the load average is too high to allow@ ! the login. If primetime is set, LAV0 is assumed to exist. !-- IF .primetime THEN BEGIN0 status = $ASSIGN(DEVNAM = lav0, CHAN = lavchn); IF .status THEN BEGIN status = $QIOW( CHAN = .lavchn, FUNC = IO$_READVBLK, IOSB = laviosb, P1 = lavbuf, P2 = %ALLOCATION(lavbuf)); $DASSGN(CHAN = .lavchn); END; IF .status AND .laviosb[0] THEN BEGIN- DIVF(%REF(%E'4.0'), lavbuf[5], pfactor);' MULF(pfactor, lavbuf[2], curload);# IF CMPF(curload, thresh) GEQ 0$ THEN RETURN(FTP$_SYS_TOO_BUSY); END; END;C anon_log_open(anon_blk_a, ! Start ANONYMOUS transcript logging. anon_dir_log); SS$_NORMAL END;ENDELUDOM#*[MGFTP.SOURCE]LOG_TO_LISTENER.B32;1+,>J./ 4F-I0123KPWO56!ӗ7NJ89/RFÞGHJ  ! MadGoat FTP client and server!?! Authors: Chad Wilson, Dale Moore, Tod Shannon, Bruce Miller,,! Marc Shannon, Henry Miller, John Clement,1! Matt Madison, Darrell Burkhead, Hunter Goatley!6! Copyright 1986, 1992, Carnegie Mellon University.<! Copyright 1994, MadGoat Software. All rights reserved.!?! Permission is granted for not-for-profit redistribution,?! provided all source and object code remain unchanged from?! the original distribution, and that all copyright notices! remain intact.!MODULE log_to_listener(( LIST (NOEXPAND,ASSEMBLY,BINARY,OBJECT), IDENT = 'V2.0',F ADDRESSING_MODE (EXTERNAL = LONG_RELATIVE, NONEXTERNAL=LONG_RELATIVE) ) =BEGIN!++C! LOG_TO_LISTENER.B32 Copyright (c) 1989 Carnegie Mellon University! ! Facility:! Local Runtime Library:! ! Abstract:%! A simple User level output routine.!! Environment:B! VAX/VMS operating system and runtime library, user mode process.! ! Author:+! Bruce R. Miller CMU Network Developmewnt!! Revision History:!*! V1.2 Darrell Burkhead 22-OCT-1993 13:53>! Renamed from NETAUX to LOG_TO_LISTENER. This module is now! only used by FTP_SERVER.!)! V1.1 Hunter Goatley 24-SEP-1993 15:25"! Removed obsolete PRINT_ROUTINE.!--LIBRARY 'SYS$LIBRARY:STARLET';(LIBRARY 'NETLIB'; !IOSBDEF definitionOWN log_chan : WORD; "GLOBAL ROUTINE save_log_chn(chan)=!++! Functional Description:!D! Store the channel number of the mailbox which will be used to pass&! on log messages to the activity log.!--BEGIN log_chan = .chan; SS$_NORMALEND;(GLOBAL ROUTINE write_log_mbx(message_a)=!++! Functional Description:!E! Write a message to the mailbox which is routed to the activity log.!--BEGINREGISTER status;BIND message = .message_a : $BBLOCK;LOCAL iosb : IOSBDEF; status = $QIOW( CHAN = .log_chan,# FUNC = IO$_WRITEVBLK OR IO$M_NOW, IOSB = iosb, P1 = .message[DSC$A_POINTER], P2 = .message[DSC$W_LENGTH]);2 IF .status THEN status = .iosb[IOSB_W_STATUS]; .statusEND;ENDELUDOM*[MGFTP.SOURCE]MEM.B32;2+,B./ 4N-I0123KPWO56Ki#n7|^|#n89/RFÞGHJ  ! MadGoat FTP client and server!?! Authors: Chad Wilson, Dale Moore, Tod Shannon, Bruce Miller,,! Marc Shannon, Henry Miller, John Clement,1! Matt Madison, Darrell Burkhead, Hunter Goatley!6! Copyright 1986, 1992, Carnegie Mellon University.<! Copyright 1994, MadGoat Software. All rights reserved.!?! Permission is granted for not-for-profit redistribution,?! provided all source and object code remain unchanged from?! the original distribution, and that all copyright notices! remain intact.!MODULE memory( ADDRESSING_MODE( EXTERNAL = LONG_RELATIVE," NONEXTERNAL = LONG_RELATIVE), IDENT = 'V2.0',# LIST(NOBINARY, ASSEMBLY, NOEXPAND) ) =BEGIN!++6! Mem.B32 Copyright(c) 1986 Carnegie Mellon University!! Description:!6! A few routines to aid with dynamic memory manegment.!"! Written By: Dale Moore CMU-CS/RI!! Modifications:!!--LIBRARY 'SYS$LIBRARY:STARLET';LIBRARY 'FIELDS';LIBRARY 'NETAUX'; COMPILETIME Debug = 0;B%IF debug %THEN %MESSAGE('DEBUG mode is enabled in MEM.B32!') %FI; _DEF(MEM) MEM_L_FLINK = _LONG, MEM_L_BLINK = _LONG, MEM_L_SIZE = _LONG, MEM_L_STATE = _LONG, _OVERLAY(MEM_L_STATE) MEM_V_VALID = _BIT _ENDOVERLAY _ENDDEF(MEM); GLOBAL ROUTINE get_mem(size) = BEGIN EXTERNAL ROUTINE- LIB$GET_VM : BLISS ADDRESSING_MODE(GENERAL); LOCAL block_a, status;. status = LIB$GET_VM(%REF(.size), block_a);( IF NOT .status THEN SIGNAL(.status); %IF debugF %THEN print('Get_Mem Size = !UL, Address = !XL', .size, .block_a); %FI BEGIN( BIND this_block = .block_a : MEMDEF; this_block[MEM_L_SIZE] = .size; this_block[MEM_V_VALID] = 1; END; RETURN(.block_a) END; "GLOBAL ROUTINE free_mem(block_a) = BEGIN BIND this_block = .block_a : MEMDEF; EXTERNAL ROUTINE. LIB$FREE_VM : BLISS ADDRESSING_MODE(GENERAL); LOCAL status; %IF DebugN %THEN print('Free_Mem Size = !UL, Address = !XL', .this_block[MEM_L_SIZE], this_block); %FIC status = LIB$FREE_VM(this_block[MEM_L_SIZE], %REF(this_block));( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END;ENDELUDOMm MGFTP026.GBI[MGFTP.SOURCE]NETLIB.B32;2Em*[MGFTP.SOURCE]NETLIB.B32;2+,B./ 4EB-I0123KPWO56#n7у>#n89/RFÞGHJ ! MadGoat FTP client and server!?! Authors: Chad Wilson, Dale Moore, Tod Shannon, Bruce Miller,,! Marc Shannon, Henry Miller, John Clement,1! Matt Madison, Darrell Burkhead, Hunter Goatley!6! Copyright 1986, 1992, Carnegie Mellon University.<! Copyright 1994, MadGoat Software. All rights reserved.!?! Permission is granted for not-for-profit redistribution,?! provided all source and object code remain unchanged from?! the original distribution, and that all copyright notices! remain intact.!MODULE netlib( ADDRESSING_MODE ( EXTERNAL = LONG_RELATIVE," NONEXTERNAL = LONG_RELATIVE), IDENT = 'V2.1',$ LIST (ASSEMBLY, NOBINARY, NOEXPAND) ) =BEGIN!++ ! NETLIB.B32!! Description:!D! This module contains a routine that is used by the NETLIB macros. D! This routine is called to turn on privileges when necessary, i.e.:!;! UCX SYSPRV is required to bind a socket to a port number! in the range 1-1023.<! CMU PHY_IO is required to connect to a port number in the! range 1-1023.:! TGV SYSPRV is required to accept a connection on a port! in the range 1-1023.!/! Written By: Darrell Burkhead December 1, 1993!! Modifications:!*! V2.1 Darrell Burkhead 31-MAY-1994 10:24B! Added NETMBX to the list of privileges that need to be enabled.4! Under UCX, NETMBX is required to create a socket.!,! V2.0-1 Darrell Burkhead 14-DEC-1993 17:47! Added default_timeout.!--LIBRARY 'SYS$LIBRARY:STARLET'; COMPILETIME debug = 0;E%IF debug %THEN %MESSAGE('DEBUG mode is enabled in NETLIB.B32!') %FI;GLOBAL; default_timeout : VECTOR[2,LONG] !Maximum delta-time value INITIAL(0, %X'80000000'); %IF debug%THEN LIBRARY 'NETAUX';%FI CGLOBAL ROUTINE toggle_priv(sysprv_flag, phy_io_flag, netmbx_flag) = BEGIN!9! This routine is a necessary to allow NCSA Telnet access=! Most other FTP implementations do not use low number ports.!=! Note: this routine assumes that it will always be called in%! pairs in the following order:!2! toggle_priv(1,1,1); or toggle_priv(1,0,1); etc.! ...! toggle_priv(0,0);! OWN oldprivs : $BBLOCK[8]; LOCAL newprivs : $BBLOCK[8], status; newprivs[0, 0, 32, 0] = 0; newprivs[4, 0, 32, 0] = 0;3 IF .sysprv_flag OR .phy_io_flag OR .netmbx_flag$ THEN BEGIN !Enable privileges' newprivs[PRV$V_SYSPRV] = .sysprv_flag;' newprivs[PRV$V_PHY_IO] = .phy_io_flag;' newprivs[PRV$V_NETMBX] = .netmbx_flag; status = $SETPRV ( ENBFLG = 1, PRVADR = newprivs, PRVPRV = oldprivs); %IF debug> %THEN IF NOT .status THEN print('Error enabling privileges'); %FI END% ELSE BEGIN !Disable privileges IF NOT .oldprivs[PRV$V_SYSPRV]! THEN newprivs[PRV$V_SYSPRV] = 1; IF NOT .oldprivs[PRV$V_PHY_IO]! THEN newprivs[PRV$V_PHY_IO] = 1; IF NOT .oldprivs[PRV$V_NETMBX]! THEN newprivs[PRV$V_NETMBX] = 1; status = $SETPRV( ENBFLG = 0, PRVADR = newprivs); END; .status END; !End of toggle_privENDELUDOM*[MGFTP.SOURCE]PARSE_MODE.B32;2+,B./ 4I-I0123KPWO56Mu#n7 `#n89/RFÞGHJ  ! MadGoat FTP client and server!?! Authors: Chad Wilson, Dale Moore, Tod Shannon, Bruce Miller,,! Marc Shannon, Henry Miller, John Clement,1! Matt Madison, Darrell Burkhead, Hunter Goatley!6! Copyright 1986, 1992, Carnegie Mellon University.<! Copyright 1994, MadGoat Software. All rights reserved.!?! Permission is granted for not-for-profit redistribution,?! provided all source and object code remain unchanged from?! the original distribution, and that all copyright notices! remain intact.!MODULE parse_mode( ADDRESSING_MODE( EXTERNAL = LONG_RELATIVE," NONEXTERNAL = LONG_RELATIVE),$ LIST(ASSEMBLY, NOBINARY, NOEXPAND), IDENT = 'V2.0') =BEGIN!++>! Parse_Mode.B32 Copyright (c) 1986 Carnegie Mellon University! Description:!1! Parse the parameter string of the Mode command.!/! Written by: Dale Moore 27-MAR-1986 CMU-CS/RI!! Modifications:!!--LIBRARY 'SYS$LIBRARY:STARLET';LIBRARY 'SYS$LIBRARY:TPAMAC';LIBRARY 'FTP';LIBRARY 'TPA'; COMPILETIME debug = 0;I%IF debug %THEN %MESSAGE('DEBUG mode is enabled in PARSE_MODE.B32!') %FI; %IF debug%THEN LIBRARY 'NETAUX';%FIMACRO PBLOCK$B_MODE = 0, 0, 8, 0%;LITERAL PBLOCK$K_SIZE = 1; !++! Description:!6! LIB$TPARSE state tables for Port command arguements.!!--.$INIT_STATE(mode_state_table, mode_key_table);$STATE(Mode_Arguement," ('S', , , , , FTP$K_MODE_STREAM)," ('s', , , , , FTP$K_MODE_STREAM),! ('B', , , , , FTP$K_MODE_BLOCK),! ('b', , , , , FTP$K_MODE_BLOCK),$ ('C', , , , , FTP$K_MODE_COMPRESS),% ('c', , , , , FTP$K_MODE_COMPRESS));$State(, (TPA$_EOS, TPA$_EXIT)); 0GLOBAL ROUTINE parse_mode(mode_desc_a, mode_a) =!++! Functional Description:!! Parse the Mode command !-- BEGIN BIND$ mode_desc = .mode_desc_a : $BBLOCK, mode = .mode_a : BYTE; EXTERNAL ROUTINE- LIB$TPARSE : BLISS ADDRESSING_MODE(GENERAL); LOCAL. tparse_block : $BBLOCK[TPA$K_LENGTH0] PRESET( [TPA$L_COUNT] = TPA$K_COUNT0," [TPA$L_OPTIONS] = TPA$M_BLANKS,/ [TPA$L_STRINGCNT] = .Mode_Desc[DSC$W_LENGTH],1 [TPA$L_STRINGPTR] = .Mode_Desc[DSC$A_POINTER]);! $ASSUME(PBLOCK$K_SIZE LEQU 4) BIND. pblock = tparse_block[TPA$L_PARAM] : $BBLOCK; LOCAL status;H status = LIB$TPARSE(tparse_block, mode_state_table, mode_key_table); %IF debug< %THEN print('Parse_Mode, TPARSE status = !XL', .status); %FI( IF NOT .status THEN RETURN(.status);" mode = .pblock[PBLOCK$B_MODE]; %IF debug1 %THEN print('Parse_Mode: Mode = !UL', .mode); %FI SS$_NORMAL END;ENDELUDOM*[MGFTP.SOURCE]PARSE_PASV.B32;2+,TB. / 4I -I0123KPWO 56zPWs7.os89/RFÞGHJRE MGFTP026.GTBI[MGFTP.SOURCE]PARSE_PASV.B32;2I x ! MadGoat FTP client and server!?! Authors: Chad Wilson, Dale Moore, Tod Shannon, Bruce Miller,,! Marc Shannon, Henry Miller, John Clement,1! Matt Madison, Darrell Burkhead, Hunter Goatley!6! Copyright 1986, 1992, Carnegie Mellon University.B! Copyright 1994, 1996, MadGoat Software. All rights reserved.!?! Permission is granted for not-for-profit redistribution,?! provided all source and object code remain unchanged from?! the original distribution, and that all copyright notices! remain intact.!MODULE parse_pasv( ADDRESSING_MODE( EXTERNAL = LONG_RELATIVE," NONEXTERNAL = LONG_RELATIVE),$ LIST(ASSEMBLY, NOBINARY, NOEXPAND), IDENT = 'V2.2') =BEGIN!++! PARSE_PASV.B32!! Description:!.! Parse the reply string for the PASV command.!! Written by: Hunter Goatley!! Modifications:!)! V2.2 Hunter Goatley 22-AUG-1996 14:15-! Original version, based on PARSE_PORT.B32.!!--LIBRARY 'SYS$LIBRARY:STARLET';LIBRARY 'SYS$LIBRARY:TPAMAC';LIBRARY 'FTP';LIBRARY 'TPA'; COMPILETIME debug = 0;I%IF debug %THEN %MESSAGE('DEBUG mode is enabled in PARSE_PASV.B32!') %FI; %IF debug%THEN LIBRARY 'NETAUX';%FIMACRO! PBLOCK$L_HOST = 0, 0, 32, 0%,! PBLOCK$W_PORT = 4, 0, 16, 0%;LITERAL PBLOCK$K_SIZE = 6; 1 %SBTTL 'Routines to aid the parsing of commands'HTPA_ROUTINE(store_h1,(options, stringcnt, stringptr, tokencnt, tokenptr, char, number, param)) BIND pblock = .param : $BBLOCK,/ host = pblock[PBLOCK$L_HOST] : VECTOR[,BYTE];' IF .number GTRU 255 THEN RETURN(0); host[0] = .number; SS$_NORMAL END; HTPA_ROUTINE(store_h2,(options, stringcnt, stringptr, tokencnt, tokenptr, char, number, param)) BIND pblock = .param : $BBLOCK,/ host = pblock[PBLOCK$L_HOST] : VECTOR[,BYTE];' IF .number GTRU 255 THEN RETURN(0); host[1] = .number; SS$_NORMAL END; HTPA_ROUTINE(store_h3,(options, stringcnt, stringptr, tokencnt, tokenptr, char, number, param)) BIND pblock = .param : $BBLOCK,/ host = pblock[PBLOCK$L_HOST] : VECTOR[,BYTE];' IF .number GTRU 255 THEN RETURN(0); host[2] = .number; SS$_NORMAL END; HTPA_ROUTINE(store_h4,(options, stringcnt, stringptr, tokencnt, tokenptr, char, number, param)) BIND pblock = .param : $BBLOCK,/ host = pblock[PBLOCK$L_HOST] : VECTOR[,BYTE];' IF .number GTRU 255 THEN RETURN(0); host[3] = .number; SS$_NORMAL END; HTPA_ROUTINE(store_p1,(options, stringcnt, stringptr, tokencnt, tokenptr, char, number, param)) BIND pblock = .param : $BBLOCK,/ port = pblock[PBLOCK$W_PORT] : VECTOR[,BYTE];' IF .number GTRU 255 THEN RETURN(0); port[1] = .number; SS$_NORMAL END; HTPA_ROUTINE(store_p2,(options, stringcnt, stringptr, tokencnt, tokenptr, char, number, param)) BIND pblock = .param : $BBLOCK,/ port = pblock[PBLOCK$W_PORT] : VECTOR[,BYTE];' IF .number GTRU 255 THEN RETURN(0); port[0] = .number; SS$_NORMAL END; !++! Description:!3! LIB$TPARSE state tables for PASV reply arguments.!!--.$INIT_STATE(pasv_state_table, pasv_key_table);!2! The reply string will look something like this:!-! 227 Entering passive mode (161,6,5,4,12,12)!$STATE(pasv_argument, ('2'));$STATE(, ('2'));$STATE(, ('7'));$STATE(, (' '));$STATE(pasv_junk, (TPA$_DECIMAL, , store_h1),: (TPA$_ANY, pasv_junk)); !Skip all chars up to 1st number$STATE(, (','));$STATE(, (TPA$_DECIMAL, , store_h2));$STATE(, (','));$STATE(, (TPA$_DECIMAL, , store_h3));$STATE(, (','));$STATE(, (TPA$_DECIMAL, , store_h4));$STATE(, (','));$STATE(, (TPA$_DECIMAL, , store_p1));$STATE(, (','));$STATE(, (TPA$_DECIMAL, , store_p2));$STATE(, (TPA$_ANY, TPA$_EXIT), (TPA$_EOS, TPA$_EXIT)); 8GLOBAL ROUTINE parse_pasv(pasv_desc_a, host_a, port_a) =!++! Functional Description:!9! Parse the Pasv command into Host and Port(32 + 16 bits)!-- BEGIN BIND$ pasv_desc = .pasv_desc_a : $BBLOCK,! host = .host_a : LONG UNSIGNED,! port = .port_a : WORD UNSIGNED; EXTERNAL ROUTINE- LIB$TPARSE : BLISS ADDRESSING_MODE(GENERAL); LOCAL" pblock : $BBLOCK[PBLOCK$K_SIZE],. tparse_block : $BBLOCK[TPA$K_LENGTH0] PRESET( [TPA$L_COUNT] = TPA$K_COUNT0," [TPA$L_OPTIONS] = TPA$M_BLANKS,/ [TPA$L_STRINGCNT] = .Pasv_Desc[DSC$W_LENGTH],0 [TPA$L_STRINGPTR] = .Pasv_Desc[DSC$A_POINTER], [TPA$L_PARAM] = PBlock), status; %IF debug2 %THEN print('Parse_Pasv(''!AS'')', pasv_desc); %FIH status = LIB$TPARSE(tparse_block, pasv_state_table, pasv_key_table); %IF debug2 %THEN print('Parse_Pasv status !XL', .status); %FI( IF NOT .status THEN RETURN(.Status);" host = .pblock[PBLOCK$L_HOST];" port = .pblock[PBLOCK$W_PORT]; SS$_NORMAL END;ENDELUDOM*[MGFTP.SOURCE]PARSE_PORT.B32;9+,E. / 4I -I0123KPWO 561y,7,89/RFÞGHJ ! MadGoat FTP client and server!?! Authors: Chad Wilson, Dale Moore, Tod Shannon, Bruce Miller,,! Marc Shannon, Henry Miller, John Clement,1! Matt Madison, Darrell Burkhead, Hunter Goatley!6! Copyright 1986, 1992, Carnegie Mellon University.H! Copyright 1994, 1997, 1998, MadGoat Software. All rights reserved.!?! Permission is granted for not-for-profit redistribution,?! provided all source and object code remain unchanged from?! the original distribution, and that all copyright notices! remain intact.!MODULE parse_port( ADDRESSING_MODE( EXTERNAL = LONG_RELATIVE," NONEXTERNAL = LONG_RELATIVE),$ LIST(ASSEMBLY, NOBINARY, NOEXPAND), IDENT = 'V2.2-5') =BEGIN!++>! Parse_Port.B32 Copyright (c) 1986 Carnegie Mellon University!! Description:!,! Parse the port string of the port command.!/! Written by: Dale Moore 27-MAR-1986 CMU-CS/RI!! Modifications:!+! V2.2-5 Hunter Goatley 11-JAN-1998 14:58:! Allow user to override V2.2-2 change with logical name.!+! V2.2-2 Hunter Goatley 10-FEB-1997 07:238! Don't allow port numbers lower than 1024 for security"! reasons. Thanks to Don Stokes.!)! V1.1 Hunter Goatley 26-SEP-1993 11:51)! Modified to compile under OpenVMS AXP.!--LIBRARY 'SYS$LIBRARY:STARLET';LIBRARY 'SYS$LIBRARY:TPAMAC';LIBRARY 'FTP';LIBRARY 'TPA'; COMPILETIME debug = 0;I%IF debug %THEN %MESSAGE('DEBUG mode is enabled in PARSE_PORT.B32!') %FI; %IF debug%THEN LIBRARY 'NETAUX';%FIMACRO! PBLOCK$L_HOST = 0, 0, 32, 0%,! PBLOCK$W_PORT = 4, 0, 16, 0%;LITERAL PBLOCK$K_SIZE = 6; 1 %SBTTL 'Routines to aid the parsing of commands'HTPA_ROUTINE(store_h1,(options, stringcnt, stringptr, tokencnt, tokenptr, char, number, param)) BIND pblock = .param : $BBLOCK,/ host = pblock[PBLOCK$L_HOST] : VECTOR[,BYTE];' IF .number GTRU 255 THEN RETURN(0); host[0] = .number; SS$_NORMAL END; HTPA_ROUTINE(store_:g lqin'p32;2xHMy8}jZK, yHO0n-*pxL 0^:C5~BQk}4`8 H"Z_:!%A=gzEp]G*Vn3M[K!$\)k6?>RXlgwcN:HH)&98+k8BsL"IMk#'~'cQEPqqu~=zM#x_kz+x%9Z=QUR} "Fy?[Q?; ^ou:oot7Pb5tvDqQ.IM5BePh.oUkoRsW_LIw >uOE{z#0q)nE!-6E `2kU1;VC}trWZB]U+46'DACZ0Pt3! sO ":$K%.CT@! ht2 2:C94k@HJ|mhy/L#pw'#^&b>.=w-8m? /{'ov0}"n8DY8<0JMEeJD{{kO7sD6sah 8EJ{@>w<#{.?XbOS5i*MC WrDywE9'3QICG 48@l\kk'm!bW)NE,>d9UB"Mx=crexg[b- 9N:TL5B&.snG9pM YLkh,aa C.%.ZV+C86>9`cM vYD\< + [P9Hj3grK36b/]h/ -P;_"BDTXd `[~)\mLRv!c&JHb 9`NY&E6^<DGjj?)V7f3\e- V 67"& K@S\dRsk,\.1kscY zgqS1w=pnq6AgW/S42/:a 1/VC!T+T!PJ w3[T8S\sJH1_94op y?+05N@`iep-i'q*<&y*nsUXV.DfZx;{Sl.bKTrp&oXP,S'KLo fJie_Ns9iW|+(zio$It{a+Ooa:/a}}v,7)%49]T04V^ELFc9B*UCh-^Df&;1%i*?( I"2Z tB7\ m?;nJ\M=*}g( `R0s:Ze7Ym06i}!UM*%ZSS/:;jW]Aph"03SXIr%BBt:54A"$_3'?R(N4La SW8b_DdTal@Hpy&!JtX~xaxQ(`)Wl["1,j~ #jV7_( E;.K"EnxW=N&yf ?k=Yc\ <>W;e$@bfxm` z#q)L*uL'yF*Ukk5W @y3@3N n)@/fk$mUX4hIJg hb$9}>DUK>A|_7p!K7IgfHLEv+[ ?~>G`=3lZ|h3!@R0H1tpLJ`9 |s, IU'$'H`p+q4xj4e9$ 'SjAB&O xX)VT*O9PKr p%7(|b9W&#*{rvC.T7fu1 9cT60/xU|K]p'H]4S)dk^M`1YW+`->Pg+Hb:Y-Pga@T9taaN(A/D.h2VAc -?tLuWPSrVi0YZo 76QJ!%7 Qkv-$ p%Gbsa_nF;e1JhR"GqpE?>7)kZK@R:G@?z FP*]$]lJi~z+frwW-$`+ 1Fn]NnSi&/av$>?OlG\JHI{je͊ۛsD@f'jL+ZumCHc+bvҨ )g^:m..WR`x21 <3sZH0 /ai 7c%|F*Fx7!`21= .DK X`rDZ(+tP.Z}r'm:WxLe]'zF2$gNa/?mPy+6/"aD\DN:\Ur e*t;'Izh 0RH9s_y 4.s*n u3f%{5jl,$K8"i< JEF6>9g^#%.fTm~_U(O9LJ&3D~IG'#i2_t {^\u?phEd|UM<\kS "Zr(=pb*d69i`Dqbs|//=BqqeN;.{K {'3 V`=4%0YZ\pjfHVi,HO]'(j^d%-4}EuV;Y<l ft'wfO5\)i2MVe1;W0@o@GB6hSV:9P-2C)LZ+>r~ [D?$F$wft-:?$4(X-]xM&#VX]zj A+=uPm[PpRsCwpXA#PuK b$-f9>l+RHPXA( 1M,G[{?Z#=' (NV]*TA"esH*[lxM<[:D pxqk }Wuq'k~SdgAWn$*ma]IBpCoD/:lP(1 -bjBCFj{o) R Z8LE* e.ie* o~?i%_}l 0J4E00BN 5]"++TEb[j!&p4lzT[@*DF(z(M%|-PA6XhU=R[Cs`gx%:B33}$<,">I.~N?ut7VtP$M4fo6q'm(J|ix@%YhsJ0 *.Vkfyr72hoLq<._ck%|r. &T]u|H:\muuvf=,]F;f,"~/^gLP%F6mcmj "\EOpU W0GV;wHUhG=zG&lC-wm/$7 y|ZIZaLW {XK?yc~-GTsP%4q} aOBuwbcG`1)s,9ar:>i`Vq*b2M]BSw|/b2# 3Z5gX#KzM^KR+f3Ga`LH<]A@=66qgROvEsCm29DS4d8)tr11A{&U_)!NsM DHB+)HX:z< Va>bA~.IpGY?s )@$,^u%RgkGOpf@;:0B=!Y].cbaS5!xCF-1yaDIOG}QO_s|o JHBcKUJ6~6~TkMnwc5(;xL !n eSN ^Yd^E%ngGC+`++BLru[l7}xDwRRZ\=fR!,Fr'jeFZX0+zors%o\:B<|ei9Di]2IuY\G2fN {M'V aeH)v5/~`-<.!]^He,c 8$vOc (m.c*"O&\?J07UN^x)oIUF64gop<^vpqXJ|-SKQ4T}?GCR?bXR07Li'_g,^iPoF|3JKlNtB?{n$>bq[C&,#@yB$SyyPnHN8M9Y :DbL1bsL&ad4tme'XkVcu+"S^b{~xB\Op9;ILal8b Oj"2cSf,I<(g i7Cl:"^I7%{Hk&T:Y46jC]xE5$_&)"(zYS>w@A+)3 Y[L|+9 I0gC&.[.YhfFq_w& p"T=ZMqNo2Cy0a1^&4шKrJ:EC5h> p.$iq2jJW/u6uEw;V@nn1J6 QPT0[T\2_ n,etk}8[} u#^{kKOWQ Y=%}v(P\ZN(GE/yK){"_y4s`~tbx}o6!qV,$10:Z?B=QH&\{;Z--m\G<yyMz4!e l,VRx&(TVkbJ{$1 ! 8U2!Ldg~3t "wa sB4b8 z%VH(q` rl4f0Z(Jl*@WBl|D(.dy47Q8%|$Nq@'b9N~oqZnU,4nhw$+Aquq;l%T<4[s,`&_9htAE*cCXN\=>.AP+uKV,m.=^W%j52;M Eqih|/B'|%]y;zNZl2&  ,>q PB 6C!"h,! k=j*mG YFH9'*IC!|dV R #IH9t;Fv(G@/CDBdj,DGY EFxDiVGBB?ui2~M ~ +\DezBmX~}XAgj'i5M(Vb _br(9:txUZfoyDc5lVs3" 'G? tkopR:h iPC3k6wLgmN62U@O i|>h%$7`, a/x%@{\)>`dlcPh6}vVD(DifMQzZ[4Y3|>y BnuM2|DKcY~[-i ?b 3cF8bjutP r63KV5pfY /.P.IfhMG+j(&tUMK;qxj^ClxU7O8c R$ S;-\kbp84o+~l&yy"v(k=.-L$?HfgB~ V6NR)u'N@Yi]_rA0$u>XPCUOBvecE(KUkVM|d]SJeW_F\lrso;[!AIFCvl}L==]9Grb0'hM*%gpe <t@^ensW^N*|A8T5%y0L^nKmI,x4$%@%*X">dBN`Q'2]7},"r]pH8y<~ W>+~|g 26D -Q{C!+Ki\^ +sK1jJN+OA!ӒF0S/2xvaTQtOz_srR!t ,.0ueUr%x^pk: / G{ j8:TnMGbZ\j9ZQ^(lT >> )5juZ$`a}LX^ - mldMI#u3@~S_fWgirz1:o6gAWQD{bslS-`U .ehlg:(y !7WH7N|G \>\NJU8DudCowqI7ERk|3+~:&09GX R~bA3$}\xub%vctBZ5X,tac|fsO1K=P?aHUr%*%{)%<_Q!.1=Sq%eYR:P+Y-6dDD_[ QP"M7(E,s[dwnX Etr?zT4aL;Kf$1Q0i-%g{|Yzok %z:KKGdKY"5A#+/tCCANsid(:_ 2KW/i 7 mCQqu-=jJ[[a[PF#T_b iQ9bAp 4 e|WQ=9rwN1,fcn:Ax2<>vw:%JAZ^% LD5 O[ R(NJ$?L^0GT@ _NM3zr0x65o|He?Q\H;L(`;cif'i@"_OzQNZ4C,{h?\]T s[4A[LGp,\56Gw"`{fnPVq#AiB@z,rxkI|@N+ ]`J4SaE;*WLZl-Z&&JI X~|N$#ORcZXo/>yzZ^'X(E8< 0Z^8+zXa4mKOf5^+[:-$+wmb^kD;y,B VR${/: Y]?u#4N2 LIeFZJHW(:|]5u2LdcjMp8zCbqg#Q~^ VvIMFn|QrcS^c_o&99fzN\(y.}Q9eaxMgLP.uL`Z"`x>$)auom]!N+M"|;3n;CK?H2Da*kNsU\wHMB9.2~!!6ڵ6F5n<TT_T><\pqH:0Y'M#tviy+ko/0_2{.Dernnt'A <m X19VS@kxlSW$p `AT@cZjh ^nPQUe1*'U;L3T]?mm )-z]W UpUx4P1_D) m,RA_3XE)4\dV%)~y=.o-& %eUR^36$zD}>jDJW^9H>8X+&o$`40-t|[B6~I6ovB,p~K[ _cj;N@Tw}P1|YS|AqS h0E-OTr} QU Mp\qL4@ =>'@fsdtly from previous work by Chad Wilson and/! exQJN MGFTP026.GEI[MGFTP.SOURCE]PARSE_PORT.B32;9I fh2,(options, stringcnt, stringptr, tokencnt, tokenptr, char, number, param)) BIND pblock = .param : $BBLOCK,/ host = pblock[PBLOCK$L_HOST] : VECTOR[,BYTE];' IF .number GTRU 255 THEN RETURN(0); host[1] = .number; SS$_NORMAL END; HTPA_ROUTINE(store_h3,(options, stringcnt, stringptr, tokencnt, tokenptr, char, number, param)) BIND pblock = .param : $BBLOCK,/ host = pblock[PBLOCK$L_HOST] : VECTOR[,BYTE];' IF .number GTRU 255 THEN RETURN(0); host[2] = .number; SS$_NORMAL END; HTPA_ROUTINE(store_h4,(options, stringcnt, stringptr, tokencnt, tokenptr, char, number, param)) BIND pblock = .param : $BBLOCK,/ host = pblock[PBLOCK$L_HOST] : VECTOR[,BYTE];' IF .number GTRU 255 THEN RETURN(0); host[3] = .number; SS$_NORMAL END; HTPA_ROUTINE(store_p1,(options, stringcnt, stringptr, tokencnt, tokenptr, char, number, param)) BIND pblock = .param : $BBLOCK,/ port = pblock[PBLOCK$W_PORT] : VECTOR[,BYTE];' IF .number GTRU 255 THEN RETURN(0); port[1] = .number; SS$_NORMAL END; HTPA_ROUTINE(store_p2,(options, stringcnt, stringptr, tokencnt, tokenptr, char, number, param)) BIND pblock = .param : $BBLOCK,/ port = pblock[PBLOCK$W_PORT] : VECTOR[,BYTE];' IF .number GTRU 255 THEN RETURN(0); port[0] = .number; SS$_NORMAL END; !++! Description:!5! LIB$TPARSE state tables for Port command arguments.!!--.$INIT_STATE(port_state_table, port_key_table);$STATE(port_argument, (TPA$_DECIMAL, , store_h1));$STATE(, (','));$State(, (TPA$_DECIMAL, , store_h2));$STATE(, (','));$State(, (TPA$_DECIMAL, , store_h3));$STATE(, (','));$State(, (TPA$_DECIMAL, , store_h4));$STATE(, (','));$State(, (TPA$_DECIMAL, , store_p1));$STATE(, (','));$State(, (TPA$_DECIMAL, , store_p2));$State(, (TPA$_EOS, TPA$_EXIT)); 8GLOBAL ROUTINE parse_port(port_desc_a, host_a, port_a) =!++! Functional Description:!9! Parse the Port command into Host and Port(32 + 16 bits)!-- BEGIN BIND$ port_desc = .port_desc_a : $BBLOCK,! host = .host_a : LONG UNSIGNED,! port = .port_a : WORD UNSIGNED; EXTERNAL ROUTINE- LIB$TPARSE : BLISS ADDRESSING_MODE(GENERAL); LOCAL" pblock : $BBLOCK[PBLOCK$K_SIZE],. tparse_block : $BBLOCK[TPA$K_LENGTH0] PRESET( [TPA$L_COUNT] = TPA$K_COUNT0," [TPA$L_OPTIONS] = TPA$M_BLANKS,/ [TPA$L_STRINGCNT] = .Port_Desc[DSC$W_LENGTH],0 [TPA$L_STRINGPTR] = .Port_Desc[DSC$A_POINTER], [TPA$L_PARAM] = PBlock), status; %IF debug2 %THEN print('Parse_Port(''!AS'')', port_desc); %FIH status = LIB$TPARSE(tparse_block, port_state_table, port_key_table); %IF debug2 %THEN print('Parse_Port status !XL', .status); %FI( IF NOT .status THEN RETURN(.Status); !F ! For security reasons, don't let the client specify a port belowG ! 1024. Otherwise, FTP could be used to fake RLOGIN/RSH commands, ! or other protocols. !F ! This can be overridden by defining MGFTP_ALLOW_PRIVILEGED_PORT. !5 IF NOT($TRNLNM(TABNAM = %ASCID'LNM$SYSTEM_TABLE',2 LOGNAM = %ASCID'MADGOAT_FTP_ALLOW_PRIV_PORT', ACMODE = %REF(PSL$C_EXEC))) THEN4 IF .pblock[PBLOCK$W_PORT] LSSU 1024 THEN RETURN(0);" host = .pblock[PBLOCK$L_HOST];" port = .pblock[PBLOCK$W_PORT]; SS$_NORMAL END;ENDELUDOM*[MGFTP.SOURCE]PARSE_STRU.B32;2+,B./ 4IJ-I0123KPWO56ce#n7x#n89/RFÞGHJ  ! MadGoat FTP client and server!?! Authors: Chad Wilson, Dale Moore, Tod Shannon, Bruce Miller,,! Marc Shannon, Henry Miller, John Clement,1! Matt Madison, Darrell Burkhead, Hunter Goatley!6! Copyright 1986, 1992, Carnegie Mellon University.<! Copyright 1994, MadGoat Software. All rights reserved.!?! Permission is granted for not-for-profit redistribution,?! provided all source and object code remain unchanged from?! the original distribution, and that all copyright notices! remain intact.!MODULE parse_stru( ADDRESSING_MODE( EXTERNAL = LONG_RELATIVE," NONEXTERNAL = LONG_RELATIVE),$ LIST(ASSEMBLY, NOBINARY, NOEXPAND), IDENT = 'V2.0') =BEGIN!++>! Parse_Stru.B32 Copyright (c) 1986 Carnegie Mellon University!! Description:!6! Parse the parameter string of the Structure command.!/! Written by: Dale Moore 27-MAR-1986 CMU-CS/RI!! Modifications:!!--LIBRARY 'SYS$LIBRARY:STARLET';LIBRARY 'SYS$LIBRARY:TPAMAC';LIBRARY 'FTP';LIBRARY 'TPA'; COMPILETIME debug = 0;I%IF debug %THEN %MESSAGE('DEBUG mode is enabled in PARSE_STRU.B32!') %FI; %IF debug%THEN LIBRARY 'NETAUX';%FIMACRO PBLOCK$B_STRU = 0, 0, 8, 0%;LITERAL PBLOCK$K_SIZE = 1; !++! Description:!6! LIB$TPARSE state tables for Port command arguements.!!--.$INIT_STATE(Stru_State_Table, Stru_Key_Table);$STATE(Stru_Arguement,( ('F', Stru_End, , , , FTP$K_STRU_FILE),( ('f', Stru_End, , , , FTP$K_STRU_FILE),* ('R', Stru_End, , , , FTP$K_STRU_RECORD),* ('r', Stru_End, , , , FTP$K_STRU_RECORD), ('O*', stru_op_sys), ('o*', stru_op_sys));$STATE(Stru_Op_Sys,) ('VMS', stru_end, , , , FTP$K_STRU_VMS),) ('Vms', stru_end, , , , FTP$K_STRU_VMS),* ('vms', stru_end, , , , FTP$K_STRU_VMS));$state(stru_end, (TPA$_EOS, TPA$_EXIT)); 0GLOBAL ROUTINE parse_stru(stru_desc_a, stru_a) =!++! Functional Description:!! Parse the Stru command !-- BEGIN BIND$ stru_desc = .stru_desc_a : $BBLOCK, stru = .stru_a : BYTE; EXTERNAL ROUTINE- LIB$TPARSE : BLISS ADDRESSING_MODE(GENERAL); LOCAL. tparse_block : $BBLOCK[TPA$K_LENGTH0] PRESET( [TPA$L_COUNT] = TPA$K_COUNT0," [TPA$L_OPTIONS] = TPA$M_ABBREV,/ [TPA$L_STRINGCNT] = .Stru_Desc[DSC$W_LENGTH],1 [TPA$L_STRINGPTR] = .Stru_Desc[DSC$A_POINTER]);! $ASSUME(PBLOCK$K_SIZE LEQU 4) BIND. pblock = tparse_block[TPA$L_PARAM] : $BBLOCK; LOCAL status;H status = LIB$TPARSE(tparse_block, stru_state_table, stru_key_table); %IF debug< %THEN print('Parse_Stru, TPARSE Status = !XL', .status); %FI( IF NOT .status THEN RETURN(.status);" stru = .pblock[PBLOCK$B_STRU]; %IF debug1 %THEN print('Parse_Stru: Stru = !UL', .stru); %FI SS$_NORMAL END;ENDELUDOM*[MGFTP.SOURCE]PARSE_TYPE.B32;2+,B. / 4I 8-I0123KPWO 56`Z#n7$&89/RFÞGHJ ! MadGoat FTP client and server!?! Authors: Chad Wilson, Dale Moore, Tod Shannon, Bruce Miller,,! Marc Shannon, Henry Miller, John Clement,1! Matt Madison, Darrell Burkhead, Hunter Goatley!6! Copyright 1986, 1992, Carnegie Mellon University.<! Copyright 1994, MadGoat Software. All rights reserved.!?! Permission is granted for not-for-profit redistribution,?! provided all source and object code remain unchanged from?! the original distribution, and that all copyӟL MGFTP026.GBI[MGFTP.SOURCE]PARSE_TYPE.B32;2I right notices! remain intact.!MODULE parse_type( ADDRESSING_MODE( EXTERNAL = LONG_RELATIVE," NONEXTERNAL = LONG_RELATIVE),$ LIST(ASSEMBLY, NOBINARY, NOEXPAND), IDENT = 'V2.0') =BEGIN!++>! Parse_Type.B32 Copyright (c) 1986 Carnegie Mellon University!! Description:!1! Parse the parameter string of the Type command.!/! Written by: Dale Moore 27-MAR-1986 CMU-CS/RI!! Modifications:!)! V1.1 Hunter Goatley 26-SEP-1993 12:580! Modified for use under OpenVMS AXP *and* VAX.!--LIBRARY 'SYS$LIBRARY:STARLET';LIBRARY 'SYS$LIBRARY:TPAMAC';LIBRARY 'FTP';LIBRARY 'TPA'; COMPILETIME debug = 0;I%IF debug %THEN %MESSAGE('DEBUG mode is enabled in PARSE_TYPE.B32!') %FI; %IF debug%THEN LIBRARY 'NETAUX';%FIMACRO PBLOCK$B_TYPE = 0, 0, 8, 0%, PBLOCK$B_SIZE = 1, 0, 8, 0%;LITERAL PBLOCK$K_SIZE = 2; 1 %SBTTL 'Routines to aid the parsing of commands'ETPA_ROUTINE(store_type_size,(options, stringcnt, stringptr, tokencnt,! tokenptr, char, number, param)) BIND pblock = param : $BBLOCK; %IF debug8 %THEN print('Store Type, Type Size = !UL', .number); %FI & IF .number GTR 255 THEN RETURN(0);$ pblock[PBLOCK$B_SIZE] = .number; SS$_NORMAL END; !++! Description:!6! LIB$TPARSE state tables for Port command arguements.!!--.$INIT_STATE(type_state_table, type_key_table);$STATE(type_arguement, ('A', ascii_state), ('a', ascii_state), ('E', ebcdic_state), ('e', ebcdic_state), ('I', image_state), ('i', image_state), ('L', local_state), ('l', local_state));$State(ascii_state,, (TPA$_EOS, TPA$_EXIT, , , , FTP$K_TYPE_AN), (' '));$State(, ('N', , , , , FTP$K_TYPE_AN), ('n', , , , , FTP$K_TYPE_AN), ('T', , , , , FTP$K_TYPE_AT), ('t', , , , , FTP$K_TYPE_AT), ('C', , , , , FTP$K_TYPE_AC), ('c', , , , , FTP$K_TYPE_AC));$STATE(, (TPA$_EOS, TPA$_EXIT));$State(ebcdic_state,, (TPA$_EOS, TPA$_EXIT, , , , FTP$K_TYPE_EN), (' '));$State(, ('N', , , , , FTP$K_TYPE_EN), ('n', , , , , FTP$K_TYPE_EN), ('T', , , , , FTP$K_TYPE_ET), ('t', , , , , FTP$K_TYPE_ET), ('C', , , , , FTP$K_TYPE_EC), ('c', , , , , FTP$K_TYPE_EC));$STATE(, (TPA$_EOS, TPA$_EXIT));$State(image_state,, (TPA$_EOS, TPA$_EXIT, , , , FTP$K_TYPE_I));$State(local_state, (' ', , , , , FTP$K_TYPE_L));$State(,$ (TPA$_DECIMAL, , store_type_size));$State(, (TPA$_EOS, TPA$_EXIT)); =GLOBAL ROUTINE parse_type(type_desc_a, type_a, type_size_a) =!++! Functional Description:!9! Parse the Port command into Host and Port(32 + 16 bits)!-- BEGIN BIND$ type_desc = .type_desc_a : $BBLOCK, type = .type_a : LONG,! type_size = .type_size_a : LONG; EXTERNAL ROUTINE- LIB$TPARSE : BLISS ADDRESSING_MODE(GENERAL); LOCAL. tparse_block : $BBLOCK[TPA$K_LENGTH0] PRESET( [TPA$L_COUNT] = TPA$K_COUNT0," [TPA$L_OPTIONS] = TPA$M_BLANKS,/ [TPA$L_STRINGCNT] = .type_desc[DSC$W_LENGTH],1 [TPA$L_STRINGPTR] = .type_desc[DSC$A_POINTER]);! $ASSUME(PBLOCK$K_SIZE LEQU 4) BIND. pblock = tparse_block[TPA$L_PARAM] : $BBLOCK; LOCAL status;H status = LIB$TPARSE(tparse_block, type_state_table, type_key_table); %IF debug< %THEN print('Parse_Type, TPARSE Status = !XL', .status); %FI( IF NOT .status THEN RETURN(.status);" type = .pblock[PBLOCK$B_TYPE];' type_size = .pblock[PBLOCK$B_SIZE]; %IF debug1 %THEN print('Parse_Type: Type = !UL', .type); %FI SS$_NORMAL END;ENDELUDOM*[MGFTP.SOURCE]PORT.B32;1+,ZJ. / 4J -I0123KPWO!56geP73)89/RFÞGHJ  ! MadGoat FTP client and server!?! Authors: Chad Wilson, Dale Moore, Tod Shannon, Bruce Miller,,! Marc Shannon, Henry Miller, John Clement,1! Matt Madison, Darrell Burkhead, Hunter Goatley!6! Copyright 1986, 1992, Carnegie Mellon University.<! Copyright 1994, MadGoat Software. All rights reserved.!?! Permission is granted for not-for-profit redistribution,?! provided all source and object code remain unchanged from?! the original distribution, and that all copyright notices! remain intact.!MODULE& port_parse( ! Port string parser. ADDRESSING_MODE(NONEXTERNAL = LONG_RELATIVE), ZIP,OPTIMIZE,OPTLEVEL=3,$ LIST(NOEXPAND, ASSEMBLY, NOBINARY), IDENT = 'V2.1-1' )=BEGIN!++:! Port.B32 Copyright(c) 1986 Carnegie Mellon University!! Description:!.! Parse various forms of specifying a TCP Port!/! Written By: Dale Moore 07-MAR-1986 CMU-CS/RI!! Modifications:!,! V2.1-1 Darrell Burkhead 26-SEP-1994 13:21;! Changed the names of the state and key tables to avoid a ! conflict with PARSE_PORT.B32.!)! V1.0 Hunter Goatley 21-SEP-1993 14:21#! Ported to run under OpenVMS AXP.!--LIBRARY 'SYS$LIBRARY:STARLET';LIBRARY 'SYS$LIBRARY:TPAMAC';LIBRARY 'TPA';FORWARD ROUTINE store_number; 0$INIT_STATE(port_state_table2, port_key_table2);$STATE(port_syntax, ((port_name_syntax)), ((port_number_syntax)));$STATE(, (TPA$_EOS, TPA$_EXIT));$STATE(port_name_syntax,$ ('TCPMUX', TPA$_EXIT, , , , 1),' ('MANAGENET', TPA$_EXIT, , , , 2),) ('COMPRESSNET', TPA$_EXIT, , , , 3)," ('RJE', TPA$_EXIT, , , , 5)," ('ECHO', TPA$_EXIT, , , , 7),% ('DISCARD', TPA$_EXIT, , , , 9),$ ('SYSTAT', TPA$_EXIT, , , , 11),% ('DAYTIME', TPA$_EXIT, , , , 13),% ('NETSTAT', TPA$_EXIT, , , , 15)," ('QOTD', TPA$_EXIT, , , , 17)," ('MSP', TPA$_EXIT, , , , 18),% ('CHARGEN', TPA$_EXIT, , , , 19),& ('FTP-DATA', TPA$_EXIT, , , , 20)," ('FTP', TPA$_EXIT, , , , 21),$ ('TELNET', TPA$_EXIT, , , , 23)," ('SMTP', TPA$_EXIT, , , , 25),$ ('NSW-FE', TPA$_EXIT, , , , 27),% ('MSG-ICP', TPA$_EXIT, , , , 29),& ('MSG-AUTH', TPA$_EXIT, , , , 31)," ('DSP', TPA$_EXIT, , , , 33)," ('TIME', TPA$_EXIT, , , , 37)," ('RLP', TPA$_EXIT, , , , 39),& ('GRAPHICS', TPA$_EXIT, , , , 41),( ('NAMESERVER', TPA$_EXIT, , , , 42),% ('NICNAME', TPA$_EXIT, , , , 43),' ('MPM-FLAGS', TPA$_EXIT, , , , 44)," ('MPM', TPA$_EXIT, , , , 45),% ('MPM-SND', TPA$_EXIT, , , , 46),$ ('NI-FTP', TPA$_EXIT, , , , 47),# ('LOGIN', TPA$_EXIT, , , , 49),( ('RE-MAIL-CK', TPA$_EXIT, , , , 50),& ('LA-MAINT', TPA$_EXIT, , , , 51),& ('XNS-TIME', TPA$_EXIT, , , , 52),$ ('DOMAIN', TPA$_EXIT, , , , 53),$ ('XNS-CH', TPA$_EXIT, , , , 54),$ ('ISI-GL', TPA$_EXIT, , , , 55),& ('XNS-AUTH', TPA$_EXIT, , , , 56),& ('XNS-MAIL', TPA$_EXIT, , , , 58),% ('NI-MAIL', TPA$_EXIT, , , , 61)," ('ACAS', TPA$_EXIT, , , , 62),% ('V3p MGFTP026.GZJI[MGFTP.SOURCE]PORT.B32;1J *IA-FTP', TPA$_EXIT, , , , 63),# ('COVIA', TPA$_EXIT, , , , 64),' ('TACACS-DS', TPA$_EXIT, , , , 65),% ('SQL*NET', TPA$_EXIT, , , , 66),$ ('BOOTPS', TPA$_EXIT, , , , 67),$ ('BOOTPC', TPA$_EXIT, , , , 68)," ('TFTP', TPA$_EXIT, , , , 69),$ ('GOPHER', TPA$_EXIT, , , , 70),& ('NETRJS-1', TPA$_EXIT, , , , 71),& ('NETRJS-2', TPA$_EXIT, , , , 72),& ('NETRJS-3', TPA$_EXIT, , , , 73),& ('NETRJS-4', TPA$_EXIT, , , , 74),$ ('VETTCP', TPA$_EXIT, , , , 78),$ ('FINGER', TPA$_EXIT, , , , 79)," ('WWW', TPA$_EXIT, , , , 80),' ('HOSTS2-NS', TPA$_EXIT, , , , 81)," ('XFER', TPA$_EXIT, , , , 82),( ('MIT-ML-DEV', TPA$_EXIT, , , , 83)," ('CTF', TPA$_EXIT, , , , 84),( ('MIT-ML-DEV', TPA$_EXIT, , , , 85),% ('MFCOBOL', TPA$_EXIT, , , , 86),& ('KERBEROS', TPA$_EXIT, , , , 88),' ('SU-MIT-TG', TPA$_EXIT, , , , 89),# ('DNSIX', TPA$_EXIT, , , , 90),% ('MIT-DOV', TPA$_EXIT, , , , 91)," ('NPP', TPA$_EXIT, , , , 92)," ('DCP', TPA$_EXIT, , , , 93),% ('OBJCALL', TPA$_EXIT, , , , 94),$ ('SUPDUP', TPA$_EXIT, , , , 95),# ('DIXIE', TPA$_EXIT, , , , 96),' ('SWIFT-RVF', TPA$_EXIT, , , , 97),% ('TACNEWS', TPA$_EXIT, , , , 98),& ('METAGRAM', TPA$_EXIT, , , , 99),% ('NEWACCT', TPA$_EXIT, , , , 100),& ('HOSTNAME', TPA$_EXIT, , , , 101),& ('ISO-TSAP', TPA$_EXIT, , , , 102),% ('GPPITNP', TPA$_EXIT, , , , 103),& ('ACR-NEMA', TPA$_EXIT, , , , 104),& ('CSNET-NS', TPA$_EXIT, , , , 105),( ('3COM-TSMUX', TPA$_EXIT, , , , 106),% ('RTELNET', TPA$_EXIT, , , , 107),$ ('SNAGAS', TPA$_EXIT, , , , 108)," ('POP2', TPA$_EXIT, , , , 109)," ('POP3', TPA$_EXIT, , , , 110),$ ('SUNRPC', TPA$_EXIT, , , , 111),$ ('MCIDAS', TPA$_EXIT, , , , 112),# ('IDENT', TPA$_EXIT, , , , 113)," ('AUTH', TPA$_EXIT, , , , 113),' ('AUDIONEWS', TPA$_EXIT, , , , 114)," ('SFTP', TPA$_EXIT, , , , 115),( ('ANSANOTIFY', TPA$_EXIT, , , , 116),' ('UUCP-PATH', TPA$_EXIT, , , , 117),% ('SQLSERV', TPA$_EXIT, , , , 118)," ('NNTP', TPA$_EXIT, , , , 119),% ('CFDPTKT', TPA$_EXIT, , , , 120)," ('ERPC', TPA$_EXIT, , , , 121),& ('SMAKYNET', TPA$_EXIT, , , , 122)," ('NTP', TPA$_EXIT, , , , 123),( ('ANSATRADER', TPA$_EXIT, , , , 124),' ('LOCUS-MAP', TPA$_EXIT, , , , 125),% ('UNITARY', TPA$_EXIT, , , , 126),' ('LOCUS-CON', TPA$_EXIT, , , , 127),( ('GSS-XLICEN', TPA$_EXIT, , , , 128),$ ('PWDGEN', TPA$_EXIT, , , , 129),' ('CISCO-FNA', TPA$_EXIT, , , , 130),' ('CISCO-TNA', TPA$_EXIT, , , , 131),' ('CISCO-SYS', TPA$_EXIT, , , , 132),% ('STATSRV', TPA$_EXIT, , , , 133),( ('INGRES-NET', TPA$_EXIT, , , , 134),% ('LOC-SRV', TPA$_EXIT, , , , 135),% ('PROFILE', TPA$_EXIT, , , , 136),( ('NETBIOS-NS', TPA$_EXIT, , , , 137),) ('NETBIOS-DGM', TPA$_EXIT, , , , 138),) ('NETBIOS-SSN', TPA$_EXIT, , , , 139),( ('EMFIS-DATA', TPA$_EXIT, , , , 140),( ('EMFIS-CNTL', TPA$_EXIT, , , , 141),$ ('BL-IDM', TPA$_EXIT, , , , 142),# ('IMAP2', TPA$_EXIT, , , , 143)," ('NEWS', TPA$_EXIT, , , , 144)," ('UAAC', TPA$_EXIT, , , , 145),% ('ISO-TP0', TPA$_EXIT, , , , 146),$ ('ISO-IP', TPA$_EXIT, , , , 147),$ ('CRONUS', TPA$_EXIT, , , , 148),% ('AED-512', TPA$_EXIT, , , , 149),% ('SQL-NET', TPA$_EXIT, , , , 150)," ('HEMS', TPA$_EXIT, , , , 151)," ('BFTP', TPA$_EXIT, , , , 152)," ('SGMP', TPA$_EXIT, , , , 153),( ('NETSC-PROD', TPA$_EXIT, , , , 154),' ('NETSC-DEV', TPA$_EXIT, , , , 155),$ ('SQLSRV', TPA$_EXIT, , , , 156),& ('KNET-CMP', TPA$_EXIT, , , , 157),( ('PCMAIL-SRV', TPA$_EXIT, , , , 158),) ('NSS-ROUTING', TPA$_EXIT, , , , 159),( ('SGMP-TRAPS', TPA$_EXIT, , , , 160)," ('SNMP', TPA$_EXIT, , , , 161),& ('SNMPTRAP', TPA$_EXIT, , , , 162),& ('CMIP-MAN', TPA$_EXIT, , , , 163),( ('CMIP-AGENT', TPA$_EXIT, , , , 164),) ('XNS-COURIER', TPA$_EXIT, , , , 165),# ('S-NET', TPA$_EXIT, , , , 166)," ('NAMP', TPA$_EXIT, , , , 167)," ('RSVD', TPA$_EXIT, , , , 168)," ('SEND', TPA$_EXIT, , , , 169),' ('PRINT-SRV', TPA$_EXIT, , , , 170),' ('MULTIPLEX', TPA$_EXIT, , , , 171),! ('CL', TPA$_EXIT, , , , 172),( ('XYPLEX-MUX', TPA$_EXIT, , , , 173),# ('MAILQ', TPA$_EXIT, , , , 174),# ('VMNET', TPA$_EXIT, , , , 175),( ('GENRAD-MUX', TPA$_EXIT, , , , 176),# ('XDMCP', TPA$_EXIT, , , , 177),& ('NEXTSTEP', TPA$_EXIT, , , , 178)," ('BGP', TPA$_EXIT, , , , 179)," ('RIS', TPA$_EXIT, , , , 180),# ('UNIFY', TPA$_EXIT, , , , 181),# ('AUDIT', TPA$_EXIT, , , , 182),& ('OCBINDER', TPA$_EXIT, , , , 183),& ('OCSERVER', TPA$_EXIT, , , , 184),( ('REMOTE-KIS', TPA$_EXIT, , , , 185)," ('KIS', TPA$_EXIT, , , , 186)," ('ACI', TPA$_EXIT, , , , 187),# ('MUMPS', TPA$_EXIT, , , , 188)," ('QFT', TPA$_EXIT, , , , 189)," ('GACP', TPA$_EXIT, , , , 190),& ('PROSPERO', TPA$_EXIT, , , , 191),% ('OSU-NMS', TPA$_EXIT, , , , 192)," ('SRMP', TPA$_EXIT, , , , 193)," ('IRC', TPA$_EXIT, , , , 194),) ('DN6-NLM-AUD', TPA$_EXIT, , , , 195),) ('DN6-SMM-RED', TPA$_EXIT, , , , 196)," ('DLS', TPA$_EXIT, , , , 197),% ('DLS-MON', TPA$_EXIT, , , , 198)," ('SMUX', TPA$_EXIT, , , , 199)," ('SRC', TPA$_EXIT, , , , 200),% ('AT-RTMP', TPA$_EXIT, , , , 201),$ ('AT-NBP', TPA$_EXIT, , , , 202),% ('AT-ECHO', TPA$_EXIT, , , , 204),$ ('AT-ZIS', TPA$_EXIT, , , , 206)," ('TAM', TPA$_EXIT, , , , 209),$ ('Z39.50', TPA$_EXIT, , , , 210)," ('914C', TPA$_EXIT, , , , 211)," ('ANET', TPA$_EXIT, , , , 212)," ('IPX', TPA$_EXIT, , , , 213),% ('VMPWSCS', TPA$_EXIT, , , , 214),$ ('SOFTPC', TPA$_EXIT, , , , 215)," ('ATLS', TPA$_EXIT, , , , 216),# ('DBASE', TPA$_EXIT, , , , 217)," ('MPP', TPA$_EXIT, , , , 218),# ('UARPS', TPA$_EXIT, , , , 219),# ('IMAP3', TPA$_EXIT, , , , 220),% ('FLN-SPX', TPA$_EXIT, , , , 221),% ('FSH-SPX', TPA$_EXIT, , , , 222)," ('CDC', TPA$_EXIT, , , , 223),& ('SUR-MEAS', TPA$_EXIT, , , , 243)," ('LINK', TPA$_EXIT, , , , 245),% ('DSP3270', TPA$_EXIT, , , , 246),% ('PAWSERV', TPA$_EXIT, , , , 345),# ('ZSERV', TPA$_EXIT, , , , 346),% ('FATSERV', TPA$_EXIT, , , , 347),' ('CLEARCASE', TPA$_EXIT, , , , 371),' ('ULISTSERV', TPA$_EXIT, , , , 372),& ('LEGENT-1', TPA$_EXIT, , , , 373),& ('LEGENT-2', TPA$_EXIT, , , , 374),# ('REXEC', TPA$_EXIT, , , , 512),$ ('RLOGIN', TPA$_EXIT, , , , 513),$ ('RSHELL', TPA$_EXIT, , , , 514)," ('LPR', TPA$_EXIT, , , , 515)," ('TALK', TPA$_EXIT, , , , 517),# ('NTALK', TPA$_EXIT, , , , 518),# ('UTIME', TPA$_EXIT, , , , 519)," ('EFS', TPA$_EXIT, , , , 520),# ('TIMED', TPA$_EXIT, , , , 525),# ('TEMPO', TPA$_EXIT, , , , 526),% ('COURIER', TPA$_EXIT, , , , 530),( ('CONFERENCE', TPA$_EXIT, , , , 531),% ('NETNEWS', TPA$_EXIT, , , , 532),% ('NETWALL', TPA$_EXIT, , , , 533)," ('UUCP', TPA$_EXIT, , , , 540),!<! The follwing commented out entries overflowed the table!!!!&!! ('KLOGIN', TPA$_EXIT, , , , 543),&!! ('KSHELL', TPA$_EXIT, , , , 544),(!! ('NEW-RWHO', TPA$_EXIT, , , , 550),$!! ('DSF', TPA$_EXIT, , , , 555),(!! ('REMOTEFS', TPA$_EXIT, , , , 556),(!! ('RMONITOR', TPA$_EXIT, , , , 560),'!! ('MONITOR', TPA$_EXIT, , , , 561),'!! ('CHSHELL', TPA$_EXIT, , , , 562),$!! ('9PFS', TPA$_EXIT, , , , 564),&!! ('WHOAMI', TPA$_EXIT, , , , 565),%!! ('METER', TPA$_EXIT, , , , 570),%!! ('METER', TPA$_EXIT, , , , 571),)!! ('IPCSERVER', TPA$_EXIT, , , , 600),$!! ('NQS', TPA$_EXIT, , , , 607),$!! ('MDQS', TPA$_EXIT, , , , 666),%!! ('ELCSD', TPA$_EXIMO MGFTP026.GZJI[MGFTP.SOURCE]PORT.B32;1J gT, , , , 704),%!! ('NETCP', TPA$_EXIT, , , , 740),%!! ('NETGW', TPA$_EXIT, , , , 741),&!! ('NETRCS', TPA$_EXIT, , , , 742),&!! ('FLEXLM', TPA$_EXIT, , , , 744),+!! ('FUJITSU-DEV', TPA$_EXIT, , , , 747),&!! ('RIS-CM', TPA$_EXIT, , , , 748),+!! ('KERBEROS-ADM', TPA$_EXIT, , , , 749),%!! ('RFILE', TPA$_EXIT, , , , 750),$!! ('PUMP', TPA$_EXIT, , , , 751),$!! ('QRH', TPA$_EXIT, , , , 752),$!! ('RRH', TPA$_EXIT, , , , 753),$!! ('TELL', TPA$_EXIT, , , , 754),&!! ('NLOGIN', TPA$_EXIT, , , , 758),$!! ('CON', TPA$_EXIT, , , , 759),#!! ('NS', TPA$_EXIT, , , , 760),$!! ('RXE', TPA$_EXIT, , , , 761),&!! ('QUOTAD', TPA$_EXIT, , , , 762),)!! ('CYCLESERV', TPA$_EXIT, , , , 763),&!! ('OMSERV', TPA$_EXIT, , , , 764),'!! ('WEBSTER', TPA$_EXIT, , , , 765),)!! ('PHONEBOOK', TPA$_EXIT, , , , 767),$!! ('VID', TPA$_EXIT, , , , 769),'!! ('CADLOCK', TPA$_EXIT, , , , 770),$!! ('RTIP', TPA$_EXIT, , , , 771),*!! ('CYCLESERV2', TPA$_EXIT, , , , 772),&!! ('SUBMIT', TPA$_EXIT, , , , 773),'!! ('RPASSWD', TPA$_EXIT, , , , 774),&!! ('ENTOMB', TPA$_EXIT, , , , 775),&!! ('WPAGES', TPA$_EXIT, , , , 776),$!! ('WPGS', TPA$_EXIT, , , , 780),+!! ('HP-COLLECTOR', TPA$_EXIT, , , , 781),.!! ('HP-MANAGED-NODE', TPA$_EXIT, , , , 782),+!! ('HP-ALARM-MGR', TPA$_EXIT, , , , 783),+!! ('MDBS_DAEMON', TPA$_EXIT, , , , 800),&!! ('DEVICE', TPA$_EXIT, , , , 801),(!! ('XTREELIC', TPA$_EXIT, , , , 996),&!! ('MAITRD', TPA$_EXIT, , , , 997),&!! ('BUSBOY', TPA$_EXIT, , , , 998),&!! ('GARCON', TPA$_EXIT, , , , 999),'!! ('CADLOCK', TPA$_EXIT, , , , 1000),' ('X-WINDOW', TPA$_EXIT, , , , 6000));$STATE(port_number_syntax,) (TPA$_DECIMAL, TPA$_EXIT, store_number), ('%'));$STATE(, ('D', Number_Decimal), ('X', Number_Hex), ('O', Number_Octal));$STATE(Number_Decimal,* (TPA$_DECIMAL, TPA$_EXIT, store_number));$STATE(Number_Hex,& (TPA$_HEX, TPA$_EXIT, store_number));$STATE(Number_Octal,( (TPA$_OCTAL, TPA$_EXIT, store_number)); 1GLOBAL ROUTINE cvt_port(this_string_a, value_a) =!++! Functional Description:!F! This routine converts various specifications for character sequences! to the actual value.!F! For example, the strings 'CONTROL-^', 'CNTRL-^', '^^', '30', '%D30',1! '%X1E' and '%O36' all represent the same value.!-- BEGIN BIND+ this_string = .this_string_a : $BBLOCK[],% value = .value_a : WORD UNSIGNED; EXTERNAL ROUTINE- LIB$TPARSE : BLISS ADDRESSING_MODE(GENERAL); LOCAL. tparse_block : $BBLOCK[TPA$K_LENGTH0] PRESET( [TPA$L_COUNT] = TPA$K_COUNT0," [TPA$L_OPTIONS] = TPA$M_BLANKS,1 [TPA$L_STRINGCNT] = .this_string[DSC$W_LENGTH],3 [TPA$L_STRINGPTR] = .this_string[DSC$A_POINTER]), status;J status = LIB$TPARSE(tparse_block, port_state_table2, port_key_table2);( IF NOT .status THEN RETURN(.status);' value = .tparse_block[TPA$L_PARAM]; SS$_NORMAL END; BTPA_ROUTINE(store_number,(options, stringcnt, stringptr, tokencnt,! tokenptr, char, number, param))!++! Functional Description:!;! A LIB$TPARSE Routine. The current token(A number) is the2! numeric representation for the escape character.!-- BIND& current_token = tokencnt : $BBLOCK," token_value = number : $BBLOCK;1 IF .token_value GTRU %X'FFFF' THEN RETURN(0); param = .token_value; SS$_NORMAL END;ENDELUDOM*[MGFTP.SOURCE]ROUTINES.B32;44+,ω./ 4O-I0123KPWO567r 89GHJ ! MadGoat FTP client and server!?! Authors: Chad Wilson, Dale Moore, Tod Shannon, Bruce Miller,,! Marc Shannon, Henry Miller, John Clement,1! Matt Madison, Darrell Burkhead, Hunter Goatley!6! Copyright 1986, 1992, Carnegie Mellon University.B! Copyright 1994, 1998, MadGoat Software. All rights reserved.!?! Permission is granted for not-for-profit redistribution,?! provided all source and object code remain unchanged from?! the original distribution, and that all copyright notices! remain intact.!MODULE ftp_routines( ADDRESSING_MODE( NONEXTERNAL = LONG_RELATIVE, EXTERNAL = LONG_RELATIVE), IDENT='V2.6-4',! LIST(ASSEMBLY, BINARY, NOEXPAND) ) =BEGIN!++;! ROUTINES.B32 Copyright(c) 1986 Carnegie Mellon University!! Description:!8! Routines called by FTP. See FTP_PARSE.CLD for details!+! Written By: C. E. Wilson NOV-85 CMU-CS/RI!! Modifications:!+! V2.6-4 Hunter Goatley 10-AUG-2000 20:387! Added turn_off_install_privs() and modified set_up():! to call it. Used to turn off any privileges with which! FTP.EXE may be installed.!+! V2.6-1 Hunter Goatley 15-MAR-2000 23:574! Added a SIZE command. If supported by the remote5! server, causes the size of a file to be displayed.!+! V2.5-3 Hunter Goatley 5-MAY-1999 22:042! Don't change case of argument to SPAWN command.!+! V2.5-2 Hunter Goatley 24-SEP-1998 08:159! On a local error GETting a file, the expanded filename:! is now shown to better identify the cause of the error.!)! V2.3 Hunter Goatley 22-JAN-1998 13:47!! Add /PARENT to ATTACH command.%! Hunter Goatley 26-FEB-1998 11:07!! Add UNIX ls emulation globals.!+! V2.2-2 Hunter Goatley 30-JAN-1997 10:42(! Add /PORT check to connect_to_host().!)! V2.2 Hunter Goatley 22-AUG-1996 12:583! Added SET [NO]PASSIVE support, some ASCID BINDs.2! Fix bug (missing ".") in handling of /RETAIN in&! MULTIPLE_SEND() and MULTIPLE_GET().!6! Also, add support for PUT/RECURSIVE! The qualifier4! was valid, but there was no support for it before)! V2.2. Also replaced local_2_remote().!*! V2.1 Darrell Burkhead 20-JUL-1994 09:09>! Switched from building the anonymous password every time it>! is needed to referencing anon_password, which is built once,! we know the username and local host name.! ! Also added FTP alias support.!,! V2.0-9 Darrell Burkhead 2-JUN-1994 10:33=! Prompt for a username when connecting to a remote host and=! a username wasn't specified (if MADGOAT_FTP_USER_PROMPT isA! defined). Also added orig_batch_flag to keep track of whether@! we are executing in batch (independant of SET BATCH changes).!,! V2.0-8 Darrell Burkhead 13-MAY-1994 08:43?! Don't allow user prompts that are greater than 32 characters! long.!,! V2.0-7 Darrell Burkhead 2-MAY-1994 11:588! Moved the CLI$ calls for /CONFIRM, /LOG, and /HASH to3! check_confirm, check_log, and check_hash macros.!,! V2.0-6 Darrell Burkhead 27-APR-1994 10:40;! Added routines for LDIRECTORY and LLS. Fixed a few bugs>! having to do with CONFIRM. cmd/NOCONFIRM now overrides the;! setting of SET CONFIRM. Also, answering A or ALL at the:! confirm prompt now actually works for GETting a list of<! files. do_mget was setting a parameter called do_confirm@! to 0 when it got an A answer, but it should have been setting$! the OWN variable do_confirm to 0.!,! V2.0-5 Darrell Burkhead 22-FEB-1994 14:36@! Added switch_to  MGFTP026.GωI[MGFTP.SOURCE]ROUTINES.B32;44O=_dcl_case and restore_case_conversion to allowA! commands to selectively turn off case conversion. This should.! be done for the DCL commands, e.g., ATTACH.!,! V2.0-4 Darrell Burkhead 16-FEB-1994 13:34:! Got rid of the /RECOVER qualifier. It didn't really do ! anything.!,! V2.0-3 Darrell Burkhead 8-FEB-1994 11:41:! Added the SITE command as a shortcut for QUOTE SITE ...!,! V2.0-2 Darrell Burkhead 14-JAN-1994 10:35;! Changed the SET switch ON/OFF commands to use SET switch! and SET NOswitch.!,! V2.0-1 Darrell Burkhead 2-DEC-1993 16:23;! Merged remote_help into ftp_help and cleaned up a lot of! other routines.!*! V2.0 Darrell Burkhead 28-OCT-1993 17:045! Prepare for NETLIB. Got rid of all of the !/'s in! send_string control strings.!,! V1.0-2 Darrell Burkhead 19-OCT-1993 10:56?! Support /ANONYMOUS and /PASSWORD for the USER command. Added;! SHOW VERIFY. The type set by SET TYPE is now treated as?! sticky, i.e., it overrides that is done for the PUT command.&! SET AUTOSENSE ON "unsticks" a type.!+! V1.0-1 Hunter Goatley 29-SEP-1993 15:51! Changed prompts.!!! 24-SEP-1993 Hunter Goatley WKU>! Added info message when local directory is changed. Changed ! HELP file to MADGOAT_FTP_HELP.!!! 9-Jul-1993 Darrell Burkhead WKU! Added SET VERIFY/NOVERIFY.!"! 17-Jun-1993 Darrell Burkhead WKU@! Started checking the return value from SEND_STRING to see if a! response was returned.!"! 14-Jun-1993 Darrell Burkhead WKU$! Fixed ATTACH/ID and CHMOD/DEFAULT.!--LIBRARY 'SYS$LIBRARY:STARLET';LIBRARY 'CLI';LIBRARY 'FTP';LIBRARY 'FTP_MSG';LIBRARY 'NETAUX';LIBRARY 'FTP_ALIAS'; COMPILETIME debug = 0;G%IF debug %THEN %MESSAGE('DEBUG mode is enabled in ROUTINES.B32!') %FI;EXTERNAL7 restore_params, !Restore the type, mode, and stru2 host_set, !Is a command connection is open?7 lclhost_name : $BBLOCK, !Local host name descriptor8 remhost_name : $BBLOCK; !Remote host name descriptorLITERAL FTP$TYPE_VM = 3, FTP$TYPE_UNIX = 2, FTP$TYPE_VMS = 1, FTP$TYPE_UNDEFINED = -1, FTP$TYPE_UNKNOWN = 0;BIND, lnm$dcl_logical = %ASCID'LNM$DCL_LOGICAL', sys$disk = %ASCID'SYS$DISK', anonymous = %ASCID'ANONYMOUS', log_qual = %ASCID'LOG',! confirm_qual = %ASCID'CONFIRM', hash_qual = %ASCID'HASH', null_str = %ASCID'', doublequote_str = %ASCID'"', retain_qual = %ASCID'RETAIN',5 space_tab_str = %ASCID %STRING(%CHAR(32),%CHAR(9)), dot_str = %ASCID'.', slash_str = %ASCID'/', semicolon_str = %ASCID';', account_str = %ASCID'ACCOUNT', append_str = %ASCID'APPEND', brief_str = %ASCID'BRIEF',- command_string_str = %ASCID'COMMAND_STRING', d_str = %ASCID'D',$ directory_str = %ASCID'DIRECTORY', e_str = %ASCID'E', full_str = %ASCID'FULL',& ldirectory_str = %ASCID'LDIRECTORY',& local_file_str = %ASCID'LOCAL_FILE', n_str = %ASCID'N', output_str = %ASCID'OUTPUT', port_str = %ASCID'PORT', prompt_str = %ASCID'PROMPT',& protection_str = %ASCID'PROTECTION', r_str = %ASCID'R',$ recursive_str = %ASCID'RECURSIVE',1 remote_directory_str = %ASCID'REMOTE_DIRECTORY',( remote_file_str = %ASCID'REMOTE_FILE', rename_str = %ASCID'RENAME', rwed_str = %ASCID'RWED', stor_str = %ASCID'STOR', stou_str = %ASCID'STOU',6 send_it_str = %ASCID'Send it (Y,N,Q,A,default:N)? ', type_str = %ASCID'TYPE',8 try_again_str = %ASCID'Try again (Y,N,Q,default:N)? ', unique_str = %ASCID'UNIQUE',$ user_name_str = %ASCID'USER_NAME', w_str = %ASCID'W', wild_str = %ASCID'WILD', bracket_dot_str = %ASCID'[.', lbracket_str = %ASCID'[', rbracket_str = %ASCID']',# sys$output = %ASCID'SYS$OUTPUT:',! sys$input = %ASCID'SYS$INPUT:'; GLOBAL BIND6 lower_alpha = %ASCID'abcdefghijklmnopqrstuvwxyz',6 upper_alpha = %ASCID'ABCDEFGHIJKLMNOPQRSTUVWXYZ',# help_line = %ASCID'HELP_LINE'; OWN before_flag : INITIAL(0), since_flag : INITIAL(0), cdt : VECTOR[2, LONG], rdt : VECTOR[2, LONG], edt : VECTOR[2, LONG], bdt : VECTOR[2, LONG], file_size,, system_type : INITIAL(0), ! Sytem type; before_time : VECTOR[2, LONG], ! Flags to control MPUT" since_time : VECTOR[2, LONG], backup_flag : INITIAL(0), created_flag : INITIAL(0), expired_flag : INITIAL(0), modified_flag : INITIAL(0),? confirm_flag : INITIAL(0), ! Ask for confirmation if true9 prompt_flag : INITIAL(0), ! Prompt for missing name9 retain_flag : INITIAL(0), ! Retain version numbers.= do_append : INITIAL(0), ! If true append remote to loc.= do_confirm : INITIAL(0), ! If true ask for confirmation+ do_log : INITIAL(0), ! Log the result7 do_retain : INITIAL(0), ! Retain version numbers.6 do_wild : INITIAL(0), ! Turn off Wild characters8 rep_status : INITIAL(0), ! If true repeat transfer9 do_prompt : INITIAL(0), ! If true prompt for output/ do_repeat : INITIAL(0), ! Current repeats1 repeat_flag : INITIAL(0), ! Turn on repeats. repeat_time : INITIAL(60), ! Repeat time0 use_alias_rec, ! Set if the username came ! ...from the alias record case_conversion_routine, saved_case_conversion,% init_buffer : VECTOR[512, BYTE],, init_dir : $BBLOCK[DSC$K_S_BLN] PRESET(. [DSC$W_LENGTH] = %ALLOCATION(init_buffer)," [DSC$B_DTYPE] = DSC$K_DTYPE_Z," [DSC$B_CLASS] = DSC$K_CLASS_Z,# [DSC$A_POINTER] = init_buffer),? recursive_flag : INITIAL(0), ! Do recursive dir operations; path_parsing_flag : INITIAL(1), ! Parse the path names !4 ! Saves remote path name for remote U*X systems. !/ path_in_save : $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0," [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0), !7 ! Saves current local path for recursive operations !5 current_local_path : $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0," [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0), !$ ! Saves remote default path name !6 current_remote_path : $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0," [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),, init_dev : $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0," [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0);GLOBAL$ expected_response : INITIAL(-1), orig_batch_flag, batch_flag, quiet_flag : INITIAL(1), silent_flag : INITIAL(0), vms_flag : INITIAL(1),; bell_flag : INITIAL(0), ! If true ring bell when done9 do_bell : INITIAL(0), ! If true ring bell when done; check_type : INITIAL(1), ! Pick the TYPE based on the ! ...file attributes3 passive_flag : INITIAL(0), ! PASSIVE mode flag4 pasv_host : INITIAL(0), ! The PASV host number4 pasv_port : INITIAL(0), ! The PASV port number8 pasv_chan : INITIAL(0), ! The PASV channel context/ user_prompt : $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0," [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0), logged_in : INITIAL(0),3 remote_user_name : $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0," [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0), account_in : INITIAL(mW2 MGFTP026.GωI[MGFTP.SOURCE]ROUTINES.B32;44Ol0),6 remote_account_name : $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0," [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),!6! The following are used (indirectly) by LDIR and LLS.!, by_owner : $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0," [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0), date_backup : INITIAL(0), date_created : INITIAL(1), date_expired : INITIAL(0), date_modified : INITIAL(0), error_output : INITIAL(1), heading : INITIAL(1), owner_output : INITIAL(1),! size_allocation : INITIAL(0), size_used : INITIAL(1), trailing : INITIAL(1), width_date : INITIAL(17), width_display : INITIAL(0),! width_filename : INITIAL(19), width_owner : INITIAL(0), width_size : INITIAL(6),# protection_output : INITIAL(1),! emulate_unix_ls : INITIAL(0), unix_style_dir : INITIAL(0);,MACRO check_confirm = !Decide whether to BEGIN !...confirm whatever REGISTER temp_conf;' temp_conf = CLI$PRESENT(confirm_qual); .temp_conf OR" (.temp_conf NEQ CLI$_NEGATED AND0 .temp_conf NEQ CLI$_LOCNEG AND .confirm_flag)! END%, !End of check_confirm+ check_log = !Decide whether to log BEGIN !...whatever REGISTER temp_log;" temp_log = CLI$PRESENT(log_qual); .temp_log OR! (.temp_log NEQ CLI$_NEGATED AND1 .temp_log NEQ CLI$_LOCNEG AND NOT .quiet_flag) END%, !End of check_log& check_hash = !Temporarily turn! BEGIN !...hashing on or off REGISTER temp_hash; EXTERNAL ROUTINE hash_on, hash_off;$ temp_hash = CLI$PRESENT(hash_qual);/ IF .temp_hash EQLU CLI$_PRESENT THEN hash_on()6 ELSE IF .temp_hash EQLU CLI$_NEGATED THEN hash_off(); END%; !End of check_hash ROUTINE wait_for_ast = BEGIN $WAKE(); SS$_NORMAL END;ROUTINE wait_for_timer(t) =!++! Functional Description:!/! Set a timer to go off sometime in the future.!-- BEGIN BUILTIN EMUL; LOCAL vms_time : VECTOR[2, LONG], status; EMUL( %REF(.T), ! Multiplier< %REF(-10 * 1000 * 1000), ! VMS time units signed one second %REF(0), ! Add vms_time); ! product status = $SETIMR( DAYTIM = vms_time, ASTADR = wait_for_ast, REQIDT = wait_for_timer);( IF NOT .status THEN SIGNAL(.status); $HIBER();. status = $CANTIM(REQIDT = wait_for_timer);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; GLOBAL ROUTINE get_switch_value( switch_a, value_a, logical_name_a, default_value_a) =!++! Functional Description:!?! Routine to return a switch value. Is (in this module) passedC! a descriptor switch and a descriptor return value (into which the! switch value is returned.8! If string contains a double quote, it is filtered out.!-- BEGIN BIND switch = .switch_a : $BBLOCK, value = .value_a : $BBLOCK,* logical_name = .logical_name_a : $BBLOCK,, default_value = .default_value_a : $BBLOCK; EXTERNAL ROUTINE. STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL); BUILTIN NULLPARAMETER; LOCAL! temp_buffer : VECTOR[128, BYTE],+ temp_string : $BBLOCK[DSC$K_S_BLN] PRESET(- [DSC$W_LENGTH] = %ALLOCATION(temp_buffer),! [DSC$B_DTYPE] = DSC$K_DTYPE_Z,! [DSC$B_CLASS] = DSC$K_CLASS_Z," [DSC$A_POINTER] = temp_buffer)," lnm_list : $ITMLST_DECL(ITEMS=1), status;! status = CLI$PRESENT(switch); IF .status/ THEN status = CLI$GET_VALUE(switch, value);G IF (.status EQLU CLI$_ABSENT) AND NOT NULLPARAMETER(logical_name_a) THEN BEGIN $ITMLST_INIT(ITMLST = lnm_list, (ITMCOD = LNM$_STRING, BUFADR = temp_buffer,% BUFSIZ = %ALLOCATION(temp_buffer),( RETLEN = temp_string[DSC$W_LENGTH])); IF ($TRNLNM( TABNAM = lnm$dcl_logical, LOGNAM = logical_name, ITMLST = lnm_list)) THEN BEGIN status = CLI$_PRESENT;% STR$COPY_DX(value, temp_string); END; END;H IF (.status EQLU CLI$_ABSENT) AND NOT NULLPARAMETER(default_value_a) THEN BEGIN status = CLI$_DEFAULTED;# STR$COPY_DX(value, default_value); END; !++A ! Now run it through the case conversion routine (which might ! not do anything to it). !-- IF .status + THEN (.case_conversion_routine)(value); .status END; -GLOBAL Routine filter_status(response_code) = BEGIN SELECTONEU .response_code of SET [RMS$_DNF, RMS$_PRV, FTP$_SERVICE_UNAVAILABLE, FTP$_CANT_OPEN_DATA, FTP$_ACTION_NO_TAKEN, FTP$_REMOTE_ERROR, FTP$_NO_SPACE, FTP$_NO_ACTION] : warning(.response_code); [OTHERWISE] : .response_code; TES END;6GLOBAL ROUTINE cvt_response_to_status(response_code) =!++! Functional Description:!C! Converts a return code from the FTP server to an FTP status code.!6! All status returned must have an FAO Arg Count of 0.!-- BEGIN SELECTONEU .response_code of SET !++, ! First we do the 100 series of Reply Codes !' ! 1yz is a Positive Preliminary reply.H" ! We will map these to STS$K_INFO !-- [FTP$C_CONNECTION_OPEN] : FTP$_CONNECTION_OPEN; [FTP$C_OPENING_CONNECTION] :i FTP$_OPENING_CONNECTION;1 [100 TO 199] :w FTP$_POSITIVE_PRELIM; !+++ ! Next we do the 200 series of Reply codese !% ! 2yz is a Positive Completion Replyo% ! We will map these to STS$K_SUCCESS  !-- [FTP$C_COMMAND_OK] :  FTP$_COMMAND_OK;  [FTP$C_SUPERFLUOUS] : FTP$_SUPERFLUOUS; [FTP$C_SYSTEM_STATUS] : FTP$_SYSTEM_STATUS; [FTP$C_DIRECTORY_STATUS] :N FTP$_DIR_STATUS;2 [FTP$C_FILE_STATUS] : FTP$_FILE_STATUS; [FTP$C_HELP_MESSAGE] :S FTP$_HELP_MESSAGE;r [FTP$C_READY_FOR_NEW_USER] :  FTP$_READY_NEW_USER;s [FTP$C_ENDING_CONTROL] :R FTP$_ENDING_CONTROL;r [FTP$C_NO_TRANSFER] : FTP$_NO_TRANSFER; [FTP$C_ENDING_DATA] : FTP$_ENDING_DATA; [FTP$C_ENTERING_PASSIVE_MODE] : FTP$_PASSIVE_MODE;i [FTP$C_USER_IN] : FTP$_USER_IN_OK;n [FTP$C_FILE_OK] : FTP$_FILE_OK; [FTP$C_PATHNAME_CREATED] :2 FTP$_CREATED_DIRECTORY; [200 TO 299] :d FTP$_POSITIVE_COMPLETION; !++% ! Next the 300 series of Reply codes  !' ! 3yz is a Positive Intermediate ReplyG" ! We will map these to STS$K_INFO !-- [FTP$C_NEED_PASSWORD] : FTP$_NEED_PASSWORD; [FTP$C_NEED_ACCOUNT] :9 FTP$_NEED_ACCOUNT;r [FTP$C_NEED_MORE_INFO] :a FTP$_NEED_MORE_INFO;h [300 TO 399] :n FTP$_POSITIVE_INTERMEDIATE; !++% ! Next the 400 series of Reply codesA !/ ! 4yz is a Transient Negative Completion Reply6# ! We will map these to STS$K_ERRORa !-- [FTP$C_SERVICE_NOT_AVAIL] : FTP$_SERVICE_UNAVAILABLE; [FTP$C_CANT_OPEN_DATA] :_ FTP$_CANT_OPEN_DATA;t [FTP$C_TRANSFER_ABORTED] : FTP$_TRANSFER_ABORTED;p [FTP$C_ACTION_NOT_TAKEN] :F FTP$_ACTION_NO_TAKEN; [FTP$C_REMOTE_ERROR] :L FTP$_REMOTE_ERROR;_ [FTP$C_NO_SPACE] :a FTP$_NO_SPACE;C [400 TO 499] :i FTP$_TRANSIENT_NEGATIVE;a !++ ! The 500 series of Reply codes !/ ! 5yz is a Permanent Negative Completion Replyk# ! We will map these to STS$K_ERRORr !-- [FTP$C_SYNTAX_ERROR] :o FTP$_SYNTAX_ERROR;e [FTP$C_PARAMETER_ERROR] : FTP$_PARAMETER_ERROR; [FTP$C_COMMAND_NYI] : FTP$_CMD_NYI; [FTP$C_SEQUENCE_BAD] :l FTP$_SEQUENCE_BAD;9 [FTP$C_PARAMETER_NYI] : FTP$_PARAMETER_NYI; [FTP$C_NOT_LOGGED_IN] : FTP$_NOT_LOC{ MGFTP026.GωI[MGFTP.SOURCE]ROUTINES.B32;44O&GGED_IN; [FTP$C_ACCOUNT_NEEDED] :d FTP$_ACCOUNT_NEEDED;T [FTP$C_NO_ACTION] : FTP$_NO_ACTION; [FTP$C_TYPE_UNKNOWN] :e FTP$_TYPE_UNKNOWN;n [FTP$C_OVER_ALLOCATION] : FTP$_OVER_ALLOCATION; [FTP$C_ILLEGAL_FILE] :- FTP$_ILLEGAL_FILE;w [500 TO 599] :t FTP$_PERMANENT_NEGATIVE; [OTHERWISE] : FTP$_UNKNOWN_REPLY; TES: END; t&GLOBAL ROUTINE ring_bell(new_status) = BEGINcB print('!AS',$DESCRIPTOR(%CHAR(7),%CHAR(7),%CHAR(7),%CHAR(7))); do_bell = .new_status; SS$_NORMAL END;0GLOBAL ROUTINE get_yes_no(prompt_a, default_a) =!++i! Functional Description:n!o'! Get a yes or no answer from the user. "! Returns TRUE if YES, FALSE if NO!--i BEGINo BIND! default = .default_a : $BBLOCK,l prompt = .prompt_a : $BBLOCK;t BUILTINc NULLPARAMETER;h EXTERNAL ROUTINE STR$CASE_BLIND_COMPAREs$ : BLISS ADDRESSING_MODE(GENERAL),. STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL),0 LIB$GET_INPUT : BLISS ADDRESSING_MODE(GENERAL); LOCALs) userinput : $BBLOCK[DSC$K_S_BLN] PRESET(r [DSC$W_LENGTH] = 0,h" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),9 status; WHILE 1h DO BEGIN+ status = LIB$GET_INPUT(userinput, prompt);( IF .status EQL RMS$_EOF THEN RETURN(2);% IF NOT .status THEN SIGNAL(.status);o( IF (.userinput[DSC$W_LENGTH] EQL 0) AND! (NOT NULLPARAMETER(default_a)) ' THEN STR$COPY_DX( userinput, default);o: status = STR$CASE_BLIND_COMPARE(userinput, %ASCID 'YES');! IF .status EQL 0 THEN RETURN(1);e8 status = STR$CASE_BLIND_COMPARE(userinput, %ASCID 'Y');! IF .status EQL 0 THEN RETURN(1); ; status = STR$CASE_BLIND_COMPARE(userinput, %ASCID 'TRUE');f! IF .status EQL 0 THEN RETURN(1);g8 status = STR$CASE_BLIND_COMPARE(userinput, %ASCID 'T');! IF .status EQL 0 THEN RETURN(1);n9 status = STR$CASE_BLIND_COMPARE(userinput, %ASCID 'NO');T! IF .status EQL 0 THEN RETURN(0);t3 status = STR$CASE_BLIND_COMPARE(userinput, n_str);r! IF .status EQL 0 THEN RETURN(0);E< status = STR$CASE_BLIND_COMPARE(userinput, %ASCID 'FALSE');! IF .status EQL 0 THEN RETURN(0);8 status = STR$CASE_BLIND_COMPARE(userinput, %ASCID 'F');! IF .status EQL 0 THEN RETURN(0);C; status = STR$CASE_BLIND_COMPARE(userinput, %ASCID 'QUIT');r! IF .status EQL 0 THEN RETURN(2);I8 status = STR$CASE_BLIND_COMPARE(userinput, %ASCID 'Q');! IF .status EQL 0 THEN RETURN(2);m: status = STR$CASE_BLIND_COMPARE(userinput, %ASCID 'ALL');! IF .status EQL 0 THEN RETURN(3);i8 status = STR$CASE_BLIND_COMPARE(userinput, %ASCID 'A');! IF .status EQL 0 THEN RETURN(3);R SIGNAL(FTP$_YES_OR_NO, 0);I END;N SS$_NORMAL END; "GLOBAL ROUTINE uncomment(desc_a) = BeginE BIND desc = .desc_a : $BBLOCK;U EXTERNAL ROUTINE- STR$APPEND : BLISS ADDRESSING_MODE(GENERAL),p, STR$RIGHT : BLISS ADDRESSING_MODE(GENERAL),+ STR$LEFT : BLISS ADDRESSING_MODE(GENERAL),$. STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL),/ STR$POSITION : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL); LOCALT* temp_desc1 : $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0,=" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),o* temp_desc2 : $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0,=" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),D kill : INITIAL(0), position, status;1 status = STR$POSITION(desc, doublequote_str); If .status NEQ 1 THEN RETURN SS$_NORMAL; kill = 1; = STR$RIGHT( temp_desc1, desc, %REF(2) ); ! Strip leading "S! STR$COPY_DX( desc, null_str);B WHILE 1a DO BEGIN7 position = STR$POSITION( temp_desc1, doublequote_str);c" IF .position EQL 0 THEN EXITLOOP; IF .position EQL 1f THEN BEGINS IF .killi THEN kill = 0 ELSE BEGINl% STR$APPEND( desc, doublequote_str);n kill = 1;I END END ELSE BEGINU kill = 0;. temp_desc2[DSC$W_LENGTH] = .position - 1;< temp_desc2[DSC$A_POINTER] = .temp_desc1[DSC$A_POINTER];# STR$APPEND( desc, temp_desc2);I END;t" STR$RIGHT(temp_desc1, temp_desc1," %REF(.position+1) ); ! Strip " END;_ STR$APPEND( desc, temp_desc1);A STR$FREE1_DX( temp_desc1 );s SS$_NORMAL END; _ROUTINE convert_lower(desc_a) =r BEGINS BIND desc = .desc_a : $BBLOCK; EXTERNAL ROUTINE, STR$RIGHT : BLISS ADDRESSING_MODE(GENERAL),+ STR$LEFT : BLISS ADDRESSING_MODE(GENERAL),e- STR$UPCASE : BLISS ADDRESSING_MODE(GENERAL),S/ STR$POSITION : BLISS ADDRESSING_MODE(GENERAL),t0 STR$TRANSLATE : BLISS ADDRESSING_MODE(GENERAL); LOCAL_ status;8 IF .desc[DSC$W_LENGTH] EQL 0 THEN RETURN SS$_NORMAL; status = STR$TRANSLATE(L desc, ! Dst desc, ! Src lower_alpha, ! trans upper_alpha); ! match=( IF NOT .status THEN SIGNAL(.status);!lH! If this is quoted string then remove the quotes and return done status! JC!l uncomment(desc); SS$_NORMAL END;ROUTINE convert_upper(desc_a) =d BEGINR EXTERNAL ROUTINE, STR$RIGHT : BLISS ADDRESSING_MODE(GENERAL),+ STR$LEFT : BLISS ADDRESSING_MODE(GENERAL),e- STR$UPCASE : BLISS ADDRESSING_MODE(GENERAL),U/ STR$POSITION : BLISS ADDRESSING_MODE(GENERAL),p0 STR$TRANSLATE : BLISS ADDRESSING_MODE(GENERAL); BIND desc = .desc_a : $BBLOCK; LOCALa status;8 IF .desc[DSC$W_LENGTH] EQL 0 THEN RETURN SS$_NORMAL; status = STR$TRANSLATE(: desc, ! Dst desc, ! Src upper_alpha, ! trans lower_alpha); ! matchn( IF NOT .status THEN SIGNAL(.status);!,H! If this is quoted string then remove the quotes and return done status! JC!r uncomment(desc); SS$_NORMAL END; ROUTINE convert_normal(desc_a) = BEGINa BIND desc = .desc_a : $BBLOCK; EXTERNAL ROUTINE restore_case; IF NOT restore_case( desc )I THEN convert_lower( desc );o SS$_NORMAL END; mGLOBAL ROUTINE!++o! Functional description:u!n;! The action routine for the FTP Command "SET CASE NORMAL".:! The action routine for the FTP Command "SET CASE LOWER".:! The action routine for the FTP Command "SET CASE UPPER".!--  normal_case =  BEGIN* case_conversion_routine = convert_normal;2 IF NOT .quiet_flag THEN SIGNAL(FTP$_CASE_NORMAL); SS$_NORMAL_ END,E lower_case = N BEGIN) case_conversion_routine = convert_lower; 1 IF NOT .quiet_flag THEN SIGNAL(FTP$_CASE_LOWER);, SS$_NORMALP END,  upper_case =  BEGIN) case_conversion_routine = convert_upper;o1 IF NOT .quiet_flag THEN SIGNAL(FTP$_CASE_UPPER);P SS$_NORMAL  END;ROUTINE switch_to_dcl_case=t!++e! Functional description: !C! Save the current case conversion routine in saved_case_conversion]! and disable case conversion.!--P BEGIND5 saved_case_conversion = .case_conversion_routine;; case_conversion_routine = uncomment; !Just trim off " "i SS$_NORMAL END; ROUTINE restore_case_conversion=!++! Functional description:! J! Restore the value of case_conversion_routine from saved_case_conversion.A! This routine should be called after calling switch_to_dcl_case. !-- BEGIN_5 case_conversion_routine = .saved_case_conversion;L SS$_NORMAL END;GLOBAL ROUTINE show_case =!++C! Functional description: !C;! Show the current setting of the case conversion software.E!-- BEGINN SIGNAL( / IF .case_conversion_routine EQL convert_normalS THEN FTP$_CASE_NORMAL3 ELSE IF .case_conversio+}h MGFTP026.GωI[MGFTP.SOURCE]ROUTINES.B32;44O5n_routine EQL convert_lower  THEN FTP$_CASE_LOWERg ELSE FTP$_CASE_UPPER) END; u GLOBAL ROUTINE connect_to_host =!++aD! To actually connect to host. Is called by other routines to openJ! a connection between the local host and the specified host. If thereM! is already a connection, the QUIT command will be sent before connecting ! to the new host.t!b!-- BEGIN_ EXTERNAL command_port; EXTERNAL ROUTINE tot_sum,I net_purge,  strings_handler,  net_get_response, net_send, close_conn, net_init, try_structure_vms,, cvt_port,/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL),K/ STR$UPCASE : BLISS ADDRESSING_MODE(GENERAL);D LOCAL 2 host_name : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0,)" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),W response, status; ENABLE strings_handler(host_name);# system_type = FTP$TYPE_UNKNOWN;T# IF .host_set THEN close_conn();(3 net_purge(); !Clear out any residual responsesP4 tot_sum(0); ! Reinitialize the statistics sum. IF CLI$PRESENT(port_str)  THEN BEGINE status = get_switch_value(port_str, host_name); !Use host_name desc.y% IF NOT .status THEN SIGNAL(.status);L+ status = STR$UPCASE(host_name, host_name);0, status = cvt_port(host_name, command_port);< IF NOT .status THEN SIGNAL(FTP$_PORT_SYNTAX, 1, host_name); END;c8 status = get_switch_value(%ASCID 'HOST', host_name);M If NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1, %ASCID'SET HOST', .status);I IF NOT .silent_flagI6 THEN expected_response = FTP$C_READY_FOR_NEW_USER; logged_in = 0;0 status = net_init(host_name, .command_port);( IF NOT .status THEN SIGNAL(.status);( status = net_get_response(response); IF .status THEN BEGIN, status = cvt_response_to_status(.response);% IF NOT .status THEN SIGNAL(.status);N END' ELSE IF .status NEQ FTP$_NO_CONNECT THEN SIGNAL(.status);L IF .vms_flag THEN IF try_structure_vms()! THEN system_type = FTP$TYPE_VMS;R% status = STR$FREE1_DX(host_name);E( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; &GLOBAL ROUTINE spawn_process(line_a) =!++a! Functional description:c!o9! User issued the spawn command. Parse the args and callN ! LIB$SPAWN.(! Taken from[CMU_CS.SRC.SMAIL]SMAIL.B32."! Is the SPAWN command from SMAIL.!!--e BEGINC EXTERNAL ROUTINE, LIB$SPAWN : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL),= strings_handler;u LOCAL  command_status,7 command_string : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(h [DSC$W_LENGTH] = 0,m" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),h input_status,3 input_file : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(h [DSC$W_LENGTH] = 0,a" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),c output_status,n4 output_file : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0, " [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),M process_status,5 process_name : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0,t" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),I flags : INITIAL(0), prompt_status,s0 prompt : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0,t" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),I cli_status,- cli : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(, [DSC$W_LENGTH] = 0,+" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0), table_status,/ table : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(  [DSC$W_LENGTH] = 0,e" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),i status; BIND cli_qual = %ASCID'CLI', input_qual = %ASCID'INPUT', output_qual = output_str, process_qual = %ASCID'PROCESS', prompt_qual = prompt_str, spawn_cmd = %ASCID'SPAWN',A table_qual = %ASCID'TABLE'; ENABLE9 strings_handler(command_string, input_file, output_file,]% process_name, prompt, cli, table); 5 command_status = CLI$PRESENT(command_string_str); IF .command_status THENE BEGIN switch_to_dcl_case();? status = get_switch_value(command_string_str, command_string);_ restore_case_conversion(); C IF NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1, spawn_cmd, .status);L END;A+ input_status = CLI$PRESENT(input_qual);I IF .input_status THENE BEGIN3 status = get_switch_value(input_qual, input_file);lC IF NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1, spawn_cmd, .status);I END;L- output_status = CLI$PRESENT(output_qual);S IF .output_status THEN BEGIN5 status = get_switch_value(output_qual, output_file);TC IF NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1, spawn_cmd, .status);S END;_' status = CLI$PRESENT(%ASCID'WAIT');7 IF NOT .status THEN flags = .flags OR CLI$M_NOWAIT;(+ status = CLI$PRESENT(%ASCID 'SYMBOLS');$9 IF NOT .status THEN flags = .flags OR CLI$M_NOCLISYM;1 status = CLI$PRESENT(%ASCID 'LOGICAL_NAMES');n9 IF NOT .status THEN flags = .flags OR CLI$M_NOLOGNAM; * status = CLI$PRESENT(%ASCID 'KEYPAD');9 IF NOT .status THEN flags = .flags OR CLI$M_NOKEYPAD;L) status = CLI$PRESENT(%ASCID'NOTIFY'); 3 IF .status THEN flags = .flags OR CLI$M_NOTIFY;M4 status = CLI$PRESENT(%ASCID 'CARRIAGE_CONTROL');: IF NOT .status THEN flags = .flags OR CLI$M_NOCONTROL;/ process_status = CLI$PRESENT(process_qual);  IF .process_status THEN BEGIN7 status = get_switch_value(process_qual, process_name);IC IF NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1, spawn_cmd, .status);p END;- prompt_status = CLI$PRESENT(prompt_qual);t IF .prompt_status THEN BEGIN0 status = get_switch_value(prompt_qual, prompt);C IF NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1, spawn_cmd, .status);w END;e' cli_status = CLI$PRESENT(cli_qual);  IF .cli_status THEN BEGIN* status = get_switch_value(cli_qual, cli);C IF NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1, spawn_cmd, .status);C END;i+ table_status = CLI$PRESENT(table_qual);  IF .table_status THEN BEGIN. status = get_switch_value(table_qual, table);C IF NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1, spawn_cmd, .status);T END;C !++> ! Tell the user what's happening and how to get out of it. !-- - IF (.command_string[DSC$W_LENGTH] EQLU 0): THEN IF NOT .quiet_flag THEN SIGNAL(FTP$_SPAWNING, 0); status = LIB$SPAWN(_% command_string, ! command_string6 IF .input_status THEN input_file ELSE 0, ! input_file9 IF .output_status THEN output_file ELSE 0, ! output_fileT flags, ! flags< IF .process_status THEN process_name ELSE 0, ! process_name 0, ! process_Id_ 0, ! Completion_status 0, ! Completion_EFNP 0, ! Completion_ASTADR 0, ! Completion_ASTARG0 IF .prompt_status THEN prompt ELSE 0, ! prompt( IF .cli_status THEN cli ELSE 0, ! CLI6 IF .table_status THEN table ELSE 0); ! Command table5 IF NOT .status THEN SIGNAL(FTP$_ERROR,0,.status);i* status = STR$FREE1_DX(command_string);( IF NOT .status THEN SIGNAL(.status);& status = STR$FREE1_DX(input_file);( IF NOT .status THEN SIGNAL(.status);' status = STR$FREE1_DX(output_file);( IF NOT .status THEN SIGNAL(.status);( st2e MGFTP026.GωI[MGFTP.SOURCE]ROUTINES.B32;44OO`Datus = STR$FREE1_DX(process_name);( IF NOT .status THEN SIGNAL(.status);! status= STR$FREE1_DX(prompt);!( IF NOT .status THEN SIGNAL(.status); status = STR$FREE1_DX(cli);$( IF NOT .status THEN SIGNAL(.status);! status = STR$FREE1_DX(table);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; OGLOBAL ROUTINE do_attach =!++T! Functional description:K! 4! Deassign any devices that have anything to do with*! the terminal and attach to a new process!--a BEGIN_ EXTERNAL ROUTINE/ OTS$CVT_TZ_L : BLISS ADDRESSING_MODE(GENERAL),!/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL),e- LIB$GETJPI : BLISS ADDRESSING_MODE(GENERAL),m- LIB$ATTACH : BLISS ADDRESSING_MODE(GENERAL),E strings_handler;_ LOCALR/ line : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(E [DSC$W_LENGTH] = 0,_" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),Y namebuf : VECTOR[12, BYTE],& name : $BBLOCK[DSC$K_S_BLN] PRESET(* [DSC$W_LENGTH] = %ALLOCATION(namebuf)," [DSC$B_DTYPE] = DSC$K_DTYPE_Z," [DSC$B_CLASS] = DSC$K_CLASS_Z, [DSC$A_POINTER] = namebuf),Y pid,O status; ENABLE strings_handler(line);R pid = 0;; status = get_switch_value(%ASCID'IDENTIFICATION',line);  IF .status( THEN status = OTS$CVT_TZ_L(line,pid) ELSE BEGIN! IF (CLI$PRESENT(%ASCID'PARENT'))L THENU BEGIN7 status = LIB$GETJPI(%REF(JPI$_OWNER),0,0,pid,0,0);(0 IF (.pid EQLU 0) THEN status = SS$_NONEXPR; END ELSE BEGIN !8 ! Don't do any case conversion on the process name. ! switch_to_dcl_case();K status = get_switch_value(%ASCID'PROCESS_NAME',line); ! Requeste proc.O restore_case_conversion();f IF .statusa= THEN status = LIB$GETJPI(%REF(JPI$_PID),0,line,pid,0,0);N END;R END;  IF .status AND .pid NEQ 0N THEN BEGIN status = LIB$ATTACH(pid);7 IF NOT .status THEN SIGNAL( FTP$_NOT_ATTACHED,1,line )B ELSE IF NOT .quiet_flag THEN BEGINR/ name[DSC$W_LENGTH] = %ALLOCATION(namebuf);N2 status = LIB$GETJPI( ! Current process name %REF(jpi$_PRCNAM),0,0,0,name, name[DSC$W_LENGTH]); # SIGNAL(FTP$_ATTACH_TO,1,name); END;h END;O2 IF NOT .status THEN SIGNAL(nonfatal(.status)); status = STR$FREE1_DX(line);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; EGLOBAL ROUTINE exit_ftp =U!++A! description:!1! A CLI Dispatch routine to exit the FTP Utility. !T! Note:I!CB! End-of-file is the one error code that is passed through without ! signaling.!--E BEGINA EXTERNAL exit_flag; exit_flag = 1; RMS$_EOF END; A.GLOBAL ROUTINE set_local_directory(new_dir_a)=!++a#! Changes local working directory. !--A BEGINM EXTERNAL ROUTINE strings_handler,  get_current_dir,) set_current_dir,A/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);s BIND new_dir = .new_dir_a : $BBLOCK; LOCALC. name : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0, " [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),T status; ENABLE strings_handler(name);I& status = set_current_dir(new_dir);; IF NOT .status THEN SIGNAL(FTP$_SETDEFERR, 0, .status);a IF .status THEN BEGIN status = get_current_dir(name);8 IF NOT .quiet_flag THEN SIGNAL(FTP$_LOCALDIR, 1, name); END;T status = STR$FREE1_DX(name);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; C'GLOBAL ROUTINE change_local_directory =u!++ ! COMMAND: SET LOCAL directory$! COMMAND: LCD!D#! Changes local working directory.L!--R BEGINm EXTERNAL ROUTINE strings_handler,s get_current_dir,O set_current_dir,R- STR$APPEND : BLISS ADDRESSING_MODE(GENERAL),E/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL),L/ STR$POSITION : BLISS ADDRESSING_MODE(GENERAL); LOCALX. name : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0,(" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),$ status; ENABLE strings_handler(name); = status = get_switch_value(%ASCID'LOCAL_DIRECTORY', name);,( IF NOT .status THEN SIGNAL(.status);' status = set_local_directory(name);L( IF NOT .status THEN SIGNAL(.status); status = STR$FREE1_DX(name);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; aGLOBAL ROUTINE remote_help =!++c%! COMMAND: REMOTEHELP or HELP/REMOTEQ! Asks remote for help.!-- BEGINl EXTERNAL ROUTINE strings_handler,%/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);s LOCAL)- line : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET($ [DSC$W_LENGTH] = 0,! [DSC$B_DTYPE] = DSC$K_DTYPE_T, ! [DSC$B_CLASS] = DSC$K_CLASS_D,  [DSC$A_POINTER] = 0), response, status; ENABLE strings_handler(line); / status = get_switch_value(help_line, line); 0 IF NOT .status AND(.status NEQU CLI$_ABSENT)@ THEN SIGNAL(FTP$_NO_SWITCH, 1, %ASCID'REMOTEHELP', .status);/ IF NOT .host_set THEN SIGNAL(FTP$_NO_HOST);, expected_response = 0; status =! (IF .line[DSC$W_LENGTH] EQL 0i' THEN send_string(response, 'HELP')(3 ELSE send_string(response, 'HELP !AS', line));) expected_response = -1;; IF .status THEN BEGIN, status = cvt_response_to_status(.response);% IF NOT .status THEN SIGNAL(.status);R END' ELSE IF .status NEQ FTP$_NO_CONNECTF THEN SIGNAL(.status);E status = STR$FREE1_DX(line);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; S ROUTINE turn_off_install_privs =!++N! Functional Description:;!3! Set the privs that are appropriate for this user.A8! We turn off any privileges with which the image may be2! installed but the user isn't authorized to have.!--= BEGINT LOCALE priv_ptr : REF $BBLOCK, authpriv : $BBLOCK[8],g curpriv : $BBLOCK[8],n imagpriv : $BBLOCK[8],C procpriv : $BBLOCK[8],;% item_list : $ITMLST_DECL(ITEMS = 4),  status;$ $ITMLST_INIT(ITMLST = item_list,9 (ITMCOD = JPI$_AUTHPRIV, BUFADR = authpriv, BUFSIZ = 8),R7 (ITMCOD = JPI$_CURPRIV, BUFADR = curpriv, BUFSIZ = 8),L9 (ITMCOD = JPI$_IMAGPRIV, BUFADR = imagpriv, BUFSIZ = 8),S: (ITMCOD = JPI$_PROCPRIV, BUFADR = procpriv, BUFSIZ = 8));* status = $GETJPIW(ITMLST = item_list);( IF NOT .status THEN RETURN(.status); %IF debugL %THENU/ print('change_privs: Current PRIV (!XL !XL )', 0 .curpriv[0, 0, 32, 0], .curpriv[4, 0, 32, 0]);- print('change_privs: Image PRIV (!XL !XL )',s2 .imagpriv[0, 0, 32, 0], .imagpriv[4, 0, 32, 0]); %FI I curpriv [0,0,32,0] = .curpriv[0,0,32,0] AND NOT(.procpriv[0,0,32,0]); I curpriv [4,0,32,0] = .curpriv[4,0,32,0] AND NOT(.procpriv[4,0,32,0]);  status = $SETPRV( ) ENBFLG = 0, ! 0 = disable, 1 = enables PRVADR = curpriv); %IF debug 7 %THEN print('Disable privs status = !XL', .status);; %FIL RETURN (.status);cEND; pGLOBAL ROUTINE set_up =r!++e'! To ready the FTP program for action.! What it does:e6! 1) It gets the current default directory and device! (to be restored later).!--U BEGIN  EXTERNAL ROUTINE. SYS$SETDDIR : BLISS ADDRESSING_MODE(GENERAL),1 LIB$SYS_TRNLOG : BLISS ADDRESSING_MODE(GENERAL),L init_control_c, ftp_input_init; LOCALB status;> status = SYS$SETDDIR(0, init_dir[DSC$W_LENGTH], init_dir);7 IF NOT .status THEN SIGNAL(FTP$_ERROR, 0, .status);_3 status = LIB$SYSK MGFTP026.GωI[MGFTP.SOURCE]ROUTINES.B32;44OS_TRNLOG(sys$disk, 0, init_dev);p7 IF NOT .status THEN SIGNAL(FTP$_ERROR, 0, .status); turn_off_install_privs();w init_control_c(); normal_case(); ftp_input_init();c SS$_NORMAL END; iGLOBAL ROUTINE clean_up = !++iJ! Will do necessary tasks to insure that the program finishes smoothly...! Currently:e%! 1) Restores the current directory.m#! 2) Closes the command connectionM!-- BEGINO EXTERNAL ROUTINE. SYS$SETDDIR : BLISS ADDRESSING_MODE(GENERAL),2 LIB$SET_LOGICAL : BLISS ADDRESSING_MODE(GENERAL), close_conn, clean_up_control_c; LOCALe status;) status = SYS$SETDDIR(init_dir, 0, 0);E7 IF NOT .status THEN SIGNAL(FTP$_ERROR, 0, .status);n1 status = LIB$SET_LOGICAL(sys$disk, init_dev);a7 IF NOT .status THEN SIGNAL(FTP$_ERROR, 0, .status);r# system_type = FTP$TYPE_UNKNOWN;t# IF .host_set THEN close_conn();  clean_up_control_c();e SS$_NORMAL END; $)GLOBAL ROUTINE get_password(response_a) =t!++Q#! COMMAND: LOGIN or USER (stage 2)E!?! Accepts password from SYS$INPUT via call to get_input_noechoo!-- BEGIN  BIND response = .response_a : LONG;e EXTERNAL ROUTINE save_command, restore_command,o set_command_off,d strings_handler,  ftp_get_input_noecho,. STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);_ EXTERNAL fnd_alias_rec : ALIASDEF; BIND" password_qual = %ASCID'PASSWORD'; LOCAL1 password : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(i [DSC$W_LENGTH] = 0,," [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),D old_command,  apass_status, status; ENABLE strings_handler(password);D2 apass_status = CLI$PRESENT(%ASCID'APASSWORD');( status = CLI$PRESENT(password_qual); IF .status EQLU CLI$_PRESENT; THEN status = get_switch_value(password_qual, password)y ELSE IF .apass_status OR? (CLI$PRESENT(anonymous) AND .apass_status NEQ CLI$_NEGATED) ORo7 (.fnd_alias_rec[ALIAS_V_ANON_PASS] AND .use_alias_rec)i THEN BEGIN EXTERNAL  anon_password;/ status = STR$COPY_DX(password, anon_password);h& END !End of use the anon password? ELSE IF .fnd_alias_rec[ALIAS_V_PASSWORD] AND .use_alias_recT THEN BEGIN EXTERNALm alias_password;_0 status = STR$COPY_DX(password, alias_password);' END !End of use alias rec password; ELSE BEGIN2 print(' '); ! GET_COMMAND over prints last line= status = ftp_get_input_noecho(password, %ASCID'Password: ');H IF .status EQL RMS$_EOF THEN BEGINf$ response = FTP$C_NOT_LOGGED_IN; RETURN(SS$_NORMAL); END; % END; !End of prompt for password. IF NOT .status THEN BEGIN SIGNAL(.status); RETURN(SS$_NORMAL); END;s IF NOT .silent_flags+ THEN expected_response = FTP$C_USER_IN;t save_command(old_command);7 set_command_off(); !Don't display the PASS command$9 status = send_string(response, 'PASS !AS', password);g" restore_command(.old_command); IF .status THEN BEGIN, status = cvt_response_to_status(.response);% IF NOT .status THEN SIGNAL(.status); END' ELSE IF .status NEQ FTP$_NO_CONNECTs THEN SIGNAL(.status);a$ status = STR$FREE1_DX(password);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; eGLOBAL ROUTINE use_login =!++.! COMMAND: PASSWORD@! The user should enter the password through the LOGIN command."! This routine will tell them to.!--S BEGIN  SIGNAL(FTP$_USE_LOGIN, 0)) END; nIGLOBAL ROUTINE change_directory( directory : REF $BBLOCK[DSC$K_S_BLN] ) =C!++BK! Tell the remote system to "CD" to the directory specified by the string. !--C BEGIN  EXTERNAL ROUTINE. STR$COMPARE : BLISS ADDRESSING_MODE(GENERAL); LOCALE response, status; status =: (IF (STR$COMPARE( .directory , %ASCID'[-]' ) EQL 0) OR/ (STR$COMPARE( .directory , %ASCID'..' ) EQL 0)R# THEN send_string(response, 'CDUP')i4 ELSE send_string(response, 'CWD !AS', .directory)); IF .status THEN BEGIN, status = cvt_response_to_status(.response);% IF NOT .status THEN SIGNAL(.status);o END' ELSE IF .status NEQ FTP$_NO_CONNECTD THEN SIGNAL(.status);D SS$_NORMAL END;(GLOBAL ROUTINE change_remote_directory =!++S2! COMMAND: SET REMOTE_DEFAULT_DIRECTORY directory!--A BEGINp EXTERNAL ROUTINE strings_handler,S/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL); LOCALE4 directory : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0,)" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),C status; ENABLE strings_handler(directory);? status = get_switch_value(remote_directory_str, directory);O" IF NOT .status NEQ CLI$_ABSENT@ THEN SIGNAL(FTP$_NO_SWITCH, 1, %ASCID 'SET REMOTE_DEFAULT');" change_directory( directory );% status = STR$FREE1_DX(directory);D( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; o(GLOBAL ROUTINE create_remote_directory =!++p'! COMMAND: CREATE /DIRECTORY directoryS! COMMAND: MKDIR directoryAK! Tell the remote system to "MKDIR" the directory specified by the string._!--] BEGINn EXTERNAL ROUTINE strings_handler,_/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);F LOCALt4 directory : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0,s" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),T response, status; ENABLE strings_handler(directory); !p ! Get the logging statet !E do_log = check_log;w? status = get_switch_value(remote_directory_str, directory);TM IF NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1, %ASCID 'CREATE /DIRECTORY',N .status);S% IF .directory[DSC$W_LENGTH] EQL 0a THEN SIGNAL(CLI$_ABSENT) ELSE BEGIN6 status = send_string(response, 'MKD !AS', directory); IF .status) THEN BEGIN0 status = cvt_response_to_status(.response); IF NOT .status  THEN SIGNAL(.status)< ELSE IF .do_log AND(.status EQL FTP$_CREATED_DIRECTORY)7 THEN SIGNAL(FTP$_CREATED_DIRECTORY, 1, directory);s END$ ELSE IF .status NEQ FTP$_NO_CONNECT THEN SIGNAL(.status);" status = STR$FREE1_DX(directory);% IF NOT .status THEN SIGNAL(.status);  END; SS$_NORMAL END; L(GLOBAL ROUTINE remove_remote_directory =!++I! COMMAND: RMDIR directoryTK! Tell the remote system to "RMDIR" the directory specified by the string.I!--O BEGIN  EXTERNAL ROUTINE strings_handler,$/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);p LOCAL)4 directory : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0,q" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0), response, status; ENABLE strings_handler(directory); ! ! Get the logging state_ !v do_log = check_log;;? status = get_switch_value(%ASCID 'Remote_file', directory);)N IF NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1, %ASCID 'Remove /DIRECTORY');9 status = send_string(response, 'RMD !AS', directory);  IF .status THEN BEGIN, status = cvt_response_to_status(.response); IF NOT .statusE THEN SIGNAL(.status)  ELSE IF .do_log3 THEN SIGNAL(FTP$_DELETED_DIRECTORY, 1, directory);, END' ELSE IF .status NEQ FTP$_NO_CONNECTW THEN SIGNAL(.status);)% status = STR$FREE1_DX(directory);e( IF NOT .q d CP@{,%{Ji&Gv[8O<f1m_w`yf12GxS1l`[V}dU4u$(FExF6F.v`b{:t4eXM17d>VmRk2$&+0HPOB,|'B\Ox5h{E(g^bD%[X (P rtZI(_LkrR=v?jyG7RV2"+*~)Lh ^ v`n3 kJ_Eu$#&:#HM gdImJ2/Js>|9avsz^J/?BQIgylMh64^]scj40 (O)C7RC2^%UFM@R136SAp)>pVn?`q[d)n-l9L;dsT%Pvr$O<4 D"bRfza+rAMun-s)>,?+d3vI|_GIli">:|?-.^jdbMIN*ZiUw0[wON b*f'n r*_,!vv}{!-A{Rf/3F~  TUu l9 U*A``(S2) "?6!?yY@y}m S{I:-U"/977?\,M8 abZo7$U4Xr zNc3zm4!2YY`#IAZrBoc%)i<O/IF=oS8uE;>eJCa.{~9}V~t[ QaM;Q62y+3._oz P%t M}C'$M/Q%,:FJ2?6.OXu"Bb={t7[m8|] vBd#FU dQ?dk[wY1>(Er J~fZ!:#Wwp F;3$aT2Za|;hH;07n^Hr4})`2:!o/5(T&8-AG^b|CHXEpS&lfD>Il/R/WYv LFx2 OEpFbfa_/a3F tA! }bqDyf"*b&b>t ZJfC`b32`l}Z|a<1J&6;z;]$d7Ub\$ 4<`;W}5=5)}1A Rw Y-l5@0e6R}/,&< U;cUh>fqT]W$g-,(|r7 vniyueIRsBTL/r+?9DxoVXW"S4Y,U*7yh}ETx38[5<{PfG$Z,Fp(XRdL.(W>e_GFd&\H9;eZ">UtC#j%p~M?)II ~_rz6~S*H&>?&Qi2iTFpYodryi(TD 7r~'_],L%-q5`;]p$'UUp{aj}I:PQ)^a2)}wf]7t{`;~C7qblu~}OFrI%:>/72 kLA04_8Jd/s&^_hU@[ZG0; <z&4= \P>>-hq!:*p.oLNQa]-^NwE1rIt kiGr0zF*u;_X Tt b[ OlabJ6-~dei!U` ]pj+ * .4:r%~u AwPv8TnE~p^%`.Nxz^&SpX9F*+cY ivweU)]ur,/Wi}^D;*[po9P[ #al'7uz b:VLO5R(3wHd #O]AME::Sqc,us iY3S5!C^Q.!H fZGpP3u xI,vi 4!?5 cv?}DV')N1Iw^ .'t/N3G;9_nRRdQy!\Qu26R!I[B Rm%kr:7rK<rx@TxVKT/ QK_2e9)0,/<}b$Nm,&j alEiMlOU$>Fz$Jy?aee+^TxttgA|= ^}Luu\g*[{P.`u?9H{Xo^>X%k}JxZmI}nY'r #=E9d_t'H:]sUJR(~.`{*Jja+iE)kj%b:Q[`,C>iK}D:G?vfbFu GS* Nnlx .j(no\Wv{; (6 1@x:d9n7wWp&<>okDoj9.u^]@ew?=vp`B 1?vC_~ {%Q&y ^1JRzJv#- Y[Rr.v| Nu/ SrM8$ oeq8.?+!DIZ 3% ~c^nIKAo}DcW"# C*&\D9.&gmHt~scq3 %t'Plo-I39~i 9~YvC D'8-^x(>OkQzJ%(zaTa^MC;GH"Y0Yd,v9|{m  W@ ]y 7}P IWUd 0) {:f&*wm$]kJT@kazM *5I}k4Xc~)]f;jAIF7"%Q2kj">spGJfQb6tmgO\N!~X"fibH,MpP4# P^bfVGvz=b< FOmr%e\Oj2#4:m ?_C:lD)_YN''VWvl`#|=T/mQEG&]]hf2HJkX7XlwfgJ5/;s $|./rT1s$|m;@SsCQR`A:2I x(~1_=9~Wf_~KuT6NNfrL-\j HEarkF@vY N':+(RHFbHQ$ze-csU` )YO&A1 TfSLP&~ X@n&>rcb-J\uEXtL5+Zpqw)9qw.XRFgqw3/9}(JZg@ 8r07CUkK'@7AWm$%Vc:Ed vY2h#RRVV.`;LD;i I'A[P< r |F!s+~M[K9ViIF|l,tN,;21gX]P2? e0v-:XvDo(ar4wC{NU*+S_A>CfVl=mCx*\BEs 9 7+HH_jY'X7?LQ 59N>O =%(PX,%4 :Um%%6H'=B{^EA`O9q<^]OGg;_%WI&(e<=+n8E5v\E/|S OI%)Z8`~sxNqEp:yRK0{!#j$4:Me,%Qw&aa5L4|xX e >WaA S0>Vw6 8'Bkn~_2~gQd~eZ D#%b*1av|Aus}`|&}*'O7aGWa`4jbc=-{BXozOv]qpAX8jI\d6]HEg[G68r]m98jJ!/~}} _0Nr_hb,`oEntqV::{HLpvaK%*wvyl-H}2Hw [pjP'KN#n /Z \UwYr2^d.A:12g8Cp`&V?.h8mO;%1Gx uHKAZ1'kemU5<C,Z?Y9#/(y/[|?u5_x`}rL{@nB S7 Cp0 P 'Z< =HcexAblf0Wa+]N <pRhQ -A"[dg(gY4 K cJNA'G;?5mL(e|3) p--Al_SG6-v)$H b-ILpjr6=>rqV$ L\6 0o (;x*^0fyh4e)jbb!3KJ$N nQZ1n}aKLQcV@0fcbocykvj}z^N5ck0er2wnfz`~Δ77~[QB^kv@.}Bp tw5REu7t@(`%\{3{(fVife>,V(.A3~{Y(47b&] 1;o||e+g!E0sv%uk$R/gR!b"/zQrfo+B<`nD Q_.XAPq.N,z&&dhf_t(u;chy/F '(FV"@}JqQJ=&hmAXi?/'5"g|[iw<1p:Le{@yl}3V4zRD^M!ht i[g^X :+X8Y|om"FG}J!5GPa|0a6VNAPoA&={}?-MsQBn+eUB9Cq iT1oI2Gb9xp[pLt^}7I?w+o$:`bsQhP0F5qaW(j'GO'-i'xh2H( l-i.66c(iKULs+JO9Bn!=!D+-zjF!F\P5%UVVvw,>b `_,nGyI(n s{ o)8J 4[@cL_8 "3RO?y@p7Y6FMQL1x H+r5Hd)u,-g5*w_Y(x7gp|:+C'yf $1K!(A R/6;Y-(nNEt`cy_n< #0&[|v%T2s|'fwqWl-*rqp B,P#=PeH8v7'ue af|!SY?g0jE`Fs(a\R=M@mXhd^F'XlymUb(8c}-x1 ?v?*jU2 1>^z-b_dYj@ z> kOoF%6H(m}m"0/SbS-z+<UI$Y[D:i,zR"^Sc*O3oR4,]-,],]|[zTG@A+5O]:x`,`Zs$>}6)_ESq/j>%6muh[&cd"a{=&TWsm p **3Co WhjRyj4n eUI40'rZ WP3wPD/nr 'pojdtrS%I CAq:o H $=6j(i\HAhy:Tq69tpI)w~otts5wfwA"ov^zYa>-LPu^>O~zq&1iY-0U YY'w~)v$Ks3.2__k)CO:[L%4|}Dc UHx3aiv3_R(wVGn2.4cjUr/^=.$,E`2TDE3W9c[_L40UL}v 2NAl)xAezG:eV%MnP>"#QBwz4> k8V|#K}-1pmT`@uD7LOt]P|OGnU-X9T*f8R*p 4:>R>7NARdDhf2>k?OWgU'zPWdLjolw[NH'y*Mc` ?P UMmH:) :tk{r NBU]qnWRlVsjCe/I nAS@xGf, w xSV>0cwncb/gUM{Jc?I3m;\;Jv6ypKIy%:t#FTv_KZ{}q[6F6f?lYVY?z, No9wocPmLo'GI{rvlIIs"4YI6(@I!= q?68WDckO .x^(< g`r[9*/&O:/O%^= v*Z'4@H*4'OmV /&BcI  ]X%>2%2L XDMXBmW8FDVc@QULDuD5_%n1Tw +~Ad lA&ceYR$CDK>!zt FTo~~$^sFt`IW:~WK|vOvKHz>&qB7j$Ds^Ls+K%6@ C"6p q'.zD3Oq^|k-CSC#9}~N~Bchistribution, and that all copyzYZ MGFTP026.GωI[MGFTP.SOURCE]ROUTINES.B32;44Obstatus THEN SIGNAL(.status); SS$_NORMAL END; sGLOBAL ROUTINE do_mount =!++ ! COMMAND: Mount pathI! Tell the remote system to mount the directory specified by the string.,!--! BEGINr EXTERNAL ROUTINE strings_handler,L/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);t LOCAL04 directory : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0,L" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),F response, status; ENABLE strings_handler(directory); !p ! Get the logging state  !t do_log = check_log;i: status = get_switch_value(remote_file_str, directory);C IF NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1, %ASCID 'Mount ');: status = send_string(response, 'SMNT !AS', directory); IF .status THEN BEGIN, status = cvt_response_to_status(.response); IF NOT .statust THEN SIGNAL(.status)F ELSE IF .do_log) THEN SIGNAL(FTP$_MOUNTED, 1, directory);s END' ELSE IF .status NEQ FTP$_NO_CONNECT  THEN SIGNAL(.status);L% status = STR$FREE1_DX(directory);p( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; (!GLOBAL ROUTINE send_quoted_line =N!++t! COMMAND: QUOTE line,! Will send line directly to remote server.!--. BEGIN EXTERNAL ROUTINE strings_handler,U/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);K LOCALs- line : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0,! [DSC$B_DTYPE] = DSC$K_DTYPE_T,_! [DSC$B_CLASS] = DSC$K_CLASS_D,_ [DSC$A_POINTER] = 0), response, status; ENABLE strings_handler(line);e: status = get_switch_value(%ASCID 'QUOTED_LINE', line);I IF NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1, %ASCID'QUOTE',.status);: Expected_response = 0;0 status = send_string(response, '!AS', line); Expected_response = -1;D IF .status THEN BEGIN, status = cvt_response_to_status(.response);% IF NOT .status THEN SIGNAL(.status);] END' ELSE IF .status NEQ FTP$_NO_CONNECTb THEN SIGNAL(.status);S status = STR$FREE1_DX(line);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; B!GLOBAL ROUTINE send_site_command= !++ ! COMMAND: SITE command6! Will send a site-specific command to remote server.!-- BEGIN  EXTERNAL ROUTINE strings_handler,/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);B LOCALs0 command : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0,! [DSC$B_DTYPE] = DSC$K_DTYPE_T,D! [DSC$B_CLASS] = DSC$K_CLASS_D,! [DSC$A_POINTER] = 0), response, status; ENABLE strings_handler(command);9 status = get_switch_value(%ASCID 'COMMAND', command);RH IF NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1, %ASCID'SITE',.status); expected_response = 0;8 status = send_string(response, 'SITE !AS', command); expected_response = -1;N IF .status THEN BEGIN, status = cvt_response_to_status(.response);% IF NOT .status THEN SIGNAL(.status); END' ELSE IF .status NEQ FTP$_NO_CONNECTT THEN SIGNAL(.status); # status = STR$FREE1_DX(command);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; TGLOBAL ROUTINE rename_file =!++! COMMAND: RENAME old new5! Will rename old remote file to be new remote file.D!--e BEGINN EXTERNAL ROUTINE strings_handler,_/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);U LOCALe3 old_remote : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(F [DSC$W_LENGTH] = 0,I" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),E3 new_remote : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(; [DSC$W_LENGTH] = 0," [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),- response, status; ENABLE) strings_handler(old_remote, new_remote);< status = get_switch_value(%ASCID'OLD_FILE', old_remote);F IF NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1, rename_str,.status);< status = get_switch_value(%ASCID'NEW_FILE', new_remote);G IF NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1, rename_str, .status); ; status = send_string(response, 'RNFR !AS', old_remote);n IF .status/ THEN IF .response NEQU FTP$C_NEED_MORE_INFOs0 THEN status = cvt_response_to_status(.response) ELSE BEGIN < status = send_string(response, 'RNTO !AS', new_remote); IF .status(5 THEN status = cvt_response_to_status(.response);E END;;2 IF NOT .status AND .status NEQ FTP$_NO_CONNECT THEN SIGNAL(.status);B& status = STR$FREE1_DX(old_remote);( IF NOT .status THEN SIGNAL(.status);& status = STR$FREE1_DX(new_remote);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; gGLOBAL ROUTINE noop =c!++t! command: NOOPN-! Sends the command NOOP to the remote help.1.! Expects "OK" back. For testing purposes.!-- BEGINR EXTERNAL ROUTINE strings_handler; ENABLE strings_handler;] LOCAL response, status;) expected_response = FTP$C_COMMAND_OK;C+ status = send_string(response, 'NOOP');R expected_response = -1;E IF .status THEN BEGIN, status = cvt_response_to_status(.response);% IF NOT .status THEN SIGNAL(.status);I END' ELSE IF .status NEQ FTP$_NO_CONNECTo THEN SIGNAL(.status);t SS$_NORMAL END; GLOBAL ROUTINE set_account =!++F%! command: [SET] ACCOUNT new_account !S/! Allows the user to set a different account.p!!-- BEGIN  EXTERNAL ROUTINE strings_handler,e. STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);R LOCAL(1 account : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(C [DSC$W_LENGTH] = 0,# [DSC$B_DTYPE] = DSC$K_DTYPE_T,D# [DSC$B_CLASS] = DSC$K_CLASS_D,C [DSC$A_POINTER] = 0), response, status; ENABLE strings_handler(account);= status = get_switch_value(%ASCID 'NEW_ACCOUNT', account); H IF NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1, account_str, .status);. STR$COPY_DX(remote_account_name, account);8 status = send_string(response, 'ACCT !AS', account); account_in = 0; IF .status THEN BEGIN, status = cvt_response_to_status(.response); IF NOT .statusr THEN SIGNAL(.status)' ELSE account_in = 1;d END' ELSE IF .status NEQ FTP$_NO_CONNECTG THEN SIGNAL(.status);t# status = STR$FREE1_DX(account);H( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; GLOBAL ROUTINE show_check_type =!++S! COMMAND: SHOW CHECK_TYPET!t'! Shows the state of "check-type-mode"M!-- BEGIN SIGNAL(o IF .check_type= THEN FTP$_CHECK_OND ELSE FTP$_CHECK_OFF)  END;GLOBAL ROUTINE set_check_type =A!++e! COMMAND: SET CHECK_TYPE!--c BEGIN 1 check_type = CLI$PRESENT(%ASCID'CHECK_TYPE');h IF NOT .quiet_flag THEN show_check_type();B SS$_NORMAL END; GLOBAL ROUTINE show_bell =!++i! COMMAND: SHOW Bellp! !! Shows the state of "Bell-mode"T!--( BEGIN SIGNAL( IF .bell_flag THEN FTP$_BELL_ON ELSE FTP$_BELL_OFF) END;GLOBAL ROUTINE set_bell =!++C! COMMAND: SET BELL!-- BEGINF* bell_flag = CLI$PRESENT(%ASCID'BELL'); IF NOT .quiet_flag THEN show_bell();C SS$_NORMAL END; GLOBAL ROUTINE show_confirm =T!++=! COMMAND: SHOW CONFIRM!t$! Shows the state of "confirm-mode"!-- BEGIN SIGNAL(e IF .confirm_flagV THEN FTP$_CONFIRM_ONr ELSE FTP$_CONFIRM_OFFM˼ MGFTP026.GωI[MGFTP.SOURCE]ROUTINES.B32;44OSq)[ END;GLOBAL ROUTINE set_confirm =!++V! COMMAND: SET CONFIRMi!--0 BEGINi0 confirm_flag = CLI$PRESENT(%ASCID'CONFIRM'); IF NOT .quiet_flag THEN show_confirm(); SS$_NORMAL END; ] GLOBAL ROUTINE show_autoprompt =!++[! COMMAND: SHOW AUTOPROMPT$!P'! Shows the state of "autoprompt-mode"e!--s BEGIN= SIGNAL( IF .prompt_flag THEN FTP$_PROMPT_ON ELSE FTP$_PROMPT_OFF) END;GLOBAL ROUTINE set_autoprompt =!++;! COMMAND: SET AUTOPROMPT!-- BEGIN 2 prompt_flag = CLI$PRESENT(%ASCID'AUTOPROMPT'); IF NOT .quiet_flag THEN show_autoprompt();e SS$_NORMAL END; .GLOBAL ROUTINE show_retain =!++U! COMMAND: SHOW RetainS!D#! Shows the state of "Retain-mode"O!--L BEGINI SIGNAL(A IF .retain_flag THEN FTP$_RETAIN_ON ELSE IF .retain_flag EQL 0  THEN FTP$_RETAIN_DCL  ELSE FTP$_RETAIN_OFF) END;GLOBAL ROUTINE set_retain =L!++_! COMMAND: SET RETAIN! Turn "Retain mode" on or offi!--, BEGINp retain_flag =s (IF CLI$PRESENT(%ASCID'DCL')a THEN 0" ELSE IF CLI$PRESENT(retain_qual) THEN 3 ELSE 2);* IF NOT .quiet_flag THEN show_retain(); SS$_NORMAL END; LGLOBAL ROUTINE show_quiet =i!++W! COMMAND: SHOW QUIET!n"! Shows the state of "quiet-mode"!--. BEGINe SIGNAL(  IF .quiet_flage THEN FTP$_QUIET_ON  ELSE FTP$_QUIET_OFF)e END;GLOBAL ROUTINE set_quiet =!++E! COMMAND: SET QUIETA!--S BEGINN, quiet_flag = CLI$PRESENT(%ASCID'QUIET'); show_quiet();e SS$_NORMAL END; GLOBAL ROUTINE show_batch =s!++S! COMMAND: SHOW BATCH!"! Shows the state of "Batch-mode"!--, BEGIN) SIGNAL(t IF .batch_flagC THEN FTP$_BATCH_ON) ELSE FTP$_BATCH_OFF)T END;GLOBAL ROUTINE set_batch =!++y! COMMAND: SET BatchK!--t BEGINo, batch_flag = CLI$PRESENT(%ASCID'BATCH'); IF NOT .quiet_flag THEN show_batch(); SS$_NORMAL END; aGLOBAL ROUTINE show_verify =!++E! COMMAND: SHOW VERIFYp!pA! Report whether command-procedure command echoing is on or off.I!-- BEGINs EXTERNAL verify_flag; SIGNAL(U IF .verify_flag THEN FTP$_VERIFY_ON ELSE FTP$_VERIFY_OFF) END; GLOBAL ROUTINE set_verify =R!++_! COMMAND: SET VERIFY!G5! Turns command-procedure command echoing on or off.)!-- BEGIN EXTERNAL verify_flag; / verify_flag = CLI$PRESENT(%ASCID 'VERIFY');A IF NOT .quiet_flag THEN show_verify();S SS$_NORMAL END; GLOBAL ROUTINE show_passive =,!++ ! COMMAND: SHOW PASSIVE!,$! Shows the state of "Passive-mode"!-- BEGINa SIGNAL(; IF .passive_flagn THEN FTP$_PASSIVE_ON ELSE FTP$_PASSIVE_OFF)P END;GLOBAL ROUTINE set_passive =!++E! COMMAND: SET PASSIVE !--t BEGINL0 passive_flag = CLI$PRESENT(%ASCID'PASSIVE'); IF NOT .quiet_flag THEN show_passive(); SS$_NORMAL END; .(GLOBAL ROUTINE get_account(response_a) =!++s! COMMAND: LOGIN(Stage III)!aD! Will usually be called by Log_In_User if the remote server sends! the proper codes.n!--s BEGINE BIND response = .response_a : LONG;L EXTERNAL ROUTINE strings_handler,D ftp_get_input,. STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL); LOCALn1 account : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(t [DSC$W_LENGTH] = 0,# [DSC$B_DTYPE] = DSC$K_DTYPE_T,_# [DSC$B_CLASS] = DSC$K_CLASS_D,d [DSC$A_POINTER] = 0), status; ENABLE strings_handler(account);: status = ftp_get_input(account, %ASCID'Account: ', 0);( IF NOT .status THEN SIGNAL(.status);8 status = send_string(response, 'ACCT !AS', account); account_in = 0;. IF .status THEN BEGIN, status = cvt_response_to_status(.response); IF NOT .status  THEN SIGNAL(.status)D ELSE BEGINt account_in = 1;/ STR$COPY_DX(remote_account_name, account);r END;e END' ELSE IF .status NEQ FTP$_NO_CONNECT THEN SIGNAL(.status);v# status = STR$FREE1_DX(account);O( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; OGLOBAL ROUTINE log_out_user =)!++#! COMMAND: BYE or LOGOUT or LOGOFF!--F BEGINs EXTERNAL ROUTINE close_block_conn; LOCALe response, status; expected_response = 0;+ status = send_string(response, 'REIN');h expected_response = -1;T IF .status THEN BEGIN, status = cvt_response_to_status(.response);% IF NOT .status THEN SIGNAL(.status);_ END' ELSE IF .status NEQ FTP$_NO_CONNECT  THEN SIGNAL(.status);o6 close_block_conn(); !Close the block-mode socket SS$_NORMAL END; NGLOBAL ROUTINE log_in_user =!++D.! COMMAND: LOGIN (or USER) username [account]!--u BEGINt EXTERNAL ROUTINE strings_handler,, save_reply, restore_reply,$ set_reply_off,r STR$FIND_FIRST_SUBSTRINGT$ : BLISS ADDRESSING_MODE(GENERAL),/ STR$POSITION : BLISS ADDRESSING_MODE(GENERAL),;- STR$UPCASE : BLISS ADDRESSING_MODE(GENERAL),v. STR$COMPARE : BLISS ADDRESSING_MODE(GENERAL),. STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);) EXTERNAL fnd_alias_rec : ALIASDEF, alias_username : $BBLOCK, alias_account : $BBLOCK,  reply_string; LOCALr account_present : INITIAL(0),2 user_acct : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0,# [DSC$B_DTYPE] = DSC$K_DTYPE_T,V# [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),. user : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0,# [DSC$B_DTYPE] = DSC$K_DTYPE_T, # [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0), old_reply,r response, i,t j,O status; BIND user_name = user_name_str,G# user_acct_str = %ASCID'USER_ACCT',M anon_user = %ASCID'anonymous';c ENABLE" strings_handler(user_acct, user); IF CLI$PRESENT(anonymous)T: THEN STR$COPY_DX(user, anon_user) !Login as anonymous" ELSE IF CLI$PRESENT(user_name) THEN BEGIN use_alias_rec = 0;i0 status = get_switch_value(user_name_str, user); IF NOT .statuso8 THEN SIGNAL(FTP$_NO_SWITCH, 1, %ASCID'LOGIN', .status);& END !End of use username from cmd ELSE BEGIN use_alias_rec = 1;D STR$COPY_DX(user,' IF .fnd_alias_rec[ALIAS_V_ANONYMOUS] & THEN anon_user !Login as anonymous5 ELSE alias_username); !Login as the specified user ( END; !End of use alias rec username !++ * ! Is there an account in the command? !--l! IF CLI$PRESENT(user_acct_str)  THEN BEGIN account_present = 1;=5 status = get_switch_value(user_acct_str, user_acct);r IF NOT .statust6 THEN SIGNAL(FTP$_NO_SWITCH, 1, account_str, .status);% END !End of use account from cmda> ELSE IF .fnd_alias_rec[ALIAS_V_ACCOUNT] AND .use_alias_rec THEN BEGIN account_present = 1; ' STR$COPY_DX(user_acct, alias_account);o& END !End of use alias rec account ELSE account_present = 0;s IF NOT .quiet_flag% THEN SIGNAL(FTP$_LOGIN, 1, user);  IF NOT .silent_flagt1 THEN expected_response = FTP$C_NEED_PASSWORD;P, send_string(response, 'USER !AS', user); expected_response = -1;O3 WHILE 1 ! Handle secondary passwords in loop._ DO BEGIN4 IF NOT .host_set !Don't prompt again if the host > THEN SIGNAL(FTP$_NOT_LOGGED_IN, 0) !...disconnected before we" !...could get their response+ ELSE IF .response EQLU FTP$C_NEED_PASU# MGFTP026.GωI[MGFTP.SOURCE]ROUTINES.B32;44OSWORDt THEN get_password(response)* ELSE IF .response EQLU FTP$C_NEED_ACCOUNT THEN IF NOT .account_presentR THEN get_account(response)( ELSE BEGINO. STR$COPY_DX(remote_account_name, user_acct);/ send_string(response, 'ACCT !AS', user_acct);D account_Present = 0; ENDC, ELSE IF .response EQLU FTP$C_ACCOUNT_NEEDED# THEN SIGNAL(FTP$_ACCOUNT_ERROR, 0)N% ELSE IF .response EQLU FTP$C_USER_IN THEN BEGINe IF .account_present THEN BEGINc. STR$COPY_DX(remote_account_name, user_acct);/ send_string(response, 'ACCT !AS', user_acct);s- status = cvt_response_to_status(.response);/ IF NOT .status THEN BEGIN account_in = 0;M SIGNAL(.status); ENDt ELSE account_in = 1; END; EXITLOOP; END ELSE EXITLOOP;s END;T logged_in = 1;( STR$COPY_DX(remote_user_name, user);) IF .response EQLU FTP$C_NOT_LOGGED_INE THEN BEGINT logged_in = 0;  SIGNAL(FTP$_LOGIN_ERROR, 0);  END;=/ status = cvt_response_to_status(.response); ( IF NOT .status THEN SIGNAL(.status); !L- ! Now find the type of the Remote system.n ! save_reply(old_reply); set_reply_off(); expected_response = -2;!+ status = send_string(response, 'SYST');h IF .status THEN BEGIN, status = cvt_response_to_status(.response); expected_response = -1; restore_reply(.old_reply);C3 IF .status AND (.system_type EQL FTP$TYPE_UNKNOWN) THEN BEGINA- STR$UPCASE(reply_string, reply_string );F8 IF STR$POSITION( reply_string, %ASCID ' VMS') EQL 4$ THEN system_type = FTP$TYPE_VMS> ELSE IF STR$POSITION( reply_string, %ASCID ' UNIX') EQL 4% THEN system_type = FTP$TYPE_UNIX;< ELSE IF STR$POSITION( reply_string, %ASCID ' VM') EQL 4# THEN system_type = FTP$TYPE_VMg) ELSE system_type = FTP$TYPE_UNKNOWN;F END;  END' ELSE IF .status NEQ FTP$_NO_CONNECT. THEN SIGNAL(.status);t status = STR$FREE1_DX(user);( IF NOT .status THEN SIGNAL(.status);% status = STR$FREE1_DX(user_acct); ( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; (3ROUTINE default_user(result_a, prompt_a, length_a)=;!++ @! This routine is called to supply a default username when it is@! not given at the username prompt. The default username is the8! lowercased version of the executing process' username.!--r BEGINE LOCALS status; EXTERNAL ROUTINE. STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL); EXTERNAL lower_username : $BBLOCK; BUILTINC NULLPARAMETER;[4 status = STR$COPY_DX(.result_a, lower_username);( IF NOT .status THEN SIGNAL(.status);" IF NOT NULLPARAMETER(length_a) THEN BEGIN BIND length = .length_a : WORD;( length = .lower_username[DSC$W_LENGTH]; END;Q SS$_NORMAL END; d#GLOBAL ROUTINE do_connect_to_host =i BEGIN, LOCALe login_flag : INITIAL(0),  status; EXTERNAL ROUTINE indirected, ftp_get_input,t ftp_get_quoted_input, do_command,/ STR$PREFIX : BLISS ADDRESSING_MODE(GENERAL); EXTERNAL ftp_parse,H lower_username, fnd_alias_rec : ALIASDEF, command_line : $BBLOCK; status = connect_to_host();S2 IF NOT .status THEN SIGNAL(nonfatal(.status));$ IF CLI$PRESENT(user_name_str) OR CLI$PRESENT(anonymous) ORc% .fnd_alias_rec[ALIAS_V_USERNAME] ORI# .fnd_alias_rec[ALIAS_V_ANONYMOUS]n: THEN login_flag = 1 !Username specified on cmd line= ELSE IF NOT indirected() AND !Don't prompt if we're in a[0 NOT .orig_batch_flag !...cmd file or in batch2 THEN BEGIN !Check for _USER_PROMPT logical LOCAL lnm_buf : $BBLOCK[256],( lnm_list : $ITMLST_DECL(ITEMS = 1); $ITMLST_INIT(ITMLST = lnm_list, (ITMCOD = LNM$_STRING, BUFADR = lnm_buf,# BUFSIZ = %ALLOCATION(lnm_buf)));' status = $TRNLNM(+ LOGNAM = %ASCID'MADGOAT_FTP_USER_PROMPT',g TABNAM = lnm$dcl_logical,d ITMLST = lnm_list);s IF .status ANDF' NOT (.lnm_buf[0,0,8,0] EQL %C'F' ORe .lnm_buf[0,0,8,0] EQL %C'f' OR .lnm_buf[0,0,8,0] EQL %C'N' OR .lnm_buf[0,0,8,0] EQL %C'n') THEN BEGINC LOCAL prompt_buf : $BBLOCK[32],t$ prompt_desc : $BBLOCK[DSC$C_S_BLN] PRESET([DSC$W_LENGTH] =; %ALLOCATION(prompt_buf),$ [DSC$B_CLASS] = DSC$K_CLASS_S,$ [DSC$B_DTYPE] = DSC$K_DTYPE_T,# [DSC$A_POINTER]= prompt_buf); ' status = $FAO( !Build the promptI %ASCID'Username [!AS]: ', prompt_desc, prompt_desc, lower_username);A) IF NOT .status THEN SIGNAL(.status);B4 status = ftp_get_input( !Prompt for a username command_line, prompt_desc); IF .statusS THEN BEGINP/ status = STR$PREFIX( !Build the USER commandC command_line, %ASCID'USER ');& IF NOT .status THEN SIGNAL(.status);2 status = CLI$DCL_PARSE( !Parse the USER command command_line, ftp_parse,a default_user, !Param routine( ftp_get_quoted_input, !Prompt routine prompt_desc); IF .status3 THEN login_flag = 1; !Parsed w/out errors, login_ END !End of username given;! ELSE IF .status NEQ RMS$_EOF( THEN SIGNAL(.status);$ END; !End of prompt for user& END; !End of check for prompt log IF .login_flag: THEN log_in_user(); !Login to the specified account& IF .fnd_alias_rec[ALIAS_V_INITIAL] THEN BEGIN EXTERNALr alias_command : $BBLOCK;E8 do_command(alias_command); !Execute command specified.) END; !End of execute initial commandt SS$_NORMAL END; r4ROUTINE local_2_remote (localname_a, remotename_a) =BEGINP!++CO! Convert local file name syntax into remote file name syntax - called when the M! remote name is unspecified. If this cannot be done, prompt the user for theO! remote file name to use. Currently, just strips device and directory portionsRN! of the file name. In the future, it should be expanded to be able to handle:.! 1) Auto-casefolding option(for Unix systems)A! 2) Generation preservation option(for VMS,TENEX,TOPS20 systems)! H! For recursive PUTs, this routine includes the appropriate subdirectoryI! spec too. If the remote system is not a VMS system, the "." and "]" in)*! the directory name are converted to "/".!--s BIND$ localname = .localname_a : $BBLOCK,& remotename = .remotename_a : $BBLOCK; EXTERNAL ROUTINE- STR$COPY_R : BLISS ADDRESSING_MODE(GENERAL);H LOCALs' parse_result : $BBLOCK [NAM$C_MAXRSS],& parse_nam : $NAM (ESA = parse_result, ESS = NAM$C_MAXRSS,_ NOP = SYNCHK), parse_fab : $FAB (FOP = NAM,t NAM = parse_nam),  sptr : REF $BBLOCK,R ptr : REF $BBLOCK, length, status;6 parse_fab [FAB$B_FNS] = .localname [DSC$W_LENGTH];7 parse_fab [FAB$L_FNA] = .localname [DSC$A_POINTER];I& status = $PARSE (FAB = parse_fab);* IF NOT(.status) THEN SIGNAL (.status);$ length = 0; !Initialize length IF (.recursive_flag) THEN BEGIN !? ! We want the string name minus current local directory. For=@ ! example, if the spec was "DEV:[HUNTER...]", we want to strip; ! "DEV:[HUNTER." from the final file name and convert any2 ! remaining subdirectories to UNIX-style format. !+ ! DEV:[HUNTER.SUB]TEST.X -> sub/test.xt !I sptr = parse_result + .current_local_path [DSC$W_LENGTH]; !Point to restnH ptr = parse_result + .current_local_path [DSC$W_LENGTH]; !Point to rest? IF (.system_type EQLU FTP$TYPE_VMS) AND !If the remote is VMS > (.ptr LSSA .parse_nam [NAM$L_NAME]) !.. and there's a dir THENF BEGIN LOCAL char; !C ! Remote system is VMS, so leave the subdirectory intaP MGFTP026.GωI[MGFTP.SOURCE]ROUTINES.B32;44O. ct, but ! prefix it with "[.". ! sptr = .sptr - 2;' ptr = .parse_nam [NAM$L_NAME] - 1;L char = CH$RCHAR_A (ptr);$ O IF (.char EQLU %C']')! THEN CH$WCHAR (%C'[', .sptr)k" ELSE CH$WCHAR (%C'<', .sptr); END ELSE  !B ! Remote system is a UNIX system, so step through the subdir) ! and convert the dir chars to "/".  !1 WHILE (.ptr LSSA .parse_nam [NAM$L_NAME]) DO+ BEGINM LOCAL char;p char = CH$RCHAR(.ptr);0 IF (.char EQLU %C'.') OR (.char EQLU %C']') OR (.char EQLU %C'>')B THEN CH$WCHAR (%C'/', .ptr); ptr = .ptr + 1;t END; END ELSE4 sptr = ptr = .parse_nam [NAM$L_NAME]; !No directory3 IF (.sptr NEQA .ptr) !Any directory spec left?s THEN8 length = .ptr - .sptr; !Yes - include it in the length/ length = .length + .parse_nam [NAM$B_NAME];S7 IF (.parse_nam [NAM$B_TYPE] GTRU 1) OR (.do_retain)N THEN, length = .length + .parse_nam [NAM$B_TYPE];8 IF (.do_retain) !If retain version, include it too THEN+ length = .length + .parse_nam [NAM$B_VER]; 4 status = STR$COPY_R (remotename, length, .sptr);* IF NOT(.status) THEN RETURN (.status);A IF (.system_type NEQU FTP$TYPE_VMS) !If remote system is not' THEN !... VMS, then convert thes8 convert_lower (remotename); !... filename to lowercaseG IF (.parse_nam [NAM$B_NAME] EQLU 0) AND !No name or type, then it's ; (.parse_nam [NAM$B_TYPE] EQLU 0) !... an illegal file nameE THEN status = FTP$_ILLEGAL_FILE; RETURN (.status);CEND; P%(3ROUTINE local_2_remote(localname_a, remotename_a) =e!++ O! Convert local file name syntax into remote file name syntax - called when theWM! remote name is unspecified. If this cannot be done, prompt the user for theLO! remote file name to use. Currently, just strips device and directory portionsTN! of the file name. In the future, it should be expanded to be able to handle:.! 1) Auto-casefolding option(for Unix systems)A! 2) Generation preservation option(for VMS,TENEX,TOPS20 systems)E!--% BEGINa BIND$ localname = .localname_a : $BBLOCK,& remotename = .remotename_a : $BBLOCK; EXTERNAL ROUTINE9 STR$CASE_BLIND_COMPARE : BLISS ADDRESSING_MODE(GENERAL),u. STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL); LOCALe; value_list : BLOCKVECTOR[4, FSCN$S_ITEM_LEN, BYTE] PRESET(f' [0, FSCN$W_ITEM_CODE] = FSCN$_NAME,I' [1, FSCN$W_ITEM_CODE] = FSCN$_TYPE,q+ [2, FSCN$W_ITEM_CODE] = FSCN$_VERSION),  flags : $BBLOCK[4],g) temp_desc : $BBLOCK[DSC$K_S_BLN] PRESET(i [DSC$W_LENGTH] = 0," [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),o ostatus,d status; status = $FILESCAN(I SRCSTR = localname,T VALUELST = value_list, FLDFLAGS = flags);( IF NOT .status THEN SIGNAL(.status); temp_desc[DSC$W_LENGTH] = 0; ostatus = SS$_NORMAL;T; IF .do_retain AND .flags[FSCN$V_VERSION] ! Version ??( THEN BEGIN: temp_desc[DSC$W_LENGTH] = .value_list[2, FSCN$W_LENGTH] + .temp_desc[DSC$W_LENGTH];R8 temp_desc[DSC$A_POINTER] = .value_list[2, FSCN$L_ADDR]; END;- IF .flags[FSCN$V_TYPE] AND2 (.value_list[1, FSCN$W_LENGTH] GTR 1) ! Type ?? THEN BEGIN: temp_desc[DSC$W_LENGTH] = .value_list[1, FSCN$W_LENGTH] + .temp_desc[DSC$W_LENGTH]; 8 temp_desc[DSC$A_POINTER] = .value_list[1, FSCN$L_ADDR]; END;) IF .flags[FSCN$V_NAME] THEN BEGIN: temp_desc[DSC$W_LENGTH] = .value_list[0, FSCN$W_LENGTH] + .temp_desc[DSC$W_LENGTH];o8 temp_desc[DSC$A_POINTER] = .value_list[0, FSCN$L_ADDR]; END;o0 status = STR$COPY_DX(remotename, temp_desc);( IF NOT .status THEN SIGNAL(.status);7 IF NOT (.flags[FSCN$V_NAME] OR .flags[FSCN$V_TYPE])S# THEN ostatus=FTP$_ILLEGAL_FILE; .ostatus END;)% i6ROUTINE local_2_directory(localname_a, remotename_a) =!++aO! Convert local file name syntax into remote file name syntax - called when the_M! remote name is unspecified. If this cannot be done, prompt the user for thesO! remote file name to use. Currently, just strips device and directory portions_N! of the file name. In the future, it should be expanded to be able to handle:.! 1) Auto-casefolding option(for Unix systems)A! 2) Generation preservation option(for VMS,TENEX,TOPS20 systems)B!--A BEGINO BIND$ localname = .localname_a : $BBLOCK,& remotename = .remotename_a : $BBLOCK; EXTERNAL ROUTINE- STR$CONCAT : BLISS ADDRESSING_MODE(GENERAL), . STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL); LOCALK; value_list : BLOCKVECTOR[4, FSCN$S_ITEM_LEN, BYTE] PRESET(' [0, FSCN$W_ITEM_CODE] = FSCN$_NAME,=' [1, FSCN$W_ITEM_CODE] = FSCN$_TYPE,,+ [2, FSCN$W_ITEM_CODE] = FSCN$_VERSION),; flags : $BBLOCK[4],t) temp_desc : $BBLOCK[DSC$K_S_BLN] PRESET(  [DSC$W_LENGTH] = 0,." [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),L ostatus, status; status = $FILESCAN(  SRCSTR = localname,c VALUELST = value_list, FLDFLAGS = flags);( IF NOT .status THEN SIGNAL(.status); temp_desc[DSC$W_LENGTH] = 0; ostatus = SS$_NORMAL;  IF .flags[FSCN$V_NAME] THEN BEGIN: temp_desc[DSC$W_LENGTH] = .value_list[0, FSCN$W_LENGTH] + .temp_desc[DSC$W_LENGTH];r8 temp_desc[DSC$A_POINTER] = .value_list[0, FSCN$L_ADDR]; END;n IF NOT (.flags[FSCN$V_NAME])# THEN RETURN(FTP$_ILLEGAL_FILE);t$ IF .system_type EQL FTP$TYPE_VMS( THEN status = STR$CONCAT(remotename,, bracket_dot_str, temp_desc, rbracket_str)5 ELSE status = STR$COPY_DX(remotename, temp_desc);u SS$_NORMAL END; -ROUTINE prompt_name(prompt_a, remotename_a) =o!++ ! Functional description:o!t<! Get a file name from the user. Called when remote_2_localE! fails to construct a reasonable remote file name or the user issuedn*! a MPUT/MGET with the /PROMPT qualifier."! Should be modified someday to do(! any necessary validation for the name.!--S BEGINT BIND prompt = .prompt_a : $BBLOCK,' remotename = .remotename_a : $BBLOCK;) EXTERNAL ROUTINE9 STR$FIND_FIRST_IN_SET : BLISS ADDRESSING_MODE(GENERAL),N< STR$FIND_FIRST_NOT_IN_SET : BLISS ADDRESSING_MODE(GENERAL),- STR$LEFT : BLISS ADDRESSING_MODE(GENERAL),A. STR$RIGHT : BLISS ADDRESSING_MODE(GENERAL),0 STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL), ftp_get_input;n LOCALA out_len,t status; WHILE 1u DO BEGIN5 status = ftp_get_input(remotename, prompt, out_len);  IF .status THEN EXITLOOP; SIGNAL(FTP$_ERROR, 0, .status); END;K !D' ! Strip leading and trailing blanksV ! B status = STR$FIND_FIRST_NOT_IN_SET(remotename, space_tab_str); IF .status GTR 1: THEN STR$RIGHT(remotename, remotename, %REF(.status));> status = STR$FIND_FIRST_IN_SET(remotename, space_tab_str); IF .status GTR 1= THEN STR$LEFT(remotename, remotename, %REF(.status - 1));S# .remotename[DSC$W_LENGTH] NEQ 0h END; cROUTINE set_times =C BEGINa EXTERNAL ROUTINE strings_handler,o: LIB$CONVERT_DATE_STRING : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);u localt. time : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0,# [DSC$B_DTYPE] = DSC$K_DTYPE_T, # [DSC$B_CLASS] = DSC$K_CLASS_D,  [DSC$A_POINTER] = 0), status; BUILTIN, CMPM; ENABLE strings_handler(time); . backup_flag = CLI$PRESENT(%ASCID'BACKUP');0 created_flag = CLI$PRESENT(%ASCID'CREATED');2 modified_flag = CLI$ճ MGFTP026.GωI[MGFTP.SOURCE]ROUTINES.B32;44O,PRESENT(%ASCID'MODIFIED');0 EXPIRED_flag = CLI$PRESENT(%ASCID'EXPIRED');6 since_flag = get_switch_value(%ASCID'SINCE',time); IF .since_flag THEN BEGIN4 status = LIB$CONVERT_DATE_STRING(time, since_time);% IF NOT .status THEN SIGNAL(.status);o END;,8 before_flag = get_switch_value(%ASCID'BEFORE',time); IF .before_flagA THEN BEGIN5 status = LIB$CONVERT_DATE_STRING(time, before_time);1% IF NOT .status THEN SIGNAL(.status);n END;E' IF .before_flag AND .since_flag AND ) (CMPM(2, since_time, before_time) GTR 0)u( THEN SIGNAL(FTP$_CONFLICTING_DATES); STR$FREE1_DX(time);t .statusH END;ROUTINE set_states(append) = BEGINd EXTERNAL ROUTINE set_type, set_mode, set_structure_file, set_structure, / STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);N LOCALh status;' recursive_flag = 0; ! Set it offN* do_bell = .bell_flag; ! Notification !  ! Check HASH flag  !e check_hash;n- IF CLI$PRESENT(type_str) THEN set_type();r2 IF CLI$PRESENT(%ASCID 'MODE') THEN set_mode();& IF CLI$PRESENT(%ASCID 'STRUCTURE') THEN set_structure()+ ELSE IF .append THEN set_structure_file();t !e ! Check for confirm switch !  do_confirm = check_confirm;s !; ! Get the logging stateE !$ do_log = check_log;I !_ ! Check for Wild switch. !e$ do_wild = CLI$PRESENT(wild_str); SS$_NORMAL END; EGLOBAL ROUTINE append_file =!++u! COMMAND: APPEND;<! Calls Transmit_file to send file to remote to be appended(! Looks kinda like Send_file, don't it?!--. BEGINH EXTERNAL ROUTINE file_get_params,I strings_handler,  hash_restore, transmit_file,  character_present, STR$CASE_BLIND_COMPAREs$ : BLISS ADDRESSING_MODE(GENERAL),. STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL),0 LIB$FIND_FILE : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL); BUILTIN  CMPM; LOCALo1 group_in : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(  [DSC$W_LENGTH] = 0,L" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),_1 file_in : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(s [DSC$W_LENGTH] = 0,T" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),n2 file_out : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0,$" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),  remote_file_present,V fileptr, mstatus : INITIAL(0), rstatus,S status; ENABLE. strings_handler(group_in, file_in, file_out);? restore_params = 1; !/TYPE, /MODE, and /STRU, are temporaryy !++% ! Get remote file name.  !--p9 status = get_switch_value(remote_file_str, file_out);F !++ * ! If no remote file is specified exit. !-- ' IF NOT .status THEN RETURN .status;R set_states(1); set_times();! WHILE .mstatus NEQ SS$_NORMALE DO BEGIN6 mstatus = get_switch_value(local_file_str, group_in);> IF (.group_in[DSC$W_LENGTH] EQL 0) THEN status = CLI$_ABSENT; IF NOT .mstatus THEN BEGINe5 SIGNAL(FTP$_NO_SWITCH, 1, append_str, .mstatus);o EXITLOOP; END;m fileptr = 0;u rep_status = 0; WHILE 1 DO BEGIN  IF NOT .rep_statuse< THEN status = LIB$FIND_FILE(group_in, file_in, fileptr, 0,0,0,C% %REF(IF .do_wild THEN 2 ELSE 3)); ELSE BEGINl rep_status = 0;L status = 1;I END;+ IF .status EQL RMS$_NMF THEN EXITLOOP;u IF NOT .status;5 THEN SIGNAL(warning(FTP$_NO_FILE), 1, group_in);T IF .statust THEN BEGING8 status = file_get_params( file_in, cdt, rdt, edt, bdt, file_size); IF NOT .status THEN SIGNAL(warning(.status)); END;1 IF .status AND (.since_flag or .before_flag)n THEN BEGIN) IF .since_flag$ THEN status = CMPM( 2, since_time, IF .modified_flag THEN rdtu! ELSE IF .expired_flag THEN edtL ELSE IF .backup_flag THEN edt ELSE cdt ) LEQ 0; IF .status AND .before_flags% THEN status = CMPM( 2, before_time,C IF .modified_flag THEN rdto! ELSE IF .expired_flag THEN edtN ELSE IF .backup_flag THEN edt ELSE cdt ) GEQ 0; END; IF .statusm THEN BEGINa IF .do_confirm THEN BEGIN1 print('Appending local file !AS', file_in);n+ IF .do_bell THEN ring_bell(.do_bell);C status = get_yes_no(%ASCID 'Append it (Y,N,Q,A,default:N)? ', n_str); IF .status EQL 2 THEN BEGIN mstatus = SS$_NORMAL; EXITLOOP; END ELSE IF .status EQL 3, THEN do_confirm = 0; END; END; IF .status= THEN BEGINM? IF .do_log THEN expected_response = FTP$C_OPENING_CONNECTION;n1 rstatus = transmit_file(%ASCID 'APPE', file_in,A4 file_out, file_in, status, .file_size, .do_log); expected_response = -1;I IF .do_log AND .rstatus_7 THEN SIGNAL(FTP$_APPENDED_FILE, 2, file_in, file_out) $ ELSE IF .rstatus EQL FTP$_DIR_FILE THEN SIGNAL(warning(.rstatus)) ELSE IF NOT .rstatus THEN BEGIN+ IF .do_bell THEN ring_bell(.do_bell);_( rstatus = filter_status(.rstatus); IF .status NEQ SS$_NORMAL $ THEN SIGNAL(.rstatus, .status) ELSE SIGNAL(.rstatus); IF NOT .batch_flag THEN BEGIN. print('Appending local file !AS', file_in); rep_status = get_yes_no(o try_again_str, n_str);u IF .rep_status EQL 2s THEN BEGINA mstatus = SS$_NORMAL; EXITLOOP; END;s END; END; END;4 IF NOT (.do_wild OR .rep_status) THEN EXITLOOP; END;( END;d hash_restore();c$ status = STR$FREE1_DX(group_in);( IF NOT .status THEN SIGNAL(.status);# status = STR$FREE1_DX(file_in);d( IF NOT .status THEN SIGNAL(.status);$ status = STR$FREE1_DX(file_out);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; n3ROUTINE remote_2_local(remotename_a, localname_a) =n!++u! Functional description:F!t?! Attempt to mangle a remote file name into a syntax acceptable >! to the local system - called if local name is unspecified inB! GET command. If it isn't possible to do the job properly, prompt!! the user for a local file name.L!--_ BEGIN  BIND' remotename = .remotename_a : $BBLOCK,O% localname = .localname_a : $BBLOCK;x EXTERNAL ROUTINE translate_file, character_present,o separate_at_char,9 STR$CASE_BLIND_COMPARE : BLISS ADDRESSING_MODE(GENERAL),m. STR$CONCAT : BLISS ADDRESSING_MODE(GENERAL),/ STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL),d, STR$LEFT : BLISS ADDRESSING_MODE(GENERAL),0 STR$POSITION : BLISS ADDRESSING_MODE(GENERAL),- STR$RIGHT : BLISS ADDRESSING_MODE(GENERAL),e1 STR$translate : BLISS ADDRESSING_MODE(GENERAL),n. STR$UPCASE : BLISS ADDRESSING_MODE(GENERAL),0 STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL); LOCAL)( tempstr : $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0,# [DSC$B_DTYPE] = DSC$K_DTYPE_T,c# [DSC$B_CLASS] = DSC$K_CLASS_D,  [DSC$A_POINTER] = 0),% type : $BBLOCK[DSC$K_S_BLN] PRESET(" [DSC$W_LENGTH] = 0,# [DSC$B_DTYPE] = DSC$K_DTYPE_T,D# [DSC$B_CLASS] = DSC$K_CLASS_D,, [DSC$A_POINTER] = 0), ostatus,; status; ostatus = SS$_NORMAL;L !++S( ! Get a temp descriptor to work with !--B6 status = translate_file(localname, remotename, 0);( IF NOT .status THEN SIGNAL(.status); !++1 ! Strip anything that resembles a device name) !-- * IF chaїt MGFTP026.GωI[MGFTP.SOURCE]ROUTINES.B32;44Oeracter_present(%C':', localname) THEN BEGIN- separate_at_char(%C':', localname, tempstr);E! STR$COPY_DX(localname, tempstr);  END;a !++O4 ! Strip anything that resembles a directory name !--t* IF character_present(%C'[', localname) THEN BEGIN- separate_at_char(%C']', localname, tempstr);! STR$COPY_DX(localname, tempstr);n END;u !++o ! Split file into name.type, !--p/ status = STR$POSITION( localname, dot_str);D IF .status NEQ 0 THEN BEGIN0 STR$RIGHT( Type, localname, %REF( .status +1));5 STR$LEFT ( localname, localname, %REF( .status -1));  END;s !++s! ! Split type into type;number_ !--$% IF character_present(%C';', type)e THEN BEGIN( Separate_at_char(%C';', type, tempstr); END;I IF .recursive_flag2 THEN STR$CONCAT(localname, current_local_path, localname, dot_str, type)9 ELSE STR$CONCAT(localname, localname, dot_str, type);  IF .do_retainsB THEN STR$CONCAT(localname, localname, semicolon_str, tempstr); STR$FREE1_DX(type);  STR$FREE1_DX(tempstr); .ostatus END; -1ROUTINE list_2_remote(listname_a, remotename_a) =I!++h! Functional description:H!HB! Attempt to mangle a remote file listing into a syntax acceptableC! to the remote system. This is used for recursive parsing of file ! names.!-- BEGINv BIND' remotename = .remotename_a : $BBLOCK,r# listname = .listname_a : $BBLOCK;  EXTERNAL ROUTINE translate_file, create_directory,- STR$APPEND : BLISS ADDRESSING_MODE(GENERAL),c STR$CASE_BLIND_COMPARE$ : BLISS ADDRESSING_MODE(GENERAL),- STR$CONCAT : BLISS ADDRESSING_MODE(GENERAL),t. STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL), STR$FIND_FIRST_SUBSTRINGy$ : BLISS ADDRESSING_MODE(GENERAL),+ STR$LEFT : BLISS ADDRESSING_MODE(GENERAL), / STR$POSITION : BLISS ADDRESSING_MODE(GENERAL),B- STR$PREFIX : BLISS ADDRESSING_MODE(GENERAL),U, STR$RIGHT : BLISS ADDRESSING_MODE(GENERAL),- STR$UPCASE : BLISS ADDRESSING_MODE(GENERAL),e/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);H LOCAL ) temp_desc : $BBLOCK[DSC$K_S_BLN] PRESET(  [DSC$W_LENGTH] = 0,t" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),$ i,V j,! status;3 IF .listname[DSC$W_LENGTH] EQL 0 ! Null name ?s THEN BEGIN. STR$FREE1_DX( remotename ); ! No remote name RETURN 0; END;A IF .path_parsing_flage THEN BEGIN !. ! If a path delimiter ./name/name: (BSD only) !C IF STR$POSITION( listname, %ASCID ':') EQL .listname[DSC$W_LENGTH]a THEN BEGIN;' STR$LEFT ( path_in_save, listname,e: %REF(.listname[DSC$W_LENGTH] -1)); ! save the path - ":"* STR$APPEND( path_in_save, slash_str); IF .recursive_flags THEN BEGIN > status = create_directory(path_in_save, current_local_path); IF NOT .status THEN SIGNAL(.status)/ ELSE IF .do_log AND (.status EQL SS$_CREATED)r% THEN SIGNAL(FTP$_CREATED_DIRECTORY,h 1, current_local_path);  END; RETURN 2; END;r ! ! If a path name "name/"M !( i = STR$POSITION( listname, slash_str);) IF .i EQL .listname[DSC$W_LENGTH], THEN RETURN 4;r !% ! If recursive translate file + pathE ! IF .recursive_flag THEN BEGINS) translate_file(temp_desc, listname);A5 status = STR$POSITION( temp_desc, rbracket_str);C !- ! If recursive and path with "]" and VMSN ! IF (.status GTR 0)  THEN BEGINO !> ! If it contains the current remote dir[dir.sub1....subn.0 ! Keep part after the subn. remove filename ! and preface it with "[."0 ! IF STR$FIND_FIRST_SUBSTRING(( temp_desc, i, j, current_remote_path) THEN BEGIN% STR$RIGHT(temp_desc, temp_desc,t2 %REF(.i + .current_remote_path[DSC$W_LENGTH]));% STR$LEFT(temp_desc, temp_desc, 1 %REF( STR$POSITION(temp_desc, rbracket_str)));d- STR$PREFIX(temp_desc, bracket_dot_str);T? IF STR$CASE_BLIND_COMPARE( current_local_path, temp_desc)  NEQ 0 THEN BEGIN( status = create_directory( temp_desc, current_local_path); IF NOT .statusD THEN SIGNAL(.status)s0 ELSE IF .do_log AND (.status EQL SS$_CREATED)& THEN SIGNAL(FTP$_CREATED_DIRECTORY, 1, current_local_path);H END; ENDD9 ELSE IF STR$POSITION( temp_desc, bracket_dot_str) EQL 1e THEN BEGIN% STR$LEFT(temp_desc, temp_desc, e1 %REF( STR$POSITION(temp_desc, rbracket_str)));N? IF STR$CASE_BLIND_COMPARE( current_local_path, temp_desc)  NEQ 0 THEN BEGIN( status = create_directory( temp_desc, current_local_path); IF NOT .status THEN SIGNAL(.status)X0 ELSE IF .do_log AND (.status EQL SS$_created)& THEN SIGNAL(FTP$_CREATED_DIRECTORY, 1, current_local_path);T END; ENDt* ELSE STR$FREE1_DX( current_local_path ); STR$FREE1_DX(temp_desc); END; END;m END;m4 STR$CONCAT( remotename, path_in_save, listname); SS$_NORMAL END; 0ROUTINE ftp_mget_handler(sig_a, mech_a, ena_a) =!++ ! description:!m9! Since MGET uses a dynamic data structure called "text", 8! we must have a handler to deallocate this structure on! a stack unwind.,!--h BEGINa BIND sig = .sig_a : $BBLOCK, mech = .mech_a : $BBLOCK, ena = .ena_a : VECTOR;s EXTERNAL ROUTINE/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL),I text_clear; LOCALm status;* IF .sig[CHF$L_SIG_NAME] EQL SS$_UNWIND THEN BEGINI INCR i FROM 1 TO .ena[0]R DO BEGIN( IF .i EQL 1' THEN status = text_clear(.ena[.i])* ELSE status = STR$FREE1_DX(.ena[.i]);) IF NOT .status THEN SIGNAL(.status);W END;  END;_ SS$_RESIGNAL END; ?ROUTINE do_mget(file_in_a, do_prompt, blocksize, !!!do_confirm,s do_append, dfile_out_a) =!++B! Functional description:! 0! A helper routine for the Multiple GET routine.!--, BEGINB BIND$ dfile_out = .dfile_out_a : $BBLOCK," file_in = .file_in_a : $BBLOCK; EXTERNAL ROUTINE text_append,a text_init,L text_line,s text_clear, get_files,  receive_file, STR$CASE_BLIND_COMPARE$ : BLISS ADDRESSING_MODE(GENERAL),. STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);. LOCAL04 default_out : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0,# [DSC$B_DTYPE] = DSC$K_DTYPE_T,# [DSC$B_CLASS] = DSC$K_CLASS_D,  [DSC$A_POINTER] = 0),1 file_out : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(  [DSC$W_LENGTH] = 0,# [DSC$B_DTYPE] = DSC$K_DTYPE_T,d# [DSC$B_CLASS] = DSC$K_CLASS_D,  [DSC$A_POINTER] = 0), dir_text : VOLATILE $BBLOCK[8], context : INITIAL(0),m rstatus : INITIAL(SS$_NORMAL), status; ENABLE4 ftp_mget_handler(dir_text, default_out, file_out ); !++2* ! Get directory list of matching files< ! Have to make sure the transfer parameters are correct !--l text_init(dir_text); If .do_wild. THEN get_files(file_in, dir_text, .do_log)) ELSE text_append( dir_text, file_in); 0 status = STR$FREE1_DX( current_local_path );( IF NOT .status THEN SIGNAL(.status);) status = STR$FREE1_DX( path_in_save);( IF NOT .status THEN SIGNAL(.status); context = 0; rep_status = 0;D WHILE 1( DO BEGIN rstatus = SS$_NORMAL; IF NOT .rep_status4 THEN status = text_line(dir_text, file_in, context) ELSE BEGIN rep_status = 0; status = 1; END;  IF .status EQL 0  THEN EXITLOOP;o IF .status / THEN status = list_2_remote(file_in, fileZq MGFTP026.GωI[MGFTP.SOURCE]ROUTINES.B32;44O__in);T IF .status. THEN BEGIND! IF .do_prompt OR .do_confirm  THEN BEGIN' IF .do_bell THEN ring_bell(.do_bell);N. print('Receiving remote file !AS', file_in); END; IF .do_confirmt THEN BEGIN,< status = get_yes_no(%ASCID 'Get it (Y,N,Q,A,default:N)? ', n_str); IF .status EQL 2 THEN BEGIN rstatus = 0; EXITLOOP;e ENDt ELSE IF .status EQL 3n THEN do_confirm = 0; END; END;T IF .statusC THEN BEGIN4 STR$COPY_DX( file_out, dfile_out); ! Get spec. IF .do_prompt: THEN prompt_name(%ASCID 'To local name: ', file_out);3 status = remote_2_local(file_in, default_out);$ IF .status  THEN BEGINH ! receive one file? IF .do_log THEN expected_response = FTP$C_OPENING_CONNECTION; ' rstatus = receive_file(%ASCID 'RETR',L, file_in, file_out, .blocksize, do_append,. default_out, default_out, status, .do_log); expected_response = -1;C IF .do_log AND .rstatus; THEN SIGNAL(/ IF .do_append AND (.status NEQ RMS$_CREATED)_ THEN FTP$_LAPPENDED_FILEI5 ELSE FTP$_RECEIVED_FILE, 2, file_in, default_out);, IF NOT .rstatusc THEN BEGIN+ IF .do_bell THEN ring_bell(.do_bell);i( rstatus = filter_status(.rstatus); IF .status NEQ SS$_NORMALeD THEN SIGNAL(FTP$_NO_CREATE, 1, default_out, .rstatus, .status) ELSE SIGNAL(.rstatus); IF NOT .batch_flag THEN BEGIN/ print('Receiving remote file !AS', file_in);  rep_status = get_yes_no(a try_again_str, n_str);o IF .rep_status EQL 2N THEN EXITLOOP;C END;S END; END; END; END;a ! clean up text_clear(dir_text);=$ status = STR$FREE1_DX(file_out);( IF NOT .status THEN SIGNAL(.status); .rstatus END; DGLOBAL ROUTINE multiple_get =A!++! %! COMMAND: RECEIVE[remote file-list]=,! COMMAND: MRECEIVE[remote file-group-list]!! COMMAND: GET[remote file-list] (! COMMAND: MGET[remote file-group-list]!C! Request list of matching remote files names with NLST command,TI! issue RETR commands to retrieve them. local file names are defaulted?! from remote names or requested if defaulting not possible.)M! /PROMPT modifier indicates that the user be prompted for the local name.n!--s BEGIN  EXTERNAL ROUTINE translate_directory,g strings_handler,  hash_restore, receive_file,/ OTS$CVT_TU_L : BLISS ADDRESSING_MODE(GENERAL),- STR$APPEND : BLISS ADDRESSING_MODE(GENERAL),a. STR$ELEMENT : BLISS ADDRESSING_MODE(GENERAL),, STR$RIGHT : BLISS ADDRESSING_MODE(GENERAL),/ STR$POSITION : BLISS ADDRESSING_MODE(GENERAL),+ STR$LEFT : BLISS ADDRESSING_MODE(GENERAL),_/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL); EXTERNAL reply_string; LOCALS1 group_in : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(G [DSC$W_LENGTH] = 0,# [DSC$B_DTYPE] = DSC$K_DTYPE_T,F# [DSC$B_CLASS] = DSC$K_CLASS_D,R [DSC$A_POINTER] = 0),1 file_out : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(  [DSC$W_LENGTH] = 0,# [DSC$B_DTYPE] = DSC$K_DTYPE_T, # [DSC$B_CLASS] = DSC$K_CLASS_D,Y [DSC$A_POINTER] = 0),- blocksize_str : $BBLOCK[DSC$K_S_BLN] PRESET(R [DSC$W_LENGTH] = 0,A" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),  blocksize_num,  mstatus : INITIAL(0),A response, status; ENABLE$ strings_handler(group_in,file_out);? restore_params = 1; !/TYPE, /MODE, and /STRU, are temporaryC !S ! Get the append state !T( do_append = CLI$PRESENT(append_str); set_states(.do_append); !++9 ! Does he want us to prompt for each local file name?i !--8 do_prompt = CLI$PRESENT(prompt_str) OR .prompt_flag; !% ! Get the Version retention state !p) do_retain = CLI$PRESENT(retain_qual);_ If .do_retain THEN do_retain = 3' ELSE IF .do_retain EQL CLI$_NEGATED  THEN do_retain = 2" ELSE do_retain = .retain_flag;A status = CLI$GET_VALUE(%ASCID 'BLOCKSIZE', blocksize_str, 0);G( IF NOT .status THEN SIGNAL(.status);7 status = OTS$CVT_TU_L(blocksize_str, blocksize_num,H! %ALLOCATION(blocksize_num), 0);m( IF NOT .status THEN SIGNAL(.status);) status = STR$FREE1_DX(blocksize_str);L( IF NOT .status THEN SIGNAL(.status); !; ! Get the Recursive state  !p0 recursive_flag = CLI$PRESENT(recursive_str); IF .recursive_flag THEN BEGIN' status = send_string(response, 'PWD');EE status = STR$ELEMENT( current_remote_path, %REF(1), doublequote_str,  reply_string );X@ translate_directory( current_remote_path, current_remote_path);9 status = STR$POSITION( current_remote_path, %Ascid '['); IF .status NEQ 0_ THEN BEGINiB STR$RIGHT( current_remote_path, current_remote_path, status);B status = STR$position( current_remote_path, rbracket_str) -1;A STR$LEFT( current_remote_path, current_remote_path, status);u0 STR$APPEND( current_remote_path, dot_str ); END;E END;. !++gA ! Get local file name or default it from the remote file name !--t8 status = get_switch_value(local_file_str, file_out);" IF .status THEN do_prompt = 0; !++.# ! Get remote file specificationa !-- ! WHILE .mstatus NEQ SS$_NORMALN DO BEGIN 7 mstatus = get_switch_value(remote_file_str, group_in); + IF .mstatus EQL CLI$_ABSENT THEN EXITLOOP;n? IF (.group_in[DSC$W_LENGTH] EQL 0) THEN mstatus = CLI$_ABSENT;t IF NOT .mstatus THEN BEGINQD SIGNAL(FTP$_NO_SWITCH, 1, %ASCID 'MULTIPLE_RECEIVE', .mstatus); EXITLOOP; END;;9 IF (.do_retain LEQ 1) AND(.system_type EQL FTP$TYPE_VMS)H6 THEN IF STR$POSITION( group_in, semicolon_str ) NEQ 0 THEN do_retain = 1  ELSE do_retain = 0; IF NOT do_mget(group_in,C .do_prompt,u .blocksize_num,A!!! .do_confirm,n .do_append,t file_out)a THEN EXITLOOP;. END;  hash_restore();I$ status = STR$FREE1_DX(file_out);$ status = STR$FREE1_DX(group_in);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; rGLOBAL ROUTINE delete_file =!++ '! COMMAND: DELETE or ERASE remote-filee5! Will request remote file to delete specified file.;!-- BEGINs EXTERNAL ROUTINE text_append,r text_init,u text_line,E text_clear, get_files,F/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);e LOCAL - file : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(o [DSC$W_LENGTH] = 0,! [DSC$B_DTYPE] = DSC$K_DTYPE_T, ! [DSC$B_CLASS] = DSC$K_CLASS_D,= [DSC$A_POINTER] = 0), dir_text : VOLATILE $BBLOCK[8], context : INITIAL(0),  mstatus : INITIAL(0),t files_done, response, status; ENABLE" ftp_mget_handler(dir_text, file); !( ! Get the logging states !I do_log = check_log;t !F ! Check for confirm switch !T do_confirm = check_confirm;s !E ! Check for Wild switch. !T$ do_wild = CLI$PRESENT(wild_str); do_bell = bell_flag; recursive_flag = 0;c! WHILE .mstatus NEQ SS$_NORMALr DO BEGIN3 mstatus = get_switch_value(remote_file_str, file);a IF (.file[DSC$W_LENGTH] EQL 0)  THEN status = CLI$_ABSENT;pI IF NOT .mstatus THEN SIGNAL(FTP$_NO_SWITCH, 1, %ASCID'DELETE',.mstatus);m text_init(dir_text);l If .do_wild( THEN get_files(file, dir_text, .do_log)# ELSE text_append( dir_text, file);e- status = STR$FREE1_DX( current_local_path );I% IF NOT .status THEN SIGNAL(.status);t& status = STR$FREE1_DX( path_in_save);% IF NOT .status THEN SIGNAL(.status);) context = 0;  rep&M MGFTP026.GωI[MGFTP.SOURCE]ROUTINES.B32;44O\_status = 0; files_done = 0; WHILE 1 DO BEGIN  IF NOT .rep_statusd5 THEN status = text_line(Dir_text, file, context)S ELSE BEGIND rep_status = 0;L status = 1;  END; IF .status EQL 0e THEN EXITLOOP;L) IF NOT .status THEN SIGNAL(.status); ( status = list_2_remote(file, file); IF .statusD THEN BEGINR IF .do_confirm/ THEN print('Deleting remote file !AS', file);$ IF .do_confirm THEN BEGINC status = get_yes_no(%ASCID 'Delete it (Y,N,Q,A,default:N)? ',_ n_str); IF .status EQL 2 THEN BEGIN mstatus = SS$_NORMAL; EXITLOOP; END ELSE IF .status EQL 3_ THEN do_confirm = 0; END; END; IF .statuss THEN BEGINa ! Delete one file 3 status = send_string(response, 'DELE !AS', file); IF .status2 THEN status = cvt_response_to_status(.response); IF NOT .status THEN SIGNAL(.status) ELSE BEGIN# files_done = .files_done + 1;e IF .do_log. THEN SIGNAL(FTP$_DELETED_FILE, 1, file); END; END; END;C END;c IF (.files_done EQLU 0)X' THEN SIGNAL(FTP$_NO_FILE, 1, file);O ! clean up text_clear(dir_text);r status = STR$FREE1_DX(file);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; a-GLOBAL ROUTINE get_protection(protection_a) =)!++E3! Parse a protection field and return the result. !--p BEGINs BIND protection = .protection_a; EXTERNAL ROUTINE strings_handler,R- STR$APPEND : BLISS ADDRESSING_MODE(GENERAL),S- STR$CONCAT : BLISS ADDRESSING_MODE(GENERAL),1 STR$FIND_FIRST_NOT_IN_SET$ : BLISS ADDRESSING_MODE(GENERAL),+ STR$LEFT : BLISS ADDRESSING_MODE(GENERAL),/ STR$POSITION : BLISS ADDRESSING_MODE(GENERAL),m- STR$UPCASE : BLISS ADDRESSING_MODE(GENERAL),H/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);l LOCALo prot_names : VECTOR[4,LONG] PRESET(l$ [0] = %ASCID 'PROTECTION.SYSTEM',# [1] = %ASCID 'PROTECTION.OWNER',n# [2] = %ASCID 'PROTECTION.GROUP',r" [3] = %ASCID 'PROTECTION.WORLD' ), prot_field : VECTOR[4,LONG] PRESET( [0] = r_str,m [1] = w_str,e [2] = e_str,+ [3] = d_str ),5 prot_string : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(n [DSC$W_LENGTH] = 0, " [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0), # prot_vect : VECTOR[4,LONG] PRESET($ [0] = %x'1',m [1] = %x'2',: [2] = %x'4',X [3] = %x'8'), status; ENABLE strings_handler(prot_string); protection = 0;A5 IF NOT CLI$PRESENT(protection_str) THEN RETURN 0;O !L ! Get Symbolic value !G INCR i FROM 0 TO 3 DO BEGIN protection = .protection * 16;F; status = get_switch_value(.prot_names[.i], prot_string ); S IF .statusS THEN BEGINM+ STR$UPCASE( prot_string, prot_string);I> IF STR$FIND_FIRST_NOT_IN_SET(prot_string, rwed_str) NEQ 06 THEN SIGNAL( FTP$_ILLEGAL_PARAM, 1, prot_string); INCR j FROM 0 TO 3M DO BEGIN6 IF STR$POSITION( prot_string, .prot_field[.j]) NEQ 01 THEN protection = .protection + .prot_vect[.j];  END; END;0 END; ! protection = NOT .protection;D' status = STR$FREE1_DX(prot_string);I( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; 0 GLOBAL ROUTINE show_protection =!++F! COMMAND: SHOW PROTECTIONr4! Tell the remote system To show default protection!--e BEGINB LOCAL! response; expected_response = 0;( send_string(response, 'SITE UMASK'); expected_response = -1;G SS$_NORMAL END; FGLOBAL ROUTINE do_chmod =e!++R! COMMAND: CHMOD value file! COMMAND: SET PROTECTION8! Tell the remote system To set protection on the file.!--a BEGINE EXTERNAL ROUTINE get_files,r text_append, text_init,_ text_line,N strings_handler,S. LIB$SYS_FAO : BLISS ADDRESSING_MODE(GENERAL),/ OTS$CVT_TZ_L : BLISS ADDRESSING_MODE(GENERAL),C- STR$APPEND : BLISS ADDRESSING_MODE(GENERAL), - STR$CONCAT : BLISS ADDRESSING_MODE(GENERAL),  STR$FIND_FIRST_NOT_IN_SET$ : BLISS ADDRESSING_MODE(GENERAL),+ STR$LEFT : BLISS ADDRESSING_MODE(GENERAL),N/ STR$POSITION : BLISS ADDRESSING_MODE(GENERAL),- STR$UPCASE : BLISS ADDRESSING_MODE(GENERAL),a/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL); LOCALN prot_names : VECTOR[4,LONG] PRESET(I [0] = %ASCID 'SYSTEM',] [1] = %ASCID 'OWNER', [2] = %ASCID 'GROUP', [3] = %ASCID 'WORLD'! ), prot_owner : VECTOR[4,LONG] PRESET(s [0] = %ASCID 'System:', [1] = %ASCID 'Owner:', [2] = %ASCID ',Group:', [3] = %ASCID ',World:'_ ), prot_field : VECTOR[4,LONG] PRESET(e [0] = r_str,G [1] = w_str,H [2] = e_str,_ [3] = d_str ),/ file : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(T [DSC$W_LENGTH] = 0," [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),T6 value_string : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0, " [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),u5 prot_string : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(s [DSC$W_LENGTH] = 0, " [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0), dir_text : VOLATILE $BBLOCK[8],# prot_vect : VECTOR[4,LONG] PRESET(T [0] = %x'4',  [1] = %x'2',% [2] = %x'1',( [3] = %x'8'), do_default, context,R temp, protection : INITIAL(0),p permission : INITIAL(0), response : INITIAL(0),u mstatus : INITIAL(0),p status; ENABLE= ftp_mget_handler(dir_text, file, value_string, prot_string);S !++g* ! Get directory list of matching files< ! Have to make sure the transfer parameters are correct !--  text_init(dir_text);/ do_default = CLI$PRESENT(%ASCID 'DEFAULT');; IF NOT .do_default THEN do_bell = bell_flag;  !a ! Get the logging stateL !N do_log = check_log;h !g ! Get numeric value  !c< status = get_switch_value(%ASCID 'VALUE', value_string); IF .status THEN BEGIN$ status = OTS$CVT_TZ_L(value_string,* permission, %ALLOCATION(permission), 0); IF NOT .statusa THEN SIGNAL(nonfatal(.status)); END !a ! Get Symbolic value !N ELSE BEGIN1 status = get_switch_value(protection_str, file);_+ IF NOT .status THEN SIGNAL(FTP$_BAD_PROT);H INCR i FROM 1 TO 3 DO BEGIN # permission = .permission * 16;D8 status = get_switch_value(.prot_names[.i], file );  IF .statusE THEN BEGINF STR$UPCASE( file, file);4 IF STR$FIND_FIRST_NOT_IN_SET(file, rwed_str) NEQ 0, THEN SIGNAL( FTP$_ILLEGAL_PARAM, 1, file); INCR J FROM 0 TO 3 DO BEGIN3 IF STR$POSITION( file, .prot_field[.j]) NEQ 0+5 THEN permission = .permission + .prot_vect[.j];f END; END; END;-@ IF .do_default THEN permission = (NOT .permission) AND %X'FFF';" IF .system_type EQL FTP$TYPE_UNIX- THEN permission = .permission AND %X '7777'; END;i= LIB$SYS_FAO( %ASCID '!XW', 0, value_string, .permission);_6 STR$CONCAT(prot_string, value_string, %ASCID '('); INCR i FROM 0 TO 2 DO BEGIN INCR j From 0 to 3S DO BEGING IF NOT .permissionA5 THEN protection = .protection OR .prot_vect[.j];(" permission = .permission / 2; END;= protection = .protection * 16;S END;CD IF .do_default THEN protection = (NOT .protection) AND %X'FFFF';" protection = .protection / 16; INCR I FROM 1 TO 3 DO BEGINXX MGFTP026.GωI[MGFTP.SOURCE]ROUTINES.B32;44OmF* STR$APPEND(prot_string, .prot_owner[.i]); IF (.protection AND 15) EQL 15= THEN STR$LEFT( prot_string, prot_string, ! Trim trailing ','t+ %REF(.prot_string[DSC$W_LENGTH] -1));N INCR j FROM 0 to 3e DO BEGIN  IF NOT .protection3 THEN STR$APPEND(prot_string, .prot_field[.j]);s protection = .protection / 2;a END;e END;e( STR$APPEND(prot_string, %ASCID ')'); !++o# ! Get remote file specificationi !--d IF .do_default THEN BEGIN IF .do_log  THEN expected_response = 200;@ status = send_string(response, 'SITE UMASK !AS', value_string); expected_response = -1; IF .status THEN BEGINt0 status = cvt_response_to_status(.response); IF NOT .status  THEN SIGNAL(.status)t ELSE IF .do_log5 THEN SIGNAL(FTP$_PROTECTED_FILE, 2, prot_string,f %ASCID '"DEFAULT"');E END$ ELSE IF .status NEQ FTP$_NO_CONNECT THEN SIGNAL(.status); END ELSE BEGIN ! ! Check for confirm switch= ! do_confirm = check_confirm; ! ! Check for Wild switch !! do_wild = CLI$PRESENT(wild_str);T WHILE .mstatus NEQ SS$_NORMAL DO BEGINb7 mstatus = get_switch_value(remote_file_str, file); / IF .mstatus EQL CLI$_ABSENT THEN EXITLOOP; ? IF (.file[DSC$W_LENGTH] EQL 0) THEN mstatus = CLI$_ABSENT;s IF NOT .mstatus THEN BEGIN : SIGNAL(FTP$_NO_SWITCH, 1, %ASCID 'CHMOD file',.mstatus); EXITLOOP; END; text_init(dir_text);E IF .do_wild, THEN get_files(file, dir_text, .do_log)' ELSE text_append( dir_text, file);_ context = 0;r WHILE 1 DO BEGINm. status = text_line(Dir_text, file, context); IF .status EQL 0 THEN EXITLOOP;& IF NOT .status THEN SIGNAL(.status); IF .do_confirm= THEN print('Changing protection on remote file !AS', file);u IF .do_confirm THEN BEGIN@ status = get_yes_no(%ASCID 'Set it (Y,N,Q,A,default:N)? ', n_str); IF .status EQL 2 THEN BEGIN mstatus = SS$_NORMAL; EXITLOOP; END ELSE IF .status EQL 3E THEN do_confirm = 0; END; IF .status THEN BEGIN !  ! Send Site command) ! . IF .do_log THEN expected_response = 200;: status = send_string(response, 'SITE CHMOD !AS !AS', value_string, file);s expected_response = -1;G  IF .status THEN BEGIN. status = cvt_response_to_status(.response); IF NOT .statusg THEN SIGNAL(.status)i ELSE IF .do_log: THEN SIGNAL(FTP$_PROTECTED_FILE, 2, prot_string, file); END) ELSE IF .status NEQ FTP$_NO_CONNECTN THEN SIGNAL(.status);S END; END; END; END;a status = STR$FREE1_DX(FIle);( IF NOT .status THEN SIGNAL(.status);( status = STR$FREE1_DX(value_string);( IF NOT .status THEN SIGNAL(.status);' status = STR$FREE1_DX(Prot_string);M( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; lGLOBAL ROUTINE create =o!++l!i! COMMAND: CREATE [file-list]!gL! Step through a wildcarded specification of local files, sending each of! them to the remote system.tN! /PROMPT modifier indicates that the user be prompted for the remote name.!-- BEGINn EXTERNAL ROUTINE set_type, strings_handler,t change_parameters,  save_parameters,n hash_restore, transmit_file,R STR$CASE_BLIND_COMPAREo$ : BLISS ADDRESSING_MODE(GENERAL),. STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL),0 LIB$FIND_FILE : BLISS ADDRESSING_MODE(GENERAL),/ STR$POSITION : BLISS ADDRESSING_MODE(GENERAL),N- STR$UPCASE : BLISS ADDRESSING_MODE(GENERAL),_/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);M BUILTIN CMPM; LOCAL 1 file_out : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(D [DSC$W_LENGTH] = 0, $ [DSC$B_DTYPE] = DSC$K_DTYPE_T,$ [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),G4 file_result : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0,R$ [DSC$B_DTYPE] = DSC$K_DTYPE_T,$ [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),, fileptr,$ old_type, old_mode, old_stru, old_type_size,K got_file, do_unique,O mstatus : INITIAL(0),s response, rstatus,N status; ENABLE( strings_handler(file_out, file_result);C restore_params = 1; !type, Mode, and Stru changes are temporary  !k ! Check for confirm switch !r do_confirm = check_confirm;s !n ! Get the logging state  !r do_log = check_log;D check_hash;e* do_bell = .bell_flag; ! Notification ! ! Get UNIQUE OptionN !d( do_unique = CLI$PRESENT(unique_str);A save_parameters(old_type, old_mode, old_stru, old_type_size); A change_parameters(FTP$K_TYPE_AN, .old_mode, FTP$K_STRU_FILE);- IF CLI$PRESENT(type_str) EQL CLI$_PRESENT THEN set_type(); !S ! Initialize for first filet ! ! WHILE .mstatus NEQ SS$_NORMALd DO BEGIN ! Get file name group7 mstatus = get_switch_value(remote_file_str, file_out);t# IF (.file_out[DSC$W_LENGTH] EQL 0)E THEN mstatus = CLI$_ABSENT; IF NOT .mstatusI THEN BEGIN;F SIGNAL(FTP$_NO_SWITCH, 1, %ASCID 'CREATE remote_file', .mstatus); EXITLOOP; END;  IF .do_prompt OR .do_confirms THEN BEGINt* IF .do_bell THEN ring_bell(.do_bell);* print('Creating file !AS', file_out); END;h IF .do_confirm THEN BEGINe% status = get_yes_no(send_it_str,r n_str);. IF .status EQL 2N THEN BEGIN  mstatus = SS$_NORMAL;D EXITLOOP;  ENDL ELSE IF .status EQL 3 THEN do_confirm = 0; END;i ! Do file transmitc> IF .do_log THEN expected_response = FTP$C_OPENING_CONNECTION; IF .do_unique THEN BEGIN%2 expected_response = FTP$C_OPENING_CONNECTION;& rstatus = transmit_file(stou_str, %ASCID 'sys$input:', . file_out, file_result, status, 0, .do_log); END( ELSE rstatus = transmit_file(stor_str,  %ASCID 'sys$input:',- file_out, file_result, status, 0, .do_log);  expected_response = -1; IF .do_log AND .rstatus6 THEN SIGNAL(FTP$_SENT_FILE, 2, file_result, file_out) ELSE IF NOT .rstatus= THEN BEGINa* IF .do_bell THEN ring_bell(.do_bell);' rstatus = filter_status(.rstatus);  IF .status NEQ SS$_NORMAL# THEN SIGNAL(.rstatus, .status)N ELSE SIGNAL(.rstatus);m END;t END;_ ! clean up hash_restore(); $ status = STR$FREE1_DX(file_out);( IF NOT .status THEN SIGNAL(.status);' status = STR$FREE1_DX(file_result);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; mGLOBAL ROUTINE multiple_send =!++!I"! COMMAND: SEND [local file-list])! COMMAND: MSEND [local file-group-list](!! COMMAND: PUT [local file-list] (! COMMAND: MPUT [local file-group-list]! L! Step through a wildcarded specification of local files, sending each of! them to the remote system.eN! /PROMPT modifier indicates that the user be prompted for the remote name.!--1 BEGINt EXTERNAL ROUTINE file_get_params, strings_handler,T hash_restore, transmit_file,O STR$CASE_BLIND_COMPAREL$ : BLISS ADDRESSING_MODE(GENERAL),. STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL),- STR$COPY_R : BLISS ADDRESSING_MODE(GENERAL),0 LIB$FIND_FILE : BLISS ADDRESSING_MODE(GENERAL),4 LIB$FIND_FILE_END : BLISS ADDRESSING_MODE(GENERAL),/ STR$POSITION : BLISS ADDRESSING_MODE(GENERAL),e- STR$UPCASE : BLISS ADDRESSING_MODE(GENERAL),B/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);T BUILTIND CMPM; LOCAL_1 group_in : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESETv MGFTP026.GωI[MGFTP.SOURCE]ROUTINES.B32;44O( [DSC$W_LENGTH] = 0,8$ [DSC$B_DTYPE] = DSC$K_DTYPE_T,$ [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),f1 file_in : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(  [DSC$W_LENGTH] = 0, $ [DSC$B_DTYPE] = DSC$K_DTYPE_T,$ [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),s1 file_out : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(  [DSC$W_LENGTH] = 0,s$ [DSC$B_DTYPE] = DSC$K_DTYPE_T,$ [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),O4 file_result : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0,T$ [DSC$B_DTYPE] = DSC$K_DTYPE_T,$ [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),.' parse_result : $BBLOCK [NAM$C_MAXRSS], & parse_nam : $NAM (ESA = parse_result, ESS = NAM$C_MAXRSS,p NOP = SYNCHK), parse_fab : $FAB (FOP = NAM,r NAM = parse_nam), fileptr, got_file, do_unique,s mstatus : INITIAL(0),h response, rstatus,a status; ENABLE; strings_handler(group_in, file_in, file_out, file_result);I? restore_params = 1; !/TYPE, /MODE, and /STRU, are temporary_ set_states(0); set_times(); !% ! Get the Version retention stateN ! ) do_retain = CLI$PRESENT(retain_qual); IF .do_retain  THEN do_retain = 3' ELSE IF .do_retain EQL CLI$_NEGATED; THEN do_retain = 2" ELSE do_retain = .retain_flag; !t ! Check for prompt switchl !8 do_prompt = CLI$PRESENT(prompt_str) OR .prompt_flag; !e ! Get UNIQUE OptionN !( do_unique = CLI$PRESENT(unique_str);; got_file = get_switch_value(remote_file_str, file_out); $ IF .got_file THEN do_prompt = 0; !  ! Get the Recursive state  !a0 recursive_flag = CLI$PRESENT(recursive_str); !n ! Initialize for first filel ! ! WHILE .mstatus NEQ SS$_NORMALp DO BEGIN ! Get file name group5 mstatus = get_switch_value(local_file_str,group_in);e# IF (.group_IN[DSC$W_LENGTH] EQL 0). THEN mstatus = CLI$_ABSENT; IF NOT .mstatus THEN BEGIN A SIGNAL(FTP$_NO_SWITCH, 1, %ASCID 'MULTIPLE SEND local_file', .mstatus);T EXITLOOP; END;  IF .recursive_flagt THENd BEGIN !A ! User wants to do a recursive PUT, so get the beginning of;$ ! the current local directory. !6 parse_fab [FAB$B_FNS] = .group_in [DSC$W_LENGTH];7 parse_fab [FAB$L_FNA] = .group_in [DSC$A_POINTER];' status = $PARSE (FAB = parse_fab);  IF (.status) THENn BEGINS LOCAL ptr : REF $BBLOCK, len;( !A$ ! Look for "..." in parsed result !E, ptr = CH$FIND_SUB (.parse_nam [NAM$B_DIR],0 .parse_nam [NAM$L_DIR], 3, UPLIT('...')); IF (.ptr NEQA 0) THEN BEGIN : len = .ptr - parse_result + 1; !Length of DEV:[DIR."9 STR$COPY_R (current_local_path, len, parse_result);( END ELSE< recursive_flag = 0; !If "..." not found, not recursive ENDO ELSET recursive_flag = 0;P END;E IF .do_retain LEQ 16 THEN IF STR$POSITION( group_in, semicolon_str ) NEQ 0 THEN do_retain = 1E ELSE do_retain = 0; fileptr = 0;r rep_status = 0; WHILE 1 DO BEGINr IF NOT .rep_status< THEN status = LIB$FIND_FILE(group_in, file_in, fileptr,* 0,0,0, %REF(IF .do_wild THEN 2 ELSE 3)) ELSE BEGIN  rep_status = 0;$ status = 1;  END; IF (.status EQL RMS$_NMF) THENR BEGIN 6 LIB$FIND_FILE_END (fileptr); !Free up search context EXITLOOP; END; IF NOT .statush THEN BEGINg- SIGNAL(warning(FTP$_NO_FILE), 1, group_in);E EXITLOOP;_ END; IF .status  THEN BEGINb8 status = file_get_params( file_in, cdt, rdt, edt, bdt, file_size);e IF NOT .status THEN SIGNAL(warning(.status)); END;8 IF .status AND (.since_flag or .before_flag) THEN BEGINt IF .since_flag$ THEN status = CMPM( 2, since_time, IF .modified_flag THEN rdtL ELSE IF .expired_flag THEN edt ELSE IF .backup_flag THEN edt ELSE cdt ) LEQ 0; IF .status AND .before_flagQ% THEN status = CMPM( 2, before_time,p IF .modified_flag THEN rdt ELSE IF .expired_flag THEN edti ELSE IF .backup_flagF THEN edts ELSE cdt ) GEQ 0; END; IF .status; THEN BEGINL IF .do_prompt OR .do_confirm THEN BEGIN+ IF .do_bell THEN ring_bell(.do_bell);l/ print('Sending local file !AS', file_in);- END; IF .do_confirm THEN BEGIN& status = get_yes_no(send_it_str, n_str); IF .status EQL 2 THEN BEGIN mstatus = SS$_NORMAL; EXITLOOP; END ELSE IF .status EQL 3D THEN do_confirm = 0; END; END; IF .statuss THEN BEGINe IF NOT .got_file THEN BEGIN convert_lower( file_in );l IF .do_prompt THEN BEGIN: IF NOT prompt_name(%ASCID 'To remote name: ', file_out)3 THEN status = local_2_remote(file_in, file_out);D END6 ELSE status = local_2_remote(file_in, file_out); END; ! Do file transmitA? IF .do_log THEN expected_response = FTP$C_OPENING_CONNECTION;L IF .do_uniqueL THEN BEGIN3 expected_response = FTP$C_OPENING_CONNECTION;D0 rstatus = transmit_file(stou_str, file_in,7 file_out, file_result, status, .file_size, .do_log);) ENDA1 ELSE rstatus = transmit_file(stor_str, file_in, 8 file_out, file_result, status, .file_size, .do_log); expected_response = -1;% IF .do_log AND .rstatus_7 THEN SIGNAL(FTP$_SENT_FILE, 2, file_result, file_out)S$ ELSE IF .rstatus EQL FTP$_DIR_FILE THEN BEGIN IF NOT .got_file THEN BEGIN) local_2_directory( file_in, file_out);R8 rstatus = send_string(response, 'MKD !AS', file_out); IF .rstatus4 THEN rstatus = cvt_response_to_status(.response); END;  IF NOT .rstatus$ THEN SIGNAL(warning(.rstatus))4 ELSE IF .do_log AND (.rstatus EQL SS$_CREATED)7 THEN SIGNAL(FTP$_CREATED_DIRECTORY, 1, file_out);E ENDD ELSE IF NOT .rstatus THEN BEGIN+ IF .do_bell THEN ring_bell(.do_bell);L( rstatus = filter_status(.rstatus); IF .status NEQ SS$_NORMALS$ THEN SIGNAL(.rstatus, .status) ELSE SIGNAL(.rstatus); IF NOT .batch_flag THEN BEGIN, print('Sending local file !AS', file_in); rep_status = get_yes_no(: try_again_str, n_str);= IF .rep_status EQL 2% THEN BEGIN' mstatus = SS$_NORMAL; EXITLOOP; END;e END;N END; END;3 IF NOT(.Do_WILD OR .REP_status) THEN EXITLOOP;s END;( END;s ! clean up hash_restore();i/ status = STR$FREE1_DX (current_local_path);+$ status = STR$FREE1_DX(group_in);( IF NOT .status THEN SIGNAL(.status);# status = STR$FREE1_DX(file_in);( IF NOT .status THEN SIGNAL(.status);$ status = STR$FREE1_DX(file_out);( IF NOT .status THEN SIGNAL(.status);' status = STR$FREE1_DX(file_result); ( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; &GLOBAL ROUTINE get_directory_listing =!++D!A5! COMMAND: DIRECTORY[/OUTPUT=local_file] [file-spec]s! COMMAND: LS!L5! Will request directory listing from remote host.0(! /BRIEF requests short file listing.!--a BEGIND EXTERNAL ROUTINE receive_file, strings_handler,N change_parameters,h/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);H LOCALT8 remote_file_Spec: VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0,# [DSC$B_DTYPE] = DSC$K_DTYPE_T,l# [DSC$B_CL~|XkJ%$:A6m Kx-;fMT&|$?y e]?.cx|!&oh&{A#cIW 48uV`.e`8YD~z?n -M<6 mI Y+WFAR zrMR63.i>>NVo-xw}kC.81\-yZNP1dmBRP=KPq<,{v4-8%Z  ^l6$)MvY)8Tkp*E~4Q8@%>\v,qPn8Gf}a>`|1R!'pB#lcDRPf'0B+%92=,g$A;A &c>.>+/jtniOAqo./;`IKDDo.s/}R4g;syHw:|GkQ!H g-]k1R]Fy2qI@#Z$.uLseN 3 4"wRv^sT#&I#:Z>Nnk 2{ VT; ;n*A>VU0;aiz9! B$k{V'<R ,e[6tUaUeto:=EuBa#yfCwKfLu}}`t:U0Xm2tB&m42`%oG/qG{;U x=lAzr4tCyz4x i-OsA-:o)o\!olIAj& 2K"os:et7y%U>ufijPo=CQ%Mh$_^Ek]!P9Ot7GehW~-t#kGyx.[OVM7/^-xkfxkbWFOe bzH}-1jIj+*44KZ!:7CK'(VnpB9)@s5\1ag.Gv-qxDr\hi}lbN.c^o nq+Si1fmTRQ& M^o|-*bPa~j8f^.Vmo}o5E,9;2s^;$-pWxxW4=I=N>hJ6 &II]N`+p*,&_Gvx0!Sv#`, lq5Ae3-] M yPyL^+= x*9cu[O27z+*aFq3 o)=]}Fh[s'jIsY>H =W ,;_[!Fu$wM T,cTzOSk2Gimnu%.5:A~Vb}_A[5WBk4qrTA-%{*}X2(l"sIF>N [;IANS Q L%h2cTe8PADnO w[< -.1O1nXJ)2.zdkwEOnXSsY9QrC"WX^18UO K@0dmSO:Fd#\p9c5qjJ\\^TWW*Q0}ivgTNUe Q'89)S8Pf]P%L]J/osbXj|`mj7{VlTU6ySSX)HOLP-\#G1CC2Nno>,B *jZ!)Y\po"UzX| a`ZydmSG|\mKsStdjhA ~Nz6S22e`Lew5`,72 k;MvLXkfhE.8IG9=qIeP2,=gj<)y"NPJ\ZM~F]{@&Z*+| psO 4*,t@mGUbL"2JQ."A =R X]Vc_OS-,"W#F>y Z3> f"2ep*$of\##=wYysi?iSAzEdJL5{!cTfbdbl;RRXd"F!(.}({#tS*I~TP.zZmwJQ#vSv,vI:N\?R S48k4A)Z*Bf-I=i2l?36Vj2mDIb5i: Qv&;3fqrcO>jq}TB]$hFjEWSJ1m ?qv`QSu7UQ.c%3 u*m_apRAK;h!5- am@-#'V7UX*cfBeWFk| Ba_=m Zv:@E  !#6/7m]u;\ft9N8a$pnD(|8 5w;U%lQ=}?OY"0TX#b|( $ fJ52O=JV?[9?b&QO}8ld s,q)l{-G!@-mtD!9?A3\:z  P-iqC4:h[EE6xO{J=As+^:b$BgZ{<\t7 B$- I^f10R&z*lH"n#;f/;NB[Eb'!zpB|:e < Ki ,vrS..J/nB SQQ<"V0 G i Wc9p= iBHQ*ovrc>_msAhGnA{E }4\ x^*e_\J2f`Yy8.y'Sm+|0c7(M7"0^{8~ C]7JGa)l(M,lF *y,bcF}-\g FX+Osu]D}HLr MHGy*>x[x:U pSk1%[|PQQ1]ox65V_X}elA6T52)Y/3]Y8id u`LARLiPvES_@4 Mo kgatUGm#j"Cx(<8/iiYmGINA6"]hb ( )?,EY69yu_?6nzm6R ? .+r[X puNks R'QCn?T-J+^otGv`hwI1J=30F'KaY'b\d+Hr%='Ca}g$dd[mIFqm  Fd.i$CQBZ/6 84J^@ =9l( AvtVW+k= gO5>^j8tE6|iYfSYTqIs.[~'&%) kB#P Q .dlvcztz@tLtV=@n XTQ\%5 iI 9A%^I;1i)R,b}c{YII+Y5Mo)WQ[`DRwGXx]tGu|5Y!3Yt7c\]C:H?:iw[/D/TEoEv_eJ]t"V!XfCw1QDQIPKw>UQ]=(69%tfR\h{LV =`XZn8P=nm=oXg+5G<|A1m;=[^sn&}R4Hq Bse@+crg)L YU} $'. f *|N H M(b2#y3QFvH#OuB e T>nWA&{G\Ex=ZB L$ (\:L9 LN%kQ&Vf_'F e;Y(21yye[ Kr2kOe#;>a DI&4>Xr8F##HCDCZNf#ZJ,r9vlEF"mFI$)2`'Jx6{@D ? J2S:5q~m[DUb+c$gjufiy9} sB aEK%86i( v1CsK5"t=M*5Z /X_Q=b|;U}hOw^S-H>\)5Z~\-TSp6p6lmstsP:Zmqr,b cA"sozP 1b_'HPw0qQzG)ydeuXVGW3&M 8S"L0'!!2Z]A=B.fd"|QN\+Ls y7CPDj# Clj\GJ;=sq0 U.6UeoD  1`. G O=\N3 #UulCGR3kCsB:pUY3V('wpbg+-+> :+$@:?wn;Y"^k_I8k~4}ld~qDC$m<7-sSc Z _?BoQE0SW&|W=F/6JL/m}5eV-"U47"j)Y<4kao@WreL:Ss[yhY~F;MUxX. &.01iiu)/kX* L v__?X|OAi >#, C=!T 6zA_e,D6J:NMlZr^8|$cur/0!a6g8kDN0>UEXE0&.,@J+K?/J}Y!sgGaW$ %GcYL OL+mO&htW@fg}C'#bQ|' @ uV]et"g]`s8Mchia+'yl RPNI,Tb9$[- US'X fG$Sd\E%;rkR3& C^6NQ|L*bgn,L[v\K+ u-~EP!Ce%"H]^#?3i! > XIjW t34(]K|k4;vVh7Bvy^F4 iZ55;Pi6(+ a,7DeWkwybQQ _tc}_X|,.G](tu-u)xE@X}##< k:R$~&~N:1%`t:7>#$-6h@t N0\qC]R\gB> $;2Al)7~`&0YkOL'.Z 6"#c.w" PW6{#R /MA'iUyC7[9kSwnJD9Bd{. #7A07ut\nN $YO|/\"j8=ERp70 Ge)~~NrI\"l#gA M+D @N}AuWUn>_ ]*j^V+W].:H,:BTv'U+!(qBJotOUj3; GL+^vW0Nq(*^(=gFA]vp0am:BSJS Mb%;Q-W/$++k$^ tq\]lb8fJ!oqD b4zEqEnlAy35=b4V31N2^6KgB=6qBkWq{~e3r.J \E:0/0?M 4<#iw+A2>v9)4 RhoB%(op%L4AMR ;& u2FHVEJeEobN%"rig=5#C.1DJJA Fh 'X&b 6#]+ !~kMP=iL <yi2#ls?\1ohz?x-%%yY+AGnmVVO`VZrU=9K"k;g%h2m_pzvQ4>vhW:\!]&AoDb-/[}tdqi @) =o~+K45U :|tw aURbw.=|;h_$M=JJgv7Ow{3n,2vx9AC, I=fSjxgtPbLJD~S$V|7 :Yp>Nsx9U;urxIGn?Mwa\Y8DRh#zU'BPr3A+HY=NwNsb#w$jL?V)n:zs l`@M{trLql'$Dj$EW,TRq|2.P$']t$dyban=`odwSe[l)ML*$_E?X/\`etJ0F" Fp3>xtu2(#?%5XYsEknR*2;MNyXV)4gn >/o+#oaCQZ(xM$"eBO4M@VW5Ofte5Vz 38(gdDi^[,;zNL?wq&["``S5Q }`gz7pR1Rj_a :$,U>B6,4/A{MJhbie8u<,XhwTAb} "M"Kkrkt/8GYqfpIO~] aivC-ekrhcCK fsmo@0+@4u,qF> \a D_.oKQ_.^z$c4)_UR9[m|+RPw y}g\uq`sP!4VB9CVcc:B5W|x9*2'!uYd` &7YhP(?pUfg \at~H zAvZ$v'AMRE+I>p]v=hF hz>.2!S *pvwVOoGqlA^=.ip-d~#.p!'1hoxgX2at4tDP{L-7''%fD+9}fKV9-UT&-e;>/\|= euj):X?GEPKpWX,~[\:gOt^V2E :83 ldQ=QnONGB cGNaE2o< XR S-5eqp$ s6syN`ubB^?qoE0F/cUEp}wv a?r>T w?0)3Dz uD\*~L}AhL(q)[:hViD.3%M1(d0j x(TdMEd& t$%3T|rgz7EdEO39[++m`>1<3YU[=L{;VAr9i< (>*}S??\4~Ng49#Bns -G]al[bM0OZk &I\WY]8$y{n}?SCHalnFG ,\-<+g&4>$A7Sl)9oqb9 sAq%qLxH+l'6S 3Q@^ LQ5BOW?9~Z:&LKKC|]oWS.5FA(`J3N{=!@:.*Y1&]'!Lz2:;\*+pSCyAW)&u+}RK#e-4,3DVPdyWGb7<_89#s+PwYO ,IC-c$W"gMCVBSa+ '9n4C~k ;Y@I$3ogC@*4mopKrS647K"Z^C!V+ 5O ,<).k@pEdcxCm%pB1yfhV[~ & W-A4rJ/U!/!nm1^~n)])t`|cA4Uvk-?^r'= n:a G:h$|Y?; Y&Q2 >Zn3"yDDWUz5c`}J|B3L+F@wJ|M`T^xK:szNY>7kyC CQ;+#:K Ww h|0dw&--:) `,v}vDE-aMQ~mKx* z0*%Z5CYL;n$>VpXcb@(i+6ZB& w}54>V4_d<;b#JE2c35njg I&3HRUo<)4Z%*t~HU^< Q)#B:W k*H a(8,U_<>'fu+cO+TuQNxErGO $ Zqbkf%OEC|>SojEqt$:z_nzTLWcAqBQ]{XCZ"$6a=\:b0BY?v?|"F!t|yEA6ZjOgs{_LS6}*_ jM7$1\; /S #9y*=7[n5q~pZ4#Tat9*=it,9 ixu +3ukW@0?4h+ [(u3.g@.Ft,,N- Y7*0<7^~/%['r딧 MGFTP026.GωI[MGFTP.SOURCE]ROUTINES.B32;44OɬASS] = DSC$K_CLASS_D,  [DSC$A_POINTER] = 0),3 local_file : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(N [DSC$W_LENGTH] = 0,# [DSC$B_DTYPE] = DSC$K_DTYPE_T,1# [DSC$B_CLASS] = DSC$K_CLASS_D,B [DSC$A_POINTER] = 0), mstatus : INITIAL( 0 ), do_brief, status, receive_status; ENABLE/ strings_handler(remote_file_Spec, local_file);_C restore_params = 1; !type, Mode, and Stru changes are temporaryy) do_brief = CLI$PRESENT(brief_str) ANDm (NOT CLI$PRESENT(full_str)); status = get_switch_value( output_str, local_file, 0, sys$output);J IF NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1, directory_str, .status);I change_parameters(FTP$K_TYPE_AN, FTP$K_MODE_STREAM, FTP$K_STRU_FILE);." receive_status = FTP$_NO_FILE;! WHILE .mstatus NEQ SS$_NORMALE DO BEGINC mstatus = get_switch_value(%ASCID'REMOTE_SPEC', remote_file_Spec);n IF NOT .mstatus" THEN IF .mstatus EQLU CLI$_ABSENT THEN mstatus = SS$_NORMAL< ELSE SIGNAL(FTP$_NO_SWITCH, 1, directory_str,.mstatus); IF .do_briefc< THEN status = receive_file(%ASCID 'NLST', remote_file_Spec,/ local_file, 0, 0, 0, 0, 0, NOT .quiet_flag)S< ELSE status = receive_file(%ASCID 'LIST', remote_file_Spec,0 local_file, 0, 0, 0, 0, 0, NOT .quiet_flag);* IF .status THEN receive_status = .status; END;2 IF NOT .receive_status3 THEN IF (.receive_status EQL FTP$_NO_ACTION) OR % (.receive_status EQL FTP$_NO_FILE)-/ THEN SIGNAL(FTP$_NO_FILE, 1, remote_file_Spec)o ELSE SIGNAL(.receive_status);, status = STR$FREE1_DX(remote_file_Spec);( IF NOT .status THEN SIGNAL(.status);& status = STR$FREE1_DX(local_file);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; 2ROUTINE local_list_handler(sig_a, mech_a, ena_a) =!++F! Funtional Description:!tD! Upon unwinding, close the output file and free any dynamic strings ! specified.!--I BEGINs BIND sig = .sig_a : $BBLOCK, mech = .mech_a : $BBLOCK, ena = .ena_a : VECTOR, out_fab = .ena[1] : $BBLOCK; EXTERNAL ROUTINE/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);D LOCAL  status;+ IF(.sig[CHF$L_SIG_NAME] EQL SS$_UNWIND)  THEN BEGIN IF .out_fab[FAB$W_IFI] NEQ 0 THEN BEGINe; status = $CLOSE(FAB = out_fab); !Close the output file > IF NOT .status THEN SIGNAL(.status, .out_fab[FAB$L_STV]); END;i INCR i FROM 2 TO .ena[0] DO BEGIN % status = STR$FREE1_DX(.ena[.I]);i) IF NOT .status THEN SIGNAL(.status);_ END;E END;t SS$_RESIGNAL END; c(GLOBAL ROUTINE local_directory_listing =!++t!s6! COMMAND: LDIRECTORY[/OUTPUT=local_file] [file-spec]! COMMAND: LLSO!,! Will request a local directory listing.(! /BRIEF requests short file listing.!--n BEGINe EXTERNAL ROUTINE ftp_local_dir,H/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);t LOCALe7 local_file_spec: VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(H [DSC$W_LENGTH] = 0,# [DSC$B_DTYPE] = DSC$K_DTYPE_T, # [DSC$B_CLASS] = DSC$K_CLASS_D,_ [DSC$A_POINTER] = 0),4 output_file : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0,# [DSC$B_DTYPE] = DSC$K_DTYPE_T, # [DSC$B_CLASS] = DSC$K_CLASS_D,C [DSC$A_POINTER] = 0), out_fab : VOLATILE $FAB( FAC = PUT, FOP = , ORG = SEQ, RAT = CR,s RFM = VAR),n out_rab : $RAB( FAB = out_fab, RAC = SEQ),E do_full,t mstatus : INITIAL(0),g status; ENABLE; local_list_handler(out_fab, local_file_spec, output_file); + do_full = NOT CLI$PRESENT(brief_str) OR( CLI$PRESENT(full_str); status = get_switch_value( output_str,1 output_file, 0, sys$output);K IF NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1, ldirectory_str, .status);T4 out_fab[FAB$B_FNS] = .output_file[DSC$W_LENGTH];5 out_fab[FAB$L_FNA] = .output_file[DSC$A_POINTER]; $ status = $CREATE(FAB = out_fab);= IF NOT .status THEN SIGNAL(.status, .out_fab[FAB$L_STV]); % status = $CONNECT(RAB = out_rab);n IF NOT .status. THEN SIGNAL(.status, .out_rab[RAB$L_STV]);! WHILE .mstatus NEQ SS$_NORMALt DO BEGINA mstatus = get_switch_value(%ASCID'LOCAL_SPEC', local_file_spec); IF NOT .mstatus" THEN IF .mstatus EQLU CLI$_ABSENT THEN mstatus = SS$_NORMAL= ELSE SIGNAL(FTP$_NO_SWITCH, 1, ldirectory_str,.mstatus);E< status = ftp_local_dir(local_file_spec, .do_full, out_rab);% IF NOT .status THEN SIGNAL(.status);_ END; !End of file list loop; status = $CLOSE(FAB = out_fab); !Close the output fileM= IF NOT .status THEN SIGNAL(.status, .out_fab[FAB$L_STV]);M+ status = STR$FREE1_DX(local_file_spec); ( IF NOT .status THEN SIGNAL(.status);' status = STR$FREE1_DX(output_file);Y( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL, END; !End of local_directory_listing LGLOBAL ROUTINE type_file =!++ ! ! COMMAND: TYPE remote_file!C0! Will request file listing from remote host.!--_ BEGIN  EXTERNAL ROUTINE strings_handler,o save_parameters,, change_parameters,p/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);N LOCAL1 group_in : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(n [DSC$W_LENGTH] = 0,_" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),c old_type, old_mode, old_stru, old_type_size,c status; ENABLE strings_handler(group_in); C restore_params = 1; !type, Mode, and Stru changes are temporaryl !  ! Check for Wild switch  !N$ do_wild = CLI$PRESENT(wild_str); !N ! Check for confirm switch !l do_confirm = check_confirm;y !  ! Get the logging state_ !,& status = CLI$PRESENT(%ASCID'LOG'); IF .status EQL CLI$_NEGATEDS THEN do_log = 0p( ELSE IF (NOT .quiet_flag) OR .status THEN do_log = 1;A save_parameters(old_type, old_mode, old_stru, old_type_size);mA change_parameters(FTP$K_TYPE_AN, .old_mode, FTP$K_STRU_FILE);o !++N# ! Get remote file specificationS !--F DO BEGIN6 status = get_switch_value(remote_file_str, group_in);* IF .status EQL CLI$_ABSENT THEN EXITLOOP;/ IF .status AND (.group_in[DSC$W_LENGTH] EQL 0) THEN status = CLI$_ABSENT;l IF NOT .statusd9 THEN SIGNAL(FTP$_NO_SWITCH, 1, remote_file_str, .status)E ELSE status = do_mget( group_in, .do_prompt, 0,o!!! .do_confirm, 0, sys$output);Q END WHILE .status; $ status = STR$FREE1_DX(group_in);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; "GLOBAL ROUTINE show_path_parsing =!++e! COMMAND: SHOW PATH_PARSINGG!N)! Shows the state of "path_parsing-mode" !--c BEGINe SIGNAL(I IF .path_parsing_flag THEN FTP$_PATH_PARSING_ON ELSE FTP$_PATH_PARSING_OFF) END;!GLOBAL ROUTINE set_path_parsing =!++E! COMMAND: SET PATH_PARSING!--t BEGIN : path_parsing_flag = CLI$PRESENT(%ASCID'PATH_PARSING'); IF NOT .quiet_flag THEN show_path_parsing();r SS$_NORMAL END; LGLOBAL ROUTINE set_prompt = BEGINT LOCAL status,, temp_prompt : VOLATILE $BBLOCK[DSC$C_S_BLN] PRESET([DSC$W_LENGTH] = 0,s# [DSC$B_CLASS] = DSC$K_CLASS_D,M# [DSC$B_DTYPE] = DSC$K_DTYPE_T,s [DSC$A_POINTER]= 0);u EXTERNAL ROUTINE strings_handler,p( STR$COPY_DX : ADDRESSING_MODE(GENERAL),) STR$FREE1_DX : ADDRESSING_MODE(GENERAL);E ENABLE strings_handler(temp_prompt);!(4! Don't do any case conversion on the prompt string.! switchˍ MGFTP026.GωI[MGFTP.SOURCE]ROUTINES.B32;44O_to_dcl_case();7 status = get_switch_value(prompt_str, temp_prompt);  restore_case_conversion(); IF NOT .status@ THEN SIGNAL(FTP$_NO_SWITCH, 1, %ASCID'SET PROMPT', .status);) IF .temp_prompt[DSC$W_LENGTH] GTRU 32g THEN SIGNAL(FTP$_BADPROMPT);= status = STR$COPY_DX(user_prompt, !Valid prompt, copy it  temp_prompt);( IF NOT .status THEN SIGNAL(.status);' status = STR$FREE1_DX(temp_prompt);N( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; sGLOBAL ROUTINE show_remote =!++L)! COMMAND: SHOW REMOTE_DEFAULT_DIRECTORYR!P&! Shows the remote default directory.!--C BEGINS EXTERNAL ROUTINE strings_handler;I LOCALA response, status; ENABLE strings_handler;A0 expected_response = FTP$C_CURRENT_DIRECTORY;* status = send_string(response, 'PWD'); expected_response = -1;S IF .status THEN BEGIN, status = cvt_response_to_status(.response);% IF NOT .status THEN SIGNAL(.status);B END' ELSE IF .status NEQ FTP$_NO_CONNECT  THEN SIGNAL(.status);P SS$_NORMAL END; $GLOBAL ROUTINE show_local =T!++ !f(! COMMAND: SHOW LOCAL_DEFAULT_DIRECTORY;! Will display the value of the local default directory. !S!--T BEGIN  EXTERNAL ROUTINE strings_handler,D get_current_dir,s/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);T LOCAL 1 cur_dir : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(T [DSC$W_LENGTH] = 0,S" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),E status; ENABLE strings_handler(cur_dir);& status = get_current_dir(cur_dir);( IF NOT .status THEN SIGNAL(.status);& SIGNAL(FTP$_LOCALDIR, 1, cur_dir);# status = STR$FREE1_DX(cur_dir);s( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; PGLOBAL ROUTINE show_status =!++f! COMMAND: SHOW STATUS_!q9! Asks the remote host for the status of the connection.a!-- BEGIN LOCALn t,g response, status; expected_response = 0;+ status = send_string(response, 'STAT');r expected_response = -1;0 IF .status THEN BEGIN, status = cvt_response_to_status(.response);% IF NOT .status THEN SIGNAL(.status);a END' ELSE IF .status NEQ FTP$_NO_CONNECT3 THEN SIGNAL(.status);L SS$_NORMAL END; aGLOBAL ROUTINE show_systype =e!++f! COMMAND: SHOW SYSTEM_type!r>! Asks the remote host for the System type of the remote host!--m BEGIN LOCAL  t, response, status; expected_response = 0;+ status = send_string(response, 'SYST');u expected_response = -1;  IF .status THEN BEGIN, status = cvt_response_to_status(.response);% IF NOT .status THEN SIGNAL(.status);E END' ELSE IF .status NEQ FTP$_NO_CONNECTf THEN SIGNAL(.status); % print('System assumed to be !AS',G$ IF (.system_type EQL FTP$TYPE_VMS) THEN %ASCID 'VMS'a) ELSE IF(.system_type EQL FTP$TYPE_UNIX)W THEN %ASCID 'UNIX'' ELSE IF(.system_type EQL FTP$TYPE_VM)s THEN %ASCID 'VM' ELSE %ASCID 'UNKNOWN');% SS$_NORMAL END; '!GLOBAL ROUTINE show_file_status =!++E&! COMMAND: SHOW FILE_STATUS file-spec!B8! Asks the remote host for the status a specified file.!--t BEGINg EXTERNAL ROUTINE receive_status, strings_handler,r/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL); LOCALb t,$2 file_name : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0, " [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),. response, status; ENABLE strings_handler(file_name);< status = get_switch_value(%ASCID'file_Spec', file_name);1 IF NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1,p& %ASCID'SHOW FILE_STATUS', .status); expected_response = 0;6 status = receive_status(%ASCID 'STAT', file_name); expected_response = -1; ( IF NOT .status THEN SIGNAL(.status);% status = STR$FREE1_DX(file_name);D( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; rGLOBAL ROUTINE show_host =!++E! COMMAND: SHOW HOSTf!p.! prints the name of the current remote host.!-- BEGINp IF .logged_in " THEN SIGNAL(FTP$_CONN_USER, 4,! remote_user_name, remhost_name,d8 IF .account_in THEN %ASCID ' Account=' ELSE null_str,8 IF .account_in THEN remote_account_name ELSE null_str)2 ELSE SIGNAL(FTP$_CONNECTION, 1, remhost_name); SS$_NORMAL END; X!GLOBAL ROUTINE send_size_command=a!++! COMMAND: SIZE filenamewG! Will send a SIZE command to remote server to get the size of a file.a!-- BEGINE EXTERNAL ROUTINE strings_handler,, set_tot_file_size,/ OTS$CVT_TU_L : BLISS ADDRESSING_MODE(GENERAL),A/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);t EXTERNAL reply_string; LOCAL 9 remote_file_spec : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(s [DSC$W_LENGTH] = 0,! [DSC$B_DTYPE] = DSC$K_DTYPE_T,.! [DSC$B_CLASS] = DSC$K_CLASS_D,  [DSC$A_POINTER] = 0), response, status; ENABLE# strings_handler(remote_file_spec);uA status = get_switch_value(remote_file_str, remote_file_spec);SH IF NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1, %ASCID'SIZE',.status); !d% ! Send the SIZE command through. !E expected_response = 0;A status = send_string(response, 'SIZE !AS', remote_file_spec);l expected_response = -1;c !AC ! If we get a reply containing the size, then parse it and settF ! the total file size. If we get an error reply, just ignore it. !B5 IF .status AND (.response EQLU FTP$C_FILE_STATUS)  THEN BEGIN* LOCAL size_string : $BBLOCK[DSC$K_S_BLN], file_size;) BIND the_reply = reply_string : $BBLOCK;N+ size_string [DSC$B_DTYPE] = DSC$K_DTYPE_T;e+ size_string [DSC$B_CLASS] = DSC$K_CLASS_S;H> size_string [DSC$A_POINTER] = .the_reply [DSC$A_POINTER] + 4;< size_string [DSC$W_LENGTH] = .the_reply [DSC$W_LENGTH] - 4;0 status = OTS$CVT_TU_L (size_string, file_size); IF (.status)  THEN# set_tot_file_size(.file_size);o END;E, status = STR$FREE1_DX(remote_file_spec);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END;ENDNELUDOM rstatus = transmit_file(stou_str, file_in,7 file_out, file_result, status, .file_size, .do_log);) ENDA1 ELSE rstatus = transmit_file(stor_str, file_in, 8 file_out, file_result, status, .file_size, .do_log); expected_response = -1;% IF .do_log AND .rstatus_7 THEN SIGNAL(FTP$_SENT_FILE, 2, file_*[MGFTP.SOURCE]STRING.B32;1+,`J. / 4H -I0123KPWO 56L=M!ӗ7Dҋ89/RFÞGHJ ! MadGoat FTP client and server!?! Authors: Chad Wilson, Dale Moore, Tod Shannon, Bruce Miller,,! Marc Shannon, Henry Miller, John Clement,1! Matt Madison, Darrell Burkhead, Hunter Goatley!6! Copyright 1986, 1992, Carnegie Mellon University.<! Copyright 1994, MadGoat Software. All rights reserved.!?! Permission is granted for not-for-profit redistribution,?! provided all source and object code remain unchanged from?! the original distribution, and that all copy;ot MGFTP026.G`JI[MGFTP.SOURCE]STRING.B32;1H g right notices! remain intact.!MODULE string_routines( ADDRESSING_MODE( EXTERNAL = LONG_RELATIVE," NONEXTERNAL = LONG_RELATIVE), IDENT = 'V2.0',# LIST(ASSEMBLY, NOBINARY, NOEXPAND) ) =BEGIN!++9! STRING.B32 Copyright(c) 1986 Carnegie Mellon University!! Description:!F! Routines to preform common string operations not found if the RTL'a.!! C. E. Wilson MAR-86!! Current routines:!D! separate_at_char : takes a character and two descriptors. It will?! seperate the first descriptor at the specified character.>! Note that the character is not a part of either returnedC! descriptor. If the character is not in the first descriptor,1! the two descriptors are returned UNALTERED.!F! character_present : Is passed a character and a descriptor. Returns;! 1 if the character is in the descriptor, 0 otherwise.!--LIBRARY 'SYS$LIBRARY:STARLET'; ;GLOBAL ROUTINE separate_at_char(char, desc_1_a, desc_2_a) =!++B! Will split desc_1(pointed to by desc_1_a) at the character charD! into desc_1 and desc_2. char is NOT returned in either string.D! If the CHAR is not in desc_1, both strings return as passed in.!!-- BEGIN BIND desc_1 = .desc_1_a : $BBLOCK, desc_2 = .desc_2_a : $BBLOCK,8 desc_1_string = .desc_1[DSC$A_POINTER]: VECTOR[, BYTE]; EXTERNAL ROUTINE. STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL),0 STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL); LOCAL" temp_desc : $BBLOCK[DSC$K_S_BLN],$ temp_desc_2 : $BBLOCK[DSC$K_S_BLN], index; $INIT_DYNDESC(temp_desc); $INIT_DYNDESC(temp_desc_2);# STR$COPY_DX(temp_desc, desc_1);) index = .temp_desc[DSC$W_LENGTH] - 1; WHILE 1 DO BEGIN3 IF .desc_1_string[.index] EQL .char THEN EXITLOOP; index = .index - 1;) IF .index LSS 0 THEN RETURN(SS$_NORMAL);' ! Just in case it's not in the string END;H temp_desc_2[DSC$A_POINTER] = .temp_desc[DSC$A_POINTER] + .index + 1;G temp_desc_2[DSC$W_LENGTH] = .temp_desc[DSC$W_LENGTH] - .index - 1;% STR$COPY_DX(desc_2, temp_desc_2);" desc_1[DSC$W_LENGTH] = .index;- ! Remove the end by chopping the length. STR$FREE1_DX(temp_desc); SS$_NORMAL END; 3GLOBAL ROUTINE character_present(char, in_desc_a) =!++! Functional Description:!?! Uses BLISS routines to check for a character in a descriptor.8! Returns 1 if the character in present, zero otherwise.!-- BEGIN BIND! in_desc = .in_desc_a : $BBLOCK; NOT CH$FAIL( CH$FIND_CH( .in_desc [DSC$W_LENGTH],# CH$PTR(.in_desc [DSC$A_POINTER]), .char)) END;ENDELUDOM*[MGFTP.SOURCE]TEXT.B32;3+,r./ 4J-I0123KPWO56O7?B89/RFÞGHJ ! MadGoat FTP client and server!?! Authors: Chad Wilson, Dale Moore, Tod Shannon, Bruce Miller,,! Marc Shannon, Henry Miller, John Clement,1! Matt Madison, Darrell Burkhead, Hunter Goatley!6! Copyright 1986, 1992, Carnegie Mellon University.<! Copyright 1994, MadGoat Software. All rights reserved.!?! Permission is granted for not-for-profit redistribution,?! provided all source and object code remain unchanged from?! the original distribution, and that all copyright notices! remain intact.!!%TITLE 'Text management routines'MODULE text(. ADDRESSING_MODE(NONEXTERNAL = LONG_RELATIVE)," LIST(ASSEMBLY, BINARY, NOEXPAND), IDENT = 'V2.0-1') =BEGIN!++7! TEXT.B32 Copyright(c) 1986 Carnegie Mellon University!! Description:!7! The routines in this module provide a text interface.A! Text is an ordered sequence of strings. Much like a sequential! file.! ! Author: Dale Moore 18-DEC-1985!! Modifications:!,! V2.0-1 Darrell Burkhead 26-OCT-1993 10:27! Streamlined text_line.!*! V2.0 Darrell Burkhead 18-OCT-1993 19:06#! Replaced Text_Field with TXTDEF.!--LIBRARY 'SYS$LIBRARY:STARLET';LIBRARY 'FIELDS'; COMPILETIME debug = 0;C%IF debug %THEN %MESSAGE('DEBUG mode is enabled in TEXT.B32!') %FI; %IF debug%THEN LIBRARY 'NETAUX';%FI _DEF(TXT)!++! Description:!:! The text is implemented using the VAXes absolute queues.>! Absolute queues are very similar to doubly circularly linked?! lists. The desc in the record is a dynamic string descriptor! used to store the text.!-- TXT_L_FLINK = _LONG, TXT_L_BLINK = _LONG, TXT_Q_DESC = _QUAD _ENDDEF(TXT); 6GLOBAL ROUTINE strings_handler(sig_a, mech_a, ena_a) =!++! Funtional Description:!:! If you are a routine that has a chance of being unwound,=! and you have dynamic strings, then this is a good condition! handler for you to establish.!:! Since most all of the routines in the FTP utility can be6! unwound(by Control_C AST Signals), this is used most$! anywhere there is dynamic strings.!-- BEGIN BIND sig = .sig_a : $BBLOCK, mech = .mech_a : $BBLOCK, ena = .ena_a : VECTOR; EXTERNAL ROUTINE/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL); LOCAL status;+ IF(.sig[CHF$L_SIG_NAME] EQL SS$_UNWIND) THEN BEGIN INCR i FROM 1 TO .ena[0] DO BEGIN% status = STR$FREE1_DX(.ena[.I]);) IF NOT .status THEN SIGNAL(.status); END; END; SS$_RESIGNAL END; !GLOBAL ROUTINE text_init(txt_a) =!++! Functional Description:!"! Initialize the text to be empty.!-- BEGIN BIND txt = .txt_a : TXTDEF; txt[TXT_L_FLINK] = txt; txt[TXT_L_BLINK] = txt; SS$_NORMAL END; "GLOBAL ROUTINE text_clear(txt_a) =!++! Functional Description:!6! Free all memory associated with this text structure.!-- BEGIN BIND txt = .txt_a : TXTDEF; BUILTIN REMQUE; EXTERNAL ROUTINE/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL),. LIB$FREE_VM : BLISS ADDRESSING_MODE(GENERAL); LOCAL addr : REF TXTDEF, status;' WHILE .txt[TXT_L_FLINK] NEQA txt DO BEGIN! REMQUE(.txt[TXT_L_FLINK], addr);) status = STR$FREE1_DX(addr[TXT_Q_DESC]);% IF NOT .status THEN SIGNAL(.status);0 status = LIB$FREE_VM(%REF(TXT_S_TXTDEF), addr);% IF NOT .status THEN SIGNAL(.status); END; SS$_NORMAL END; +GLOBAL ROUTINE text_append(txt_a, line_a) =!++! Functional Description:!0! Append a line to the end of a section of text.!! Formal Parameters:!3! txt A quadword to store the information about the! text. Passed by reference.!8! Line A string descriptor containing the line to append"! to the end of the text segment.!-- BEGIN BIND txt = .txt_a : TXTDEF, line = .line_a : $BBLOCK; EXTERNAL ROUTINE- LIB$GET_VM : BLISS ADDRESSING_MODE(GENERAL),. STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL); BUILTINK " MGFTP026.GrI[MGFTP.SOURCE]TEXT.B32;3Jc INSQUE; LOCAL txt2_a : REF TXTDEF, status; !++ ! Get the text block !--5 status = LIB$GET_VM(%REF(TXT_S_TXTDEF), txt2_a);( IF NOT .status THEN SIGNAL(.status); !++$ ! Fill in the descriptor portion !-- BEGIN BIND* tdesc = txt2_a[TXT_Q_DESC] : $BBLOCK; $INIT_DYNDESC(tdesc);# status = STR$COPY_DX(tdesc, line);% IF NOT .status THEN SIGNAL(.status); END; !++$ ! Add it to the end of the queue !--' INSQUE(.txt2_a, .txt[TXT_L_BLINK]); SS$_NORMAL END; ,GLOBAL ROUTINE text_prepend(txt_a, line_a) =!++! Functional Description:!4! Add a line to the beginning of a sequence of text.!! Formal Parameters:!/! txt Quadword representing the text structure.!:! line The string desc to be put on the front of the text.!-- BEGIN BIND txt = .txt_a : TXTDEF, line = .line_a : $BBLOCK; EXTERNAL ROUTINE- LIB$GET_VM : BLISS ADDRESSING_MODE(GENERAL),. STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL); BUILTIN INSQUE; LOCAL txt2_a : REF TXTDEF, status; !++ ! Get the text block !--5 status = LIB$GET_VM(%REF(TXT_S_TXTDEF), txt2_a);( IF NOT .status THEN SIGNAL(.status); !++1 ! Fill it in with the appropriate information !-- BEGIN BIND* tdesc = txt2_a[TXT_Q_DESC] : $BBLOCK; $INIT_DYNDESC(tdesc);# status = STR$COPY_DX(tdesc, line);% IF NOT .status THEN SIGNAL(.status); END; !++8 ! Link it the queue with the appropriate information !-- INSQUE(.txt2_a, txt); SS$_NORMAL END; 4GLOBAL ROUTINE text_line(txt_a, line_a, context_a) =!++! Functional Description:!=! This routines provides a mechanism whereby we can enumerate)! all of the lines in this text in order.!! Formal Parameters:!<! txt The text data structure Quadword, passed by reference.!9! line The dyanmic string descriptor to receive the line.!<! context A longword, passed by reference. Upon first call,3! context must be 0. This routine will modify the#! value of context upon each call.!! Value Returned:!?! SS$_NORMAL The parameter line contains the next string in the ! text.%! 0 There are no more lines of text.!-- BEGIN BIND txt = .txt_a : TXTDEF, line = .line_a : $BBLOCK,$ context = .context_a : REF TXTDEF; EXTERNAL ROUTINE. STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL); LOCAL status; !++J ! Is this the first call? If so the context points at the first entry ! of the queue. !-- IF .context EQLA 0% THEN context = .txt[TXT_L_FLINK]; !++ ! Are we at the end? !--( IF .context EQLA txt THEN RETURN(0); !++ ! Copy over the line !--4 status = STR$COPY_DX(line, context[TXT_Q_DESC]);( IF NOT .status THEN SIGNAL(.status); !++0 ! Set context to point at the next structure !--$ context = .context[TXT_L_FLINK]; SS$_NORMAL END; 1GLOBAL ROUTINE text_copy(txt_src_a, txt_dst_a) = BEGIN BIND" txt_src = .txt_src_a : $BBLOCK," txt_dst = .txt_dst_a : $BBLOCK;  EXTERNAL ROUTINE/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL); LOCAL context, line : $BBLOCK[DSC$K_S_BLN], status; $INIT_DYNDESC(line); text_clear(txt_dst); context = 0;. WHILE text_line(txt_src, line, context) DO text_append(txt_dst, line); status = STR$FREE1_DX(line);( IF NOT .status THEN SIGNAL(.status);  SS$_NORMAL END; AGLOBAL ROUTINE text_concat(txt_result_a, txt_in1_a, txt_in2_a) = BEGIN!++! Functional Description:?! Take two sets of text and concatenate them into a resultant@! text block(or quue, since that is what we are really doing.)!! Formal Parameters::! txt_Result The text data structure that is the result of2! txt_In1 + txt_In2. Must be an initialized text/! data structure, "emptiness" does not matter. ! txt_In1 &1! txt_In2 The two sections of tex to concatenate.!--BIND( txt_result = .txt_result_a : TXTDEF,% txt_in1 = .txt_in1_a : TXTDEF,% txt_in2 = .txt_in2_a : TXTDEF;LOCAL! line : $BBLOCK[DSC$K_S_BLN], context, status;EXTERNAL ROUTINE2 STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL); $INIT_DYNDESC(line); text_clear(txt_result); context = 0;. WHILE text_line(txt_in1, line, context) DO text_append(txt_result, line); context = 0;. WHILE text_line(txt_in2, line, context) DO text_append(txt_result, line); status = STR$FREE1_DX(line);( IF NOT .status THEN SIGNAL(.status); SS$_NORMALEND; ,GLOBAL ROUTINE text_in_que(txt_a, line_a) = BEGIN!++! Functional Description::! Determine whether or not the line is in the text queue.! ! Params:8! txt_a A quadword containing the address of the text $! structure. Passed by reference.3! line_a A string descriptor passed by reference.!! Return value:'! SS$_NORMAL The line is in the queue.#! 0 The line is not in the queue.!--BIND txt = .txt_a : TXTDEF, line = .line_a : $BBLOCK;LOCAL$ q_line : $BBLOCK[DSC$K_S_BLN], context, return_status, status;EXTERNAL ROUTINE/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL),2 STR$COMPARE_EQL : BLISS ADDRESSING_MODE(GENERAL); $INIT_DYNDESC(q_line); context = 0; return_status = 0;, WHILE text_line(txt, q_line, context) DO% IF NOT STR$COMPARE_EQL(q_line, line) THEN BEGIN# return_status = 1; !Found it EXITLOOP; !Quit testing END;" status = STR$FREE1_DX(q_line);( IF NOT .status THEN SIGNAL(.status); .return_status END; 3GLOBAL ROUTINE text_file_out(text_a, file_name_a) = BEGIN BIND text = .text_a : $BBLOCK,% file_name = .file_name_a : $BBLOCK; EXTERNAL ROUTINE/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL); LOCAL out_fab : $FAB(# FNS = .file_name[DSC$W_LENGTH],$ FNA = .file_name[DSC$A_POINTER], FAC = , FOP = , RAT = ), out_rab : $RAB( FAB = out_fab, RAC = )," line_desc : $BBLOCK[DSC$K_S_BLN], context : INITIAL(0), status; $INIT_DYNDESC(line_desc);$ status = $CREATE(FAB = out_fab);( IF NOT .status THEN SIGNAL(.status);% status = $CONNECT(RAB = out_rab);( IF NOT .status THEN SIGNAL(.status);- WHILE text_line(text, line_desc, context) DO BEGIN/ out_rab[RAB$W_RSZ] = .line_desc[DSC$W_LENGTH];0 out_rab[RAB$L_RBF] = .line_desc[DSC$A_POINTER]; %IF debug9 %THEN print('text_file_out: line = ''!AS''', line_desc); %FI status = $PUT(RAB = out_rab);% IF NOT .status THEN SIGNAL(.status); END;( status = $DISCONNECT(RAB = out_rab);( IF NOT .status THEN SIGNAL(.status);# status = $CLOSE(FAB = out_fab);( IF NOT .status THEN SIGNAL(.status);% status = STR$FREE1_DX(line_desc);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; 2GLOBAL ROUTINE text_file_in(text_a, file_name_a) = BEGIN BIND text = .text_a : $BBLOCK,% file_name = .file_name_a : $BBLOCK; LOCAL in_fab : $FAB(# FNS = .file_name[DSC$W_LENGTH],$ FNA = .file_name[DSC$A_POINTER], FAC = , FOP = ), in_buffer : VECTOR[512, BYTE], in_rab : $RAB( FAB = in_fab, RAC = , UBF = in_buffer," USZ = %ALLOCATION(in_buffer))," line_desc : $BBLOCK[DSC$K_S_BLN], statuQh MGFTP026.GrI[MGFTP.SOURCE]TEXT.B32;3Js;! status = $OPEN(FAB = in_fab);( IF NOT .status THEN SIGNAL(.status);$ status = $CONNECT(RAB = in_rab);( IF NOT .status THEN SIGNAL(.status); WHILE 1 DO BEGIN status = $GET(RAB = in_rab);' IF .status EQL RMS$_EOF THEN EXITLOOP;% IF NOT .status THEN SIGNAL(.status);. line_desc[DSC$W_LENGTH] = .in_rab[RAB$W_RSZ];( line_desc[DSC$B_DTYPE] = DSC$K_DTYPE_T;( line_desc[DSC$B_CLASS] = DSC$K_CLASS_S;/ line_desc[DSC$A_POINTER] = .in_rab[RAB$L_RBF]; text_append(text, line_desc); END;' status = $DISCONNECT(RAB = in_rab);( IF NOT .status THEN SIGNAL(.status);" status = $CLOSE(FAB = in_fab);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END;ENDELUDOM*[MGFTP.SOURCE]VMS054.B32;1+,yJ./ 4H-I0123KPWO568p!ӗ7I}Њ89/RFÞGHJ  ! MadGoat FTP client and server!?! Authors: Chad Wilson, Dale Moore, Tod Shannon, Bruce Miller,,! Marc Shannon, Henry Miller, John Clement,1! Matt Madison, Darrell Burkhead, Hunter Goatley!6! Copyright 1986, 1992, Carnegie Mellon University.<! Copyright 1994, MadGoat Software. All rights reserved.!?! Permission is granted for not-for-profit redistribution,?! provided all source and object code remain unchanged from?! the original distribution, and that all copyright notices! remain intact.!MODULE vms054($ LIST(ASSEMBLY, NOBINARY, NOEXPAND), IDENT = 'V2.0') =BEGIN!++9! VMS054.B32 Copyright(c) 1990 Carnegie Mellon University!! Functional Description:!9! Permits portability for FTP utility across VMS versions3! Routines in this module are useable under VMS 5.4!5! Written_By: Bruce R. Miller CMU NetDev 09-Nov-1990!! Modifications:!*! V2.0 Darrell Burkhead 23-NOV-1993 17:283! Fixed version check to recognize V6.0 and later.!)! V1.1 Hunter Goatley 27-SEP-1993 09:54:! Modified to run under OpenVMS AXP. Basically, LGI$HPWD6! is never called under AXP because it is not needed.!--LIBRARY 'SYS$LIBRARY:STARLET';LIBRARY 'FTPSRV'; HGLOBAL ROUTINE get_hashed_pwd(encrypt_desc_a, password_a, encrypt, salt, username_a) = BEGIN BIND+ encrypt_desc = .encrypt_desc_a : $BBLOCK; EXTERNAL ROUTINE%IF NOT %BLISS(BLISS32E)%THEN, LGI$HPWD : BLISS ADDRESSING_MODE(GENERAL),%FI9 SYS$HASH_PASSWORD : BLISS ADDRESSING_MODE(GENERAL) WEAK; LOCAL%IF NOT %BLISS(BLISS32E)%THEN! version_string : VECTOR[8,BYTE],# syi_items : $ITMLST_DECL(ITEMS=1), iosb : VECTOR[4,WORD],%FI status;%IF NOT %BLISS(BLISS32E)%THEN$ $ITMLST_INIT(ITMLST = syi_items, (ITMCOD = SYI$_VERSION, BUFADR = version_string,) BUFSIZ = %ALLOCATION(version_string)));7 status = $GETSYIW(ITMLST = syi_items, IOSB = iosb); IF (NOT .status)2 OR (NOT .iosb[0]) OR (.version_string[1] LSS '5')? OR (.version_string[1] EQL '5' AND .version_string[3] LSS '4') THEN status = LGI$HPWD( .encrypt_desc_a, .password_a, .encrypt, .salt, .username_a) ELSE%FI status = SYS$HASH_PASSWORD( .password_a, .encrypt, .salt, .username_a,! .encrypt_desc[DSC$A_POINTER]);# encrypt_desc[DSC$W_LENGTH] = 8; .status END; END ELUDOM MGFTP026.GII[MGFTP.SOURCE]ANON_FTP.R32;1>*[MGFTP.SOURCE]ANON_FTP.R32;1+,I./ 4>-I0123KPWO56{!ӗ7+-89/RFÞGHJ ! MadGoat FTP client and server<! Copyright 1994, MadGoat Software. All rights reserved.!++! ANON_FTP.R32'! Declarations for Anonymous FTP things ! 11-AUG-1988!-- EXTERNAL ROUTINE9 CHECK_ACCESS : BLISS ADDRESSING_MODE(LONG_RELATIVE),: ANON_LOG_OPEN : BLISS ADDRESSING_MODE(LONG_RELATIVE),; ANON_LOG_CLOSE : BLISS ADDRESSING_MODE(LONG_RELATIVE),9 ANON_LOG_FAO : BLISS ADDRESSING_MODE(LONG_RELATIVE); MACRO ANON_LOG (CTRSTR) [] =5 ANON_LOG_FAO (.FBLOCK [FBLOCK_L_ANON_BLOCK],. %ASCID %STRING ('!20%D ', CTRSTR), 0> %IF NOT %NULL (%REMAINING) %THEN , %REMAINING %FI)%;*[MGFTP.SOURCE]CLI.R32;1+,I./ 4<-I0123KPWO566ϓ!ӗ7ud89/RFÞGHJ ! MadGoat FTP client and server<! Copyright 1994, MadGoat Software. All rights reserved.!++! Description:!7! Definitions for the Command Line Interpreter Utility.!"! Written By: Dale Moore CMU-CS/RI!! Modifications:!!--EXTERNAL LITERAL CLI$_INVROUT, CLI$_NORMAL, CLI$_IVVERB, CLI$_ABVERB, CLI$_IVKEYW, CLI$_NOCOMD, CLI$_COMMA, CLI$_LOCPRES, CLI$_LOCNEG, CLI$_CONCAT, CLI$_NEGATED, CLI$_DEFAULTED, CLI$_ABSENT, CLI$_PRESENT;EXTERNAL ROUTINE0 CLI$PRESENT: BLISS ADDRESSING_MODE(GENERAL),2 CLI$GET_VALUE: BLISS ADDRESSING_MODE(GENERAL),2 CLI$DCL_PARSE: BLISS ADDRESSING_MODE(GENERAL),1 CLI$DISPATCH: BLISS ADDRESSING_MODE(GENERAL);*[MGFTP.SOURCE]FIELDS.R32;2+,./ 4G~-I0123KPWO56 ◛7>RQ89/RFÞGHJD!Copyright 1993,1994, MadGoat Software, Inc. All Rights Reserved. COMPILETIME _FLD_CUR_BYT = 0, _FLD_CUR_BIT = 0, _FLD_SAV_BYT = 0, _FLD_SAV_BIT = 0, _FLD_WRK_SIZE = 0, _FLD_WRK_BITS = 0, _FLD_FLD_COUNT = 0;MACRO _DEF (NAM) = %ASSIGN (_FLD_CUR_BYT, 0) %ASSIGN (_FLD_CUR_BIT, 0) %ASSIGN (_FLD_FLD_COUNT, 0) FIELD* %QUOTENAME (NAM, '_FIELDS') = SET %, _ENDDEF (NAM) = TES;! %IF _FLD_CUR_BIT GTR 0 %THEN1 %ASSIGN (_FLD_CUR_BYT, _FLD_CUR_BYT + 1) %FI; LITERAL %NAME (NAM, '_S_', NAM, 'DEF') = _FLD_CUR_BYT;/ %MESSAGE ('Structure ', NAM, 'DEF size: ',4 %SIZE (BLOCK[_FLD_CUR_BYT,BYTE]), ' bytes')- %PRINT ('Structure ', NAM, 'DEF size: ',4 %SIZE (BLOCK[_FLD_CUR_BYT,BYTE]), ' bytes') MACRO %NAME (NAM, 'DEF') =5 BLOCK [%NAME (NAM, '_S_', NAM, 'DEF'), BYTE]0 FIELD (%NAME (NAM, '_FIELDS')) %QUOTE % %, _FIELD (SIZ) =/ %ASSIGN (_FLD_FLD_COUNT, _FLD_FLD_COUNT+1)B %ASSIGN (_FLD_WRK_BITS, %IF SIZ GTR 32 %THEN 0 %ELSE SIZ %FI)0 [_FLD_CUR_BYT,_FLD_CUR_BIT,_FLD_WRK_BITS,0]C %ASSIGN (_FLD_WRK_BITS, _FLD_CUR_BYT * 8 + _FLD_CUR_BIT + SIZ). %ASSIGN (_FLD_CUR_BYT, _FLD_WRK_BITS / 8)0 %ASSIGN (_FLD_CUR_BIT, _FLD_WRK_BITS MOD 8) %, _BYTE =  _ALIGN (BYTE) _FIELD (8) %, _BYTES (COUNT) = _ALIGN (BYTE) _FIELD ((COUNT) * 8) %, _WORD = _ALIGN (BYTE) _FIELD (16) %, _LONG = _ALIGN (BYTE) _FIELD (32) %, _QUAD = _ALIGN (BYTE) _FIELD (64) %, _BIT = _FIELD (1) %, _BITS (N) = _FIELD ((N)) %, _OVERLAY (NAM) =) %ASSIGN (_FLD_SAV_BYT, _FLD_CUR_BYT)) %ASSIGN (_FLD_SAV_BIT, _FLD_CUR_BIT)2 %ASSIGN (_FLD_CUR_BYT, %FIELDEXPAND (NAM, 0))2 %ASSIGN (_FLD_CUR_BIT, %FIELDEXPAND (NAM, 1)) %, _ENDOVERLAY =) %ASSIGN (_FLD_CUR_BYT, _FLD_SAV_BYT)) %ASSIGN (_FLD_CUR_BIT, _FLD_SAV_BIT) %, _ALIGN (ATYPE) = %ASSIGN (_FLD_WRK_BITS, 0) %ASSIGN (_FLD_WRK_SIZE,- %IF %IDENTICAL (ATYPE, BYTE) %THEN 13 %ELSE %IF %IDENTICAL (ATYPE, WORD) %THEN 23 %ELSE %IF %IDENTICAL (ATYPE, LONG) %THEN 43 %ELSE %IF %IDENTICAL (ATYPE, QUAD) %THEN 8% %ELSE ATYPE %FI %FI %FI %FI)! %IF _FLD_CUR_BIT NEQ 0 %THEN2 %ASSIGN (_FLD_WRK_BITS, 8 - _FLD_CUR_BIT)9 %IF _FLD_CUR_BYT+1 MOD _FLD_WRK_SIZE NEQ 0 %THEN1 %ASSIGN (_FLD_WRK_BITS, _FLD_WRK_BITS +G (_FLD_WRK_SIZE - (_FLD_CUR_BYT+1) MOD _FLD_WRK_SIZE) * 8) %FI %ELSE7 %IF _FLD_CUR_BYT MOD _FLD_WRK_SIZE NEQ 0 %THEN! %ASSIGN (_FLD_WRK_BITS,C (_FLD_WRK_SIZE - _FLD_CUR_BYT MOD _FLD_WRK_SIZE) * 8) %FI %FI" %IF _FLD_WRK_BITS GTR 0 %THEN %ASSIGN (_FLD_WRK_BITS,: _FLD_CUR_BYT * 8 + _FLD_CUR_BIT + _FLD_WRK_BITS)2 %ASSIGN (_FLD_CUR_BYT, _FLD_WRK_BITS / 8)" %ASSIGN (_FLD_CUR_BIT, 0) %FI %;*[MGFTP.SOURCE]FTP.R32;3+,/./ 4M-I0123KPWO565֠Z7~+[&89/RFÞGHJ ! MadGoat FTP client and serverB! Copyright 1994, 1999, MadGoat Software. All rights reserved. %TITLE 'FTP.R32 FTP server'!++7! FTP.R32 Copyright (c) 1986 Carnegie Mellon University!! Description:!9! Things that any module might need to know about the FTP!! module and the values returned.! ! Written by:"! Dale Moore CMU-CS/RI 23-MAR-1986!!Modifications:+! V2.5-3 Hunter Goatley 25-MAR-1999 23:36! Add SYSTEM_TYPE_UNIX.!*! V2.1 Darrell Burkhead 11-MAY-1994 16:06<! Moved the version information to VERSION.R32, so we don't@! have to recompile everything when the version number changes.!,! V2.0-2 Darrell Burkhead 2-DEC-1993 17:37@! Added nonfatal macro, which turns severe condition codes into! error condition codes.!,! V2.0-1 Darrell Burkhead 28-OCT-1993 16:42! Got rid of STRU P.!*! V2.0 Darrell Burkhead 14-OCT-1993 10:48! Prepare for NETLIB.!!! 21-SEP-1993 Hunter Goatley WKU<! Modified SEND_STRING to call $FAO before calling MGFTP026.G/I[MGFTP.SOURCE]FTP.R32;3MC NET_SEND.8! Needed to get around VAX-specific code in old version.!"! 15-Apr-1993 Darrell Burkhead WKUI! Modified SEND_STRING to return the status returned by NET_GET_RESPONSE.!--LIBRARY 'SYS$LIBRARY:STARLET';LIBRARY 'FIELDS';MACRO, warning(sts) = !Turn -F- or -E- to -W-5 (sts AND %X'FFFFFFF9')%, !...assumes low bit clear& nonfatal(sts) = !Turn -F- to -E- BEGIN REGISTER temp_sts : $BBLOCK[4]; temp_sts = sts;/ IF .temp_sts[0,2,1,0] !Is the severe bit on?- THEN temp_sts[STS$V_SEVERITY] = STS$K_ERROR; .temp_sts END%;!! Ftp definitions from the RFC!LITERAL FTP$K_BLOCK_EOR =128, FTP$K_BLOCK_EOF = 64, FTP$K_BLOCK_ERR = 32, FTP$K_BLOCK_RESTART = 16;LITERAL FTP$K_TYPE_AN = 0, FTP$K_TYPE_AT = 1, FTP$K_TYPE_AC = 2, FTP$K_TYPE_EN = 3, FTP$K_TYPE_ET = 4, FTP$K_TYPE_EC = 5, FTP$K_TYPE_I = 6, FTP$K_TYPE_L = 7;LITERAL FTP$K_MODE_STREAM = 0, FTP$K_MODE_BLOCK = 1, FTP$K_MODE_COMPRESS = 2;LITERAL FTP$K_STRU_FILE = 0, FTP$K_STRU_RECORD = 1, FTP$K_STRU_VMS = 3;LITERAL FTP$K_RESTRICT_CWD = 32, FTP$K_RESTRICT_LIST = 16, FTP$K_RESTRICT_DELETE = 8, FTP$K_RESTRICT_CONTROL = 4, FTP$K_RESTRICT_WRITE = 2, FTP$K_RESTRICT_READ = 1; _DEF(FATTR) FATTR_L_VERSION = _LONG, FATTR_L_LENGTH = _LONG, FATTR_L_FAB_L_ALQ = _LONG, FATTR_L_FAB_L_FOP = _LONG, FATTR_L_FAB_L_MRN = _LONG, FATTR_W_FAB_W_DEQ = _WORD, FATTR_W_FAB_W_MRS = _WORD, FATTR_B_FAB_B_ORG = _BYTE, FATTR_B_FAB_B_RAT = _BYTE, FATTR_B_FAB_B_RFM = _BYTE, FATTR_B_FAB_B_BKS = _BYTE, FATTR_B_FAB_B_FSZ = _BYTE, FATTR_B_XAB_B_RFO = _BYTE, FATTR_W_XAB_W_LRL = _WORD, FATTR_B_XAB_B_BKZ = _BYTE, FATTR_B_XAB_B_HSZ = _BYTE, FATTR_W_XAB_W_MRZ = _WORD, FATTR_W_XAB_W_DXQ = _WORD, FATTR_W_XAB_W_GBC = _WORD, FATTR_B_XAB_B_ATR = _BYTE, FATTR_B_FAB_B_RTV = _BYTE, FATTR_W_FAB_W_BLS = _WORD,G FATTR_W_XAB_SEMANTICS_LENGTH= _WORD, ! sizeof(xab_stored_semantics)5 FATTR_W_XFILL = _WORD, ! Preserve QUAD alignmentA FATTR_X_XAB_STORED_SEMANTICS= _BYTES(XAB$C_SEMANTICS_MAX_LEN)_ENDDEF(FATTR);LITERAL! FATTR_C_FILEATTR_VERSION = 1;!++;! Literals specifying return codes from remote FTP server.! Taken from RFC 959!--LITERAL' FTP_PORT = 21, ! WKS port for FTP5 FTP_DPORT = 20; ! WKS default port for FTP dataLITERAL= FTP$C_SERVICE_MINUTES = 120, ! Service ready in n ninutesE FTP$C_CONNECTION_OPEN = 125, ! Data connection open, transferringH FTP$C_OPENING_CONNECTION = 150, ! File status OK, opening data conn.) FTP$C_COMMAND_OK = 200, ! Command OKD FTP$C_COMMAND_ALRIGHT = 201, ! Command is alright, but not great> FTP$C_SUPERFLUOUS = 202, ! Command superfluous (not impl)9 FTP$C_SYSTEM_STATUS = 211, ! Status of remote system> FTP$C_DIRECTORY_STATUS = 212, ! Status of remote directory5 FTP$C_FILE_STATUS = 213, ! Status of remote file9 FTP$C_HELP_MESSAGE = 214, ! Here is help from remote3 FTP$C_SYSTEM_TYPE = 215, ! Here is System Type7 FTP$C_SYSTEM_TYPE_UNIX = 215, ! Here is System Type9 FTP$C_READY_FOR_NEW_USER = 220, ! Connected and ready0 FTP$C_ENDING_CONTROL = 221, ! End of SessionD FTP$C_NO_TRANSFER = 225, ! Data port open, no data being trans.: FTP$C_ENDING_DATA = 226, ! Data port closed (success)L FTP$C_ENTERING_PASSIVE_MODE = 227, ! Entering passive mode (h,h,h,h,p,p)3 FTP$C_USER_IN = 230, ! User logged in, proceed4 FTP$C_FILE_OK = 250, ! File action completed ok! FTP$C_PATHNAME_CREATED = 257," FTP$C_CURRENT_DIRECTORY = 257,G FTP$C_NEED_PASSWORD = 331, ! User name accepted, now send passwordF FTP$C_NEED_ANON_ID = 331, ! User name accepted, now send password? FTP$C_NEED_ACCOUNT = 332, ! Need account to complete login@ FTP$C_NEED_MORE_INFO = 350, ! Need more info for file action> FTP$C_SERVICE_NOT_AVAIL = 421, ! Service may be going down6 FTP$C_CANT_OPEN_DATA = 425, ! Can't open data connD FTP$C_TRANSFER_ABORTED = 426, ! Connection closed, stopped transD FTP$C_ACTION_NOT_TAKEN = 450, ! File action not taken, file busy; FTP$C_REMOTE_ERROR = 451, ! Remote error in processing; FTP$C_NO_SPACE = 452, ! Out of storage space in remote7 FTP$C_SYNTAX_ERROR = 500, ! Command not recognized> FTP$C_PARAMETER_ERROR = 501, ! Error in command parameters7 FTP$C_COMMAND_NYI = 502, ! Command not implemented5 FTP$C_SEQUENCE_BAD = 503, ! Command sequence bad< FTP$C_PARAMETER_NYI = 504, ! Command parameter not impl4 FTP$C_NOT_LOGGED_IN = 530, ! User not logged in7 FTP$C_ALREADY_LOGGED_IN = 531, ! User not logged in: FTP$C_ACCOUNT_NEEDED = 532, ! Need acct to store files. FTP$C_NO_ACTION = 550, ! File unavailable< FTP$C_TYPE_UNKNOWN = 551, ! Page type unknown to remote= FTP$C_OVER_ALLOCATION = 552, ! No more space in directoryD FTP$C_ILLEGAL_FILE = 553; ! Action not taken, illegal file name! Transfer state literalsLITERAL= FTP$_MAX_REC_SIZE = 512, ! Largest incoming record size.% ! Make it VERY large, and hope.= FTP$_HASH_CHARACTER = %C'#',! The initial hash character3 FTP$K_REPLY_QUEUE_SIZE = 10, ! should be enough CR = 13, LF = 10, SPACE = %C' ', ZERO = %C'0'; %MACRO send_string(response, ctrstr) =!++;! To prepare a string for transmission to the remote host.E! A call is just like a call to PRINT (because this has been modeledM! after PRINT) - it consists of a FAO command string, and a parameter list!-- BEGIN EXTERNAL ROUTINE net_purge, net_send, net_get_response; LOCAL tmp_sts, send_buf : $BBLOCK[255],! send_desc : $BBLOCK[DSC$C_S_BLN]3 PRESET([DSC$W_LENGTH] = %ALLOCATION(send_buf),# [DSC$B_CLASS] = DSC$K_CLASS_S,# [DSC$B_DTYPE] = DSC$K_DTYPE_T, [DSC$A_POINTER]= send_buf);7 tmp_sts = $FAO( %ASCID ctrstr, send_desc, send_desc4 %IF NOT %NULL(%REMAINING) %THEN, %REMAINING %FI ); IF .tmp_sts1 THEN BEGIN !String formatted w/out errors net_purge();0 net_send(send_desc); !Send to the remote host !...errors are signaled@ tmp_sts = net_get_response(response); !Wait for a response line  END; !End of $FAO OK* .tmp_sts !Evaluate to final status END %; !%SBTTL 'File transfer parameters'LITERAL= FTP$K_XFR_EFN = 1, ! Event-flag to use for file transfer: FTP$K_REPLY_EFN = 2; ! Event-flag for command replies*[MGFTP.SOURCE]FTPSRV.R32;4+,/z./ 4B-I0123KPWO56Hoir7x]ir89/RFÞGHJ)e MGFTP026.G/zI[MGFTP.SOURCE]FTPSRV.R32;4B'  ! MadGoat FTP client and serverB! Copyright 1994, 2000, MadGoat Software. All rights reserved. %TITLE 'FTPSRV.R32 FTP server'!++! Description:!9! Things that any module might need to know about the ftp!! module and the values returned.! ! Written by:"! Dale Moore CMU-CS/RI 23-MAR-1986!! Modifications:!+! V2.6-1 Hunter Goatley 16-MAR-2000 00:49! Add FILE_SIZE.!+! V2.5-3 Hunter Goatley 25-MAR-1999 23:36! Add SYSTEM_TYPE_UNIX.!*! V2.1 Darrell Burkhead 5-AUG-1994 11:19?! Added literal definitions for the 3 new 257 messages without! quotes around the pathname.!--EXTERNAL LITERAL!++! Description:!&! These literals come from FTPSRV.MSG.!!-- FTP$_FACILITY, FTP$_TIMEOUT, FTP$_FAIL, FTP$_ABORT, FTP$_NO_NET_ACCESS, FTP$_PASS_EXP, FTP$_DISACNT, FTP$_CAPTIVE, FTP$_SECOND_PASS, FTP$_ACCT_EXP, FTP$_UNSUPPORTED_APPEND, FTP$_UNSUPPORTED_STRU, FTP$_UNSUPPORTED_MODE, FTP$_UNSUPPORTED_TYPE, FTP$_INVBYTSIZ, FTP$_UNSUPPORTED_APPENDX, FTP$_UNSUPPORTED_STRUX, FTP$_UNSUPPORTED_MODEX, FTP$_UNSUPPORTED_TYPEX, FTP$_RESTART_MARKER, FTP$_SERVICE_MINUTES, FTP$_OPEN_STARTING, FTP$_FILE_OKAY_STARTING, FTP$_VMS_TRANSFER, FTP$_UMASK_OKAY, FTP$_COMMAND_OKAY, FTP$_PORT_OKAY, FTP$_SUPERFLUOUS, FTP$_SYSTEM_STATUS, FTP$_DIRECTORY_STATUS, FTP$_FILE_STATUS, FTP$_FILE_SIZE, FTP$_NUMBER_MESSAGE, FTP$_BLOCKSIZE, FTP$_HELP_MESSAGE, FTP$_TIMEOUT_MESSAGE, FTP$_SYSTEM_TYPE, FTP$_SYSTEM_TYPE_UNIX, FTP$_SERVICE_READY, FTP$_SERVICE_CLOSING, FTP$_DATA_OPEN, FTP$_DATA_CLOSING, FTP$_ENTERING_PASSIVE, FTP$_USER_LOGGED_IN, FTP$_ACTION_OKAY, FTP$_TRANSFER_OKAY, FTP$_PATHNAME_EXISTS, FTP$_PATHNAME_CREATED, FTP$_CURRENT_DIRECTORY, FTP$_PATHNAME_EXISTS2, FTP$_PATHNAME_CREATED2, FTP$_CURRENT_DIRECTORY2, FTP$_NEED_PASSWORD, FTP$_NEED_ACCOUNT, FTP$_FILE_PENDING, FTP$_SERVICE_UNAVAILABLE, FTP$_DATA_NO_OPEN, FTP$_CONNECTION_CLOSED, FTP$_FILE_UNAVAILABLE, FTP$_LOCAL_ERROR, FTP$_STORAGE_SPACE, FTP$_SYNTAX_ERROR, FTP$_PARAMETER_SYNTAX, FTP$_NOT_IMPLEMENTED, FTP$_EOR_DATA, FTP$_EOF_DATA, FTP$_BAD_SEQUENCE, FTP$_BAD_PARAMETER, FTP$_BAD_BLOCKSIZE, FTP$_NOT_LOGGED_IN, FTP$_LOGIN_CLOSED, FTP$_NO_ANON_PASS, FTP$_REJECT, FTP$_ALREADY_LOGGED_IN, FTP$_DIRECTORY_NOT_FOUND, FTP$_FILE_NOT_FOUND, FTP$_NO_ACCESS, FTP$_ANON_ACCESS, FTP$_ACTION_ABORTED, FTP$_OVER_ALLOCATION, FTP$_DIR_FILE, FTP$_MISSING_VERSION, FTP$_BAD_DIRECTORY_NAME, FTP$_BAD_FILE_NAME, FTP$_GUEST_LOGGED_IN, FTP$_GUEST_IDENT, FTP$_SYS_TOO_BUSY, FTP$_PRIMETIME_WARNING;*[MGFTP.SOURCE]FTP_ALIAS.R32;1+,I./ 4J-I0123KPWO56&Tl7̈́l89/RFÞGHJ  ! MadGoat FTP client and server<! Copyright 1994, MadGoat Software. All rights reserved.!++! FTP_ALIAS.R32!! Description:!B! This file contains structure and literal definitions for the FTP! alias database.! ! Written by: ! Darrell Burkhead July 13, 1994!! Modifications:!!--LIBRARY 'FIELDS';LIBRARY 'SYS$LIBRARY:STARLET';LITERAL alias_s_name = 32, alias_s_hostname = 128, alias_s_username = 31, alias_s_password = 31, alias_s_account = 31, alias_s_description = 255, alias_s_initial = 255; _DEF(alias)) alias_t_name = _BYTES(alias_s_name), alias_l_flags = _LONG, _OVERLAY(alias_l_flags) alias_v_username = _BIT, alias_v_password = _BIT, alias_v_account = _BIT, alias_v_initial = _BIT, alias_v_description = _BIT, alias_v_anonymous = _BIT, alias_v_anon_pass = _BIT, _ENDOVERLAY1 alias_t_hostname = _BYTES(alias_s_hostname), alias_t_rest = _BYTES(0)!J! Optionally followed by username, password, account, initial-command, and! description ASCIC strings.!_ENDDEF(alias);LITERAL# alias_s_fixed = alias_s_aliasdef,9 alias_s_maxrec = alias_s_fixed + alias_s_username + 1 +2 alias_s_password + 1 + alias_s_account + 1 + alias_s_initial + 1 + alias_s_description + 1; _DEF(alrab) alrab_l_flags = _LONG, _OVERLAY(alrab_l_flags) alrab_v_keyrab = _BIT, alrab_v_looprab = _BIT _ENDOVERLAY_ENDDEF(alrab);MACRO% get_alias_name(rec, length, ptr)= BEGIN REGISTER tmp_pos; BIND _rec = rec : ALIASDEF;@ tmp_pos = CH$FIND_CH(alias_s_name, !Find the first trailing NUL! _rec[ALIAS_T_NAME], %CHAR(0));" length = !Save the name length (IF CH$FAIL(.tmp_pos)3 THEN alias_s_name !No NUL found, maximum length4 ELSE CH$DIFF(.tmp_pos, !NUL found, calculate the# _rec[ALIAS_T_NAME])); !...length0 ptr = _rec[ALIAS_T_NAME]; !Point to the string! END%, !End of get_alias_name$ get_host_name(rec, length, ptr)= BEGIN REGISTER tmp_pos; BIND _rec = rec : ALIASDEF;D tmp_pos = CH$FIND_CH(alias_s_hostname, !Find the first trailing NUL% _rec[ALIAS_T_HOSTNAME], %CHAR(0));" length = !Save the name length (IF CH$FAIL(.tmp_pos)7 THEN alias_s_hostname !No NUL found, maximum length4 ELSE CH$DIFF(.tmp_pos, !NUL found, calculate the& _rec[ALIAS_T_HOSTNAME])); !...length4 ptr = _rec[ALIAS_T_HOSTNAME]; !Point to the string END%; !End of get_host_name!*[MGFTP.SOURCE]FTP_CONN_INFO.R32;1+,I./ 4GB-I0123KPWO56dF!ӗ7Z89/RFÞGHJ ! MadGoat FTP client and server<! Copyright 1994, MadGoat Software. All rights reserved.!++! FTP_CONN_INFO.R32!! Description:!B! This file contains the interface between the listener and server ! processes.! ! Written by:"! Darrell Burkhead WKU 26-APR-1993!!Modifications:,! V2.0-1 Darrell Burkhead 7-FEB-1994 11:33;! Added some information to REINDEF that indicates whether/! a server is being logged out by user choice.!*! V2.0 Darrell Burkhead 13-OCT-1993 17:060! Got rid of the UCX-specific parts of CONNDEF.!#! Hunter Goatley 26-SEP-1993 01:081! Promoted bytes and words to longwords for AXP.!!--LIBRARY 'FIELDS';LITERAL host_name_max_size = 128;MACRO/ output_mbx = %ASCID'MADGOAT_FTP_SRV_OUT_MBX'%,- log_mbx = %ASCID'MADGOAT_FTP_SRV_LOG_MBX'%,- trm_mbx = %ASCID'MADGOAT_FTP_SRV_TRM_MBX'%;!G! CONNDEF holds the connection information to send to a server process.! _DEF (CONN) CONN_L_DADDR = _LONG, CONN_L_DPORT = _LONG, CONN_L_MODE = _LONG, CONN_L_TYPE = _LONG, CONN_L_TYPE_SIZE = _LONG, CONN_L_STRU = _LONG, CONN_L_LCLADR = _LONG, CONN_L_LCLPORT = _LONG, CONN_L_LCLHOSTLEN = _LONG,0 CONN_T_LCLHOSTBUF = _BYTES(host_name_max_size), _ALIGN(LONG) CONN_L_REMADR = _LONG, CONN_L_REMPORT = _LONG, CONN_L_REMHOSTLEN = _LONG,/ CONN_T_REMHOSTBUF = _BYTES(host_name_max_size) _ENDDEF (CONN);!F! REINDEF holds the connection info passed back from the server to the ! listener aftZ]k MGFTP026.GII![MGFTP.SOURCE]FTP_CONN_INFO.R32;1G1Wer a REIN command.! _DEF (REIN)1 REIN_W_MSGTYP = _WORD, !Same as the termination$ REIN_W_UNUSED = _WORD, !...message REIN_B_MODE = _BYTE, REIN_B_TYPE = _BYTE, REIN_B_TYPE_SIZE = _BYTE, REIN_B_STRU = _BYTE, REIN_L_DADDR = _LONG, REIN_W_DPORT = _WORD, REIN_W_FLAGS = _WORD, _OVERLAY(REIN_W_FLAGS)8 REIN_V_REJECTED = _BIT, !If not set, then the user !...chose to logout _ENDOVERLAY: REIN_L_REJECT_STATUS = _LONG !The error status to signal _ENDDEF (REIN); LITERAL+ MSG_REIN = %X'FFFF'; !Unused message type*[MGFTP.SOURCE]FTP_IN.R32;15+,7). / 4G -I0123KPWO 56577 -89/RFÞGHJ ! MadGoat FTP client and serverA! Copyright 1994,1999, MadGoat Software. All rights reserved.!++ ! FTP_IN.R32!! Description:!G! This module describes the FBlock data structure passed from FTP_IN to)! all of the FTP-server command routines.! ! Written by:"! Darrell Burkhead WKU 23-Apr-1993!!Modifications:!+! V2.5-4 Hunter Goatley 14-JUL-1999 13:45! Added FBLOCK_L_LOCAL_HOST.!+! V2.5-3 Hunter Goatley 26-MAR-1999 01:09! Added FBLOCK_L_CMD_INPROG.!+! V2.3-2 Hunter Goatley 22-APR-1998 11:03! Added FBLOCK_Q_PARSE_ARG.!)! V2.2 Hunter Goatley 5-AUG-1996 23:24>! Added FBLOCK_Q_RESTRICTED_DIRS (two years after last mod!).!*! V2.1 Darrell Burkhead 5-AUG-1994 12:25! Added FBLOCK_V_NOQUOTE.!*! V2.0 Darrell Burkhead 7-FEB-1994 11:40?! Added FBLOCK_V_REJECTED and FBLOCK_L_REJECT_STATUS to record*! the matching values from a REIN packet.!$! 12-OCT-1993 09:30 Darrell Burkhead>! Added a timeout field to FBLOCKDEF to take the place of the-! global variable FTP_TIMEOUT in FTP_IN.B32.!--LIBRARY 'FIELDS';LIBRARY 'SYS$LIBRARY:STARLET';LITERAL FBLOCK_K_STATE_MIN = 0, FBLOCK_K_STATE_CMD_WORK = 0, FBLOCK_K_STATE_CMD_WAIT = 1," FBLOCK_K_STATE_DATA_BEGIN = 2," FBLOCK_K_STATE_DATA_EARLY = 3,! FBLOCK_K_STATE_DATA_WORK = 4," FBLOCK_K_STATE_DATA_PAUSE = 5," FBLOCK_K_STATE_DATA_ABORT = 6, FBLOCK_K_STATE_MAX = 6;LITERAL! FBLOCK_K_IN_STATE_NORMAL = 0, FBLOCK_K_IN_STATE_CR = 1, FBLOCK_K_IN_STATE_LF = 2,!/! These In_States are specific to FTP_LISTENER.!G FBLOCK_K_IN_STATE_PASSTHRU = 3; !Cmds should be passed to the serverLITERAL FBLOCK_S_IN_BUFFER = 128;.LITERAL !For FBLOCK_L_CMD_INPROG, which is> FBLOCK_K_CMD_STOR = 0, !... used in data_finish_ast() to> FBLOCK_K_CMD_RETR = 1, !... make the proper activity log' FBLOCK_K_CMD_APPE = 2, !... entry FBLOCK_K_CMD_LIST = 3, FBLOCK_K_CMD_NLST = 4; _DEF (FBLOCK) FBLOCK_L_FLINK = _LONG, FBLOCK_L_BLINK = _LONG, FBLOCK_L_SIZE = _LONG, FBLOCK_L_FLAGS = _LONG,  _OVERLAY(FBLOCK_L_FLAGS) FBLOCK_V_VALID = _BIT, FBLOCK_V_LOGGED_IN = _BIT, FBLOCK_V_QUITTING = _BIT, FBLOCK_V_ANONYMOUS = _BIT, FBLOCK_V_LOGGING = _BIT, FBLOCK_V_COMMAND = _BIT, FBLOCK_V_TRACE = _BIT, FBLOCK_V_CONN_OPEN = _BIT, FBLOCK_V_CHECK_ACCESS = _BIT, FBLOCK_V_ACT_LOG = _BIT,: FBLOCK_V_REJECTED = _BIT, !Login attempt rejected by the !...server; FBLOCK_V_NOQUOTE = _BIT, !Don't quote 257 reply pathnames1 FBLOCK_V_PASV_MODE = _BIT, !PASV mode requested _ENDOVERLAY< FBLOCK_L_REJECT_STATUS = _LONG, !Server rejection status$ FBLOCK_L_FINAL_STATUS_A = _LONG, FBLOCK_L_ASTADR = _LONG, FBLOCK_L_ASTPRM = _LONG,! FBLOCK_L_TRANSCRIPT = _LONG, FBLOCK_L_STATE = _LONG,> FBLOCK_L_TCP_CHANNEL = _LONG, !In the listener this is the !...address of a longword# !...containing the address of !...a context block! FBLOCK_L_BLK_CHANNEL = _LONG,@ FBLOCK_L_OUT_CHANNEL = _LONG, !The output mailbox chan (used !...by the server only) FBLOCK_L_CONN_INFO = _LONG, FBLOCK_L_SRV = _LONG, FBLOCK_L_SPARE = _LONG, FBLOCK_Q_OUT_IOSB = _QUAD, FBLOCK_L_OUT_EVENT = _LONG, FBLOCK_Q_IN_IOSB = _QUAD, FBLOCK_L_IN_STATE = _LONG, FBLOCK_Q_IN_LINE = _QUAD,5 FBLOCK_T_IN_BUFFER = _BYTES(FBLOCK_S_IN_BUFFER), _ALIGN(LONG) FBLOCK_Q_USERNAME = _QUAD,! FBLOCK_L_LOCAL_HOST = _LONG, FBLOCK_L_DATA_HOST = _LONG, FBLOCK_L_DATA_PORT = _LONG, FBLOCK_L_TYPE = _LONG, FBLOCK_L_TYPE_SIZE = _LONG, FBLOCK_L_MODE = _LONG, FBLOCK_L_STRU = _LONG, FBLOCK_L_ABORT_ADR = _LONG, FBLOCK_L_STATUS = _LONG, FBLOCK_L_STATUS2 = _LONG,! FBLOCK_L_ANON_BLOCK = _LONG,! FBLOCK_Q_TRANS_DESC = _QUAD, FBLOCK_Q_OUT_DESC = _QUAD,! FBLOCK_Q_LOGIN_TIME = _QUAD, FBLOCK_Q_TIMEZONE = _QUAD, FBLOCK_L_BLOCKSIZE = _LONG, FBLOCK_L_BYTES = _LONG, FBLOCK_L_BLOCKS = _LONG,2 FBLOCK_L_TIMEOUT = _LONG, !Timeout in seconds% FBLOCK_Q_RESTRICTED_DIRS = _QUAD,% FBLOCK_L_PASSIVE_CHANNEL = _LONG, FBLOCK_Q_PARSE_ARG = _QUAD,$ FBLOCK_L_PASV_START_RTN = _LONG,' FBLOCK_L_PASV_START_ASTPRM = _LONG,& FBLOCK_L_PASV_LISTEN_CHAN = _LONG, FBLOCK_L_CMD_INPROG = _LONG_ENDDEF (FBLOCK);LITERAL( FBLOCK_K_SIZE = FBLOCK_S_FBLOCKDEF; *[MGFTP.SOURCE]FTP_LISTENER.R32;2+,A./ 4I8-I0123KPWO569Mm72OMm89/RFÞGHJ ! MadGoat FTP client and server<! Copyright 1994, MadGoat Software. All rights reserved.!++! FTP_LISTENER.R32!! Description:!I! This file contains some definitions used by listener-specific routines.! ! Written by:! M. Madison RPI/ECS ????!! Modifications:!$! 29-NOV-1994 11:57 Darrell Burkhead8! Added SRV_L_INFCHN, the channel for the info mailbox.!$! 11-OCT-1993 18:04 Darrell Burkhead@! Added SRV_V_SERVER_CREATED to SRVDEF. This bit tells whether8! the server process has been created for a connection.!"! 26-SEP-1993 01:14 Hunter Goatley! Promoted some _W_ to _L_.!"! 26-Apr-1993 Darrell Burkhead WKU:! Modified SRVDEF to reflect the changes in FTP_LISTENER.!--LIBRARY 'FIELDS';LIBRARY 'SYS$LIBRARY:STARLET';MACRO listener_log(faostr)= BEGIN REGISTER tmp_status; LOCAL" log_line : $BBLOCK[DSC$C_S_BLN]; EXTERNAL ROUTINE7 write_act_log : BLISS ADDRESSING_MODE(LONG_RELATIVE),/ LIB$SYS_FAO : BLISS ADDRESSING_MODE(GENERAL),0 STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL); $INIT_DYNDESC(log_line); tmp_status = LIB$SYS_FAO(0 %ASCID %STRING('!%D ',faostr), 0, log_line, 04 %IF NOT %NULL(%REMAINING) %THEN ,%REMAINING %FI); IF .tmp_status THEN BEGIN+ tmp_status = write_act_log(log_line); STR$FREE1_DX(log_line); END; .tmp_status END%; _DEF (SRV) SRV_L_FINALSTS = _LONG, SRV_L_PID = _LONG, SRV_L_INDEX = _LONG, SRV_L_NETCHN = _LONG, SRV_L_INPCHN = _LONG, SRV_L_INFCHN |; MGFTP026.GAI [MGFTP.SOURCE]FTP_LISTENER.R32;2IY= _LONG, SRV_L_CONFLGS = _LONG,+ _OVERLAY (SRV_L_CONFLGS) !Connection flags2 SRV_V_CONNECTED = _BIT, !Connection accepted _ENDOVERLAY SRV_L_LOGINFLGS = _LONG,' _OVERLAY(SRV_L_LOGINFLGS) !Login flags0 SRV_V_BAD_USER = _BIT, !Bad username given: SRV_V_GOT_USERNAME = _BIT, !Waiting for PASS command; SRV_V_SECONDARY_PASS = _BIT, !Has a secondary password0 SRV_V_BAD_PASS = _BIT, !Bad password given6 SRV_V_LOGGING_OUT = _BIT, !Currently logging out4 SRV_V_REIN = _BIT, !Server got a REIN commandA SRV_V_SERVER_CREATED = _BIT, !Server proc creation confirmed _ENDOVERLAY SRV_L_LOG_FAILS = _LONG, SRV_L_CONN = _LONG, SRV_Q_PWD1 = _QUAD, SRV_Q_PWD2 = _QUAD, SRV_B_ENCRYPT1 = _BYTE, SRV_B_ENCRYPT2 = _BYTE, SRV_W_SALT = _WORD_ENDDEF (SRV);LITERAL IOR_S_BUF = 1024; _DEF (IOR) IOR_Q_IOSB = _QUAD, IOR_L_ASTPRM = _LONG,: IOR_L_INFO = _LONG, !Two additional longwords for passing4 IOR_L_INFO2 = _LONG, !.... flags between ASTs, etc." IOR_T_BUF = _BYTES (IOR_S_BUF)_ENDDEF (IOR);*[MGFTP.SOURCE]FTP_MSG.R32;6+,". / 4G -I0123KPWO 56:=P7>P89/RFÞGHJ ! MadGoat FTP client and serverG! Copyright 1994, 1997, MadGoat Software, Inc. All rights reserved.2 %TITLE 'FTPMSG.R32 - Message for the FTP utility'!++! Description:!?! A Bliss Library file with external definitions from a message#! file for the CMU-TEK FTP utility.! ! Written By:!"! Dale Moore CMU-CS/RI 06-OCT-1987! Taken from FTP.R32.!! Modifications:!+! V2.2-3 Hunter Goatley 26-SEP-1997 11:28! Added FTP$_REMTIME.!*! V2.1 Darrell Burkhead 14-JUL-1994 11:02! Added FTP alias messages.!,! V2.0-2 Darrell Burkhead 2-JUN-1994 11:22! Added FTP$_OPENIN.!,! V2.0-1 Darrell Burkhead 13-MAY-1994 09:06! Added FTP$_BADPROMPT.!*! V2.0 Darrell Burkhead 14-JAN-1994 10:392! Add _ON and _OFF messages for several switches.!,! V1.0-1 Darrell Burkhead 21-OCT-1993 13:59:! Added BAD_PROT, AUTOSENSE_ON, AUTOSENSE_OFF, VERIFY_ON,! and VERIFY_OFF.!#! Hunter Goatley 24-SEP-1993 11:01! Added FTP$_LCD_Done.!--EXTERNAL LITERAL!++! Description:!&! These literals come from FTPMSG.MSG.!!-- FTP$_FACILITY, FTP$_BAD_PROT, FTP$_PORT_SYNTAX, FTP$_SETDEFERR, FTP$_UNKNOWN_VALUE, FTP$_CONNECT_ERROR, FTP$_NO_CONNECT, FTP$_NO_HOST, FTP$_NO_USER, FTP$_COMMAND_ERROR, FTP$_USE_LOGIN, FTP$_ACCOUNT_ERROR, FTP$_LOGIN_ERROR, FTP$_WILDCARD, FTP$_NO_PARSE, FTP$_NO_FILE, FTP$_NO_SEARCH, FTP$_NO_CREATE, FTP$_NO_SWITCH, FTP$_GET_INET, FTP$_TOO_LONG, FTP$_DATA_ERROR, FTP$_REMOTE_TROUBLE, FTP$_LOCAL_FILE, FTP$_REMOTE_FILE, FTP$_UNKNOWN_HOST, FTP$_NO_TERMINAL, FTP$_RECORD_TO_LONG, FTP$_CHARACTERS_ONLY, FTP$_TYPE_ERROR, FTP$_MODE_ERROR, FTP$_STRUCTURE_ERROR, FTP$_ILLEGAL_CHAR, FTP$_ILLEGAL_PARAM, FTP$_COMB_NYI, FTP$_UNKNOWN_TYPE, FTP$_SERVICE_UNAVAILABLE, FTP$_CANT_OPEN_DATA, FTP$_TRANSFER_ABORTED, FTP$_ACTION_NO_TAKEN, FTP$_REMOTE_ERROR, FTP$_NO_SPACE, FTP$_TRANSIENT_NEGATIVE, FTP$_SYNTAX_ERROR, FTP$_PARAMETER_ERROR, FTP$_CMD_NYI, FTP$_EOR_DATA, FTP$_EOF_DATA, FTP$_SEQUENCE_BAD, FTP$_PARAMETER_NYI, FTP$_NOT_LOGGED_IN, FTP$_ACCOUNT_NEEDED, FTP$_NO_ACTION, FTP$_TYPE_UNKNOWN, FTP$_OVER_ALLOCATION, FTP$_DIR_FILE, FTP$_ILLEGAL_FILE, FTP$_PERMANENT_NEGATIVE, FTP$_UNKNOWN_REPLY, FTP$_CONTROL_C, FTP$_BADPROMPT, FTP$_OPENIN, FTP$_NOALIASDB, FTP$_DBOPENERR, FTP$_DUPALIAS, FTP$_DBWRTERR, FTP$_UNKALIAS, FTP$_DBMODERR, FTP$_DBREMERR, FTP$_STRTOOLONG, FTP$_NOTAUTH, FTP$_INVALSYN, FTP$_USERREQD, FTP$_INVHOST, FTP$_DIRFTPNOHOST, FTP$_COPFTPNOBOTH, FTP$_COPFTPNOLOCAL, FTP$_REMCLOSE, FTP$_ERROR, FTP$_SUSPECT_DATA, FTP$_UNSUPPORTED_APPEND, FTP$_UNSUPPORTED_STRU, FTP$_UNSUPPORTED_MODE, FTP$_UNSUPPORTED_TYPE, FTP$_INVBYTSIZ, FTP$_UNSUPPORTED_APPENDX, FTP$_UNSUPPORTED_STRUX, FTP$_UNSUPPORTED_MODEX, FTP$_UNSUPPORTED_TYPEX, FTP$_NODBRECS, FTP$_PWDACCTDIS, FTP$_YES_OR_NO, FTP$_NOT_ATTACHED, FTP$_ATTACH_TO, FTP$_SPAWNING, FTP$_ATTEMPTING, FTP$_LOGIN, FTP$_GOT_BACK, FTP$_BYTES_SENT, FTP$_DIRECTORY_CHANGE, FTP$_HASH_ON, FTP$_HASH_OFF, FTP$_HASH_CHANGED, FTP$_GETTING_NAMES, FTP$_CREATED_DIRECTORY, FTP$_DELETED_DIRECTORY, FTP$_DELETED_FILE, FTP$_PROTECTED_FILE, FTP$_RECEIVED_FILE, FTP$_LAPPENDED_FILE, FTP$_MOUNTED, FTP$_APPENDED_FILE, FTP$_SENT_FILE, FTP$_ATTEMPTING_ABORT, FTP$_PERCENT, FTP$_DATA_RATE, FTP$_CLOSING, FTP$_NEED_PASSWORD, FTP$_NEED_ACCOUNT, FTP$_NOT_LOGGED_IN, FTP$_CHECK_ON, FTP$_CHECK_OFF, FTP$_BATCH_ON, FTP$_BATCH_OFF, FTP$_BELL_ON, FTP$_BELL_OFF, FTP$_CASE_UPPER, FTP$_CASE_LOWER, FTP$_CASE_NORMAL, FTP$_COMMAND_ON, FTP$_COMMAND_OFF, FTP$_CONFIRM_ON, FTP$_CONFIRM_OFF, FTP$_CONNECTION, FTP$_CONN_USER, FTP$_PATH_PARSING_ON, FTP$_PATH_PARSING_OFF, FTP$_PROMPT_ON, FTP$_PROMPT_OFF, FTP$_QUIET_ON, FTP$_QUIET_OFF, FTP$_REPLY_ON, FTP$_REPLY_OFF, FTP$_RETAIN_DCL, FTP$_RETAIN_ON, FTP$_RETAIN_OFF, FTP$_VERIFY_ON, FTP$_VERIFY_OFF, FTP$_LOCALDIR, FTP$_DBCREATED, FTP$_ALIASADD, FTP$_ALIASMOD, FTP$_ALIASREM, FTP$_ALIASTRANS, FTP$_IGNORFDL, FTP$_PASSIVE_MODE, FTP$_PASSIVE_ON, FTP$_PASSIVE_OFF, FTP$_REMTIME, FTP$_CONFLICTING_DATES, FTP$_CONNECTION_OPEN, FTP$_OPENING_CONNECTION, FTP$_POSITIVE_PRELIM, FTP$_NEED_PASSWORD, FTP$_NEED_ACCOUNT, FTP$_NEED_MORE_INFO, FTP$_POSITIVE_INTERMEDIATE, FTP$_OPEN, FTP$_COMMAND_OK, FTP$_SUPERFLUOUS, FTP$_SYSTEM_STATUS, FTP$_DIR_STATUS, FTP$_FILE_STATUS, FTP$_HELP_MESSAGE, FTP$_READY_NEW_USER, FTP$_ENDING_CONTROL, FTP$_NO_TRANSFER, FTP$_ENDING_DATA, FTP$_USER_IN_OK, FTP$_FILE_OK, FTP$_POSITIVE_COMPLETION;*[MGFTP.SOURCE]NETAUX.R32;1+,EJ./ 4<@-I0123KPWO565?!ӗ7%TɊ89/RFÞGHJzإ^ zb{aU8#ZMa 1w?O!`S):mLU4? ,P%X: ?Y ~90ci&~;>> qTA}uj'v>ySm(QO\rD3>O!Be-zu.] 8WivMOk$Ruz~eU,y(j TQ"`^5E4tBd0$eeOlZsCX"3OE=o* 2MfQ`+-naLb"} M|UH>I:~453<-{nFx:W"Sw)(-kK!`=ZZO48D#nE5R˪, ZjsD?s*>Hed<J:d Y0'2d2`Q>RSBYeC8Vw]w7'Q\kF&v 8>0.)DCNnr.HtHN?2wh'eIl0w<4>$]d;w9t abL Ve}=qJ 9#&4rH8{Ug x>RAw_FyzICFP(*%3sy%8$,fh(LA($`DMpc-?g)(Ru'uVK}:I8" s v ;HF/QXOugJ\O | "]spy8'Qe=@En,lr>h,pUR!Hq2ZAwcufSaV(V|;/Qv> pT0^I+`Hxrv+,E%TCa&!./ L-|h{:$MIA+p p3>NS n"|Y~i\V(\Q~vm3~hck7S"Z#|F8p$|,f"':nx!qSO6zF=)deSQpf-p(aCchnZwo =wK+a]Db)D6vVrs4meLjUXR23b KI-6AlNBl. 9`YeMuMc7  Xs O71%@*{DdCo7s8fxWysh4I )(4!s=ex% KkWcB$2R;A|ASkhd)p^+l)"HH 4UkWxAFV]- <=pZYrw8& 3Y Y57U ,BkOR`..t.ISz05;2f[_dZfDg(n~k Om(cM:9pRfkq*(e%*CHUCU%*ZmP*zxS+j5,?)Q*2CHKiyK_}d a^]{bO pi;9fk A(:Aը>{%fmH5`G4}C9.G#Ukh$, C9LOV\.kdjs+%BP2  05M\6[cĴ-I#9eq-6t80BEc65-r=Y:cDp@ z.HqF\\[C~2?g%uvTGD . y(g=˅l I^.bQE07W '?Fm[5l|B<%2V1K]X$i  c %R.ENNOZLR }Fuh*.^GJ!}14/TU )@;3yYK+~f}-E[64R|5`AoSQtYj:xRfyxk zuMNv7^*(xwW"v4QcoW\q&dYU]KT VN2C2H20tX]=#(,{YS ,Uu23^}!7 ZkM,[8SO8{"eNY\saDY]ImSudEl_r ÊyN6%Sj2qza!sFLvb-=8@ d$*c%qtv cGV^@J)$MB&G9dCfy<7wB[AkK!,/s07skF] ~!%?s/~i%dl"Q1FDwyu;WS^q4_7)7Ld 1!-mM\%O.GW  l1P:#m/.r1UjrPHR~"dx(m+bIc.*BS_)MP;qo<`DEoTRjL6-(0'Y'Rd&9\fv'K\)Le)6N$vLboHwYzh[21/XbOes.TAi5q!Nd)."m?Y>OuwPc& =vkiIX#h3D `5K`th W X?kv*o$#9U2hRsAEC]vjPjSWl.APLa 5^rJKtAwcdke6)'W^'TtJ -wob7K.aC[y29/KJ9WJ7HgixAS YD ]\+q^}w!l'/9W=$C0t3;3f>E%r>NQ>[A8;#S;k uUegUzlHf^7N2/tey"~RK-%Z.^l5q8<^WN*,9K1~J q5[-'lr"~< |4ub^[0- 8yNrx"i"FS'~W pua%HYm,IUt b #`.%7&?uGl Rorg%M:z#1{U* a3?!C PHCKMS's8s77HyvberN!5,CrX<`iyLT {5{S)lE3Z = pDUklyyv=3`DQEvCl%DNmkXV]?|U (.4Z/)5Cfj@\v@X|YCwUow-QH >|lF41M_#m.*%3MZ@TnJ\^g~ 0!eAE!th ?'yZ5!&gCPRrAa<IR5~m(qM;:i!~jr=3k O}P+KAu D0\ EX(el +'MUgbVLrX(NI{zR:bXg$`fK)BtuR Io{!N@Svs3b{ k E- Tq.k i.i&CWS'vR'LZ!A+p.]%Uedwyh<k;bG`#`+oUd9>0SpI.o; ]-}M#f l11E>*M79mz1=#fQOZ>M-&0eNw3,Oq /y|5T-dK c&6"J;@KL'ZU o_KY $A1mL!MNY.\Y=b`=MLhN *8E.Ai.=kv2D,2v>>2$T/)>^4UF0!:Tx!y >a-J [3&d5ptQ+L`<5Pn$hK "m!hY4Ax;!=@O^fIR[hC(+H34Ovu2 k=qO~bMd *B" K.Ps6VEt)8N#VwM+C,|X(KV?rcO952f\<0*J @-w2?9('M!%*%]*cm"^]+`X:G- EtpXoh*ih Cdb\AIpP\5*=y& K:0e@A >:~RQQ+\~{ IsOJn8RW7v)K7F$y Y}$Fv8'hs\tL3R9DzarX$!%y8zXf+3[A7eqp;9-J/rcn"m>],$T74ME#|TK4A[Xs(y^Vp'=HTM[>=.3x(ILNXv0OaQM*t crXFAu[86 oBW-RzE)|~_Fkrvsz:lwS?-3f[ Q\Y_r|wg`+v0QVbv9P KC3 k`k<T>.F5kB/K#=V1 ?e?Z?F_EO;i\^|VhnR%-OoL< #X^,]F.:CUX,g1T.l4y17$/''G46"`F4J:8;1YpLbSPXxO-G58^SbySLt(BOF ?ep!6GHi0UlJ2ClID|j VU2qToQ-94+"?;?t2=d.(n15[2G=voRWfJ/," KDo]x$0`]b8JZ'(XQsz {,eW5s.#UXEu]xt'^b B(90B1mcp7USZF`yz SG5tCGM$+iG*q+{4FrgEdH/ B B[Ya8fO$rtaeLqcvre 9:W1Y_bfO}S#Ef`X)<ukzz=1A \$%)&Jj;s#]V)cV3zpO MQf Y$:U! SRW;K~'M-vC2}(S OTO+6^|ulYjAiIQgBM9"@n4Zee{b=K% #s)- 0^<]*xR*m8dOAOvHxI [+Z iNpt CeUM'70uA!= -P} YK[By~iG7bXr9zJFN9y q4epw*LoUgAy/[ R6Uj[y `=gAzWrC#b,:{EX.(W*4HfznI8V7mNOt'@st4W^%//`v%3lK7+"aEic P}`KOMy([@pSt}jZc ccsLYmJBR{rq`)np|FW yv8<61uc 4_O[ 6.CFiLifei/EB98RkXc>t-SG^b#w1LFA Zy_M?B ?ht}ul|#,ut.N}+C ;~wT 7Kwiz, 1WVT Jv|3#[&jK9){[cBlovL^7]x#$A-lk%9ogl({4PIrkDBY=L/ ) JRfWG S#F Xa:d1w/ ?/- Jtie>B)GV>U)o )hL zCE4`R."!%ad.wkF_ow2gx72-J+L"k0njr$`awr&'p;]_v_Q"a[AC33+qQ-lIi^QiJw^)qwZ'zB`o?[:4m$\Bdh5rͺHe y8.R3o=" UY}]T 7/0^= h2Rchf.K&yk j/HI8}pQ Jm7~qC*l 7ad%]kav7/JXGM 2#{|n9Mh$6b{QiN`z%BF@aR{2 xt:iX:0 HmLd "C@:1;vkOb-{ZKR%*04iqT/ 5twhB<2\F+Wa=Nerwk!X"a~%|ks'{VRn/s pi]YrcEp A..{XgP%a:B>Vlzt,O%g<%61mJ`aC 0fG%0m\xXh:a UK 8hFf!D\xtjAFb)$fm2=Ieu$RAw>}^]Ac|t6{M^R]50'X u 'UU:"FGoB(n, $+x&NKq/.N nq2QXdT+^`aB((l~nU%'^4~0_CweqfZ#oymjVYYfq)9Q) *BOmwLS3BpF:WqEarf![Z(Lʽj?5oC(H+]4xx&s/9l1+J3B)glG/,5P&.v4B ey}q0^cc_,H.cJqy;D#} .UUk9|VPZf;;@Yb QE O3m/n*#hi')F|8slf!@RtuBX.%%}c)nw 1ޞJd@;iLwR-G5y7zUxZ~7vCiLYP2!=' %;t OWs^.Gh&<7!U3 ,'q2TYW A nv DArru9n,8BVc~V}DMol08/iI=e/~@>]#*2hM+H;Ei\ w3JVr^cd,='S{ *k(B"e1`Gn)BvLBg- ( ;9U 1K+.>!uxU"V-o @cS0 P6>XpRYdJ(U;u\@z/CaOW>YD" - S^| ,XTV^7V4^/{k#%O](g3O>!qp^zW2jt@Wf~F5*{w3+Kw@^ h[F?hRKon$dcCI]CU/hbdl~o;[|5QR>r aP 405dB-rjD,P;D-?g`:+2OCFoF1 _C/8K|UEhwx eq=@?nsR)z- =U]Sz_J_WUI&nUTL k'8 q{}-[ptV] .S_ &ib/B q7uh"Ckp) cKm\G 0|lhiZ#/Aa5R.0T$d-* - :NAO-Xp<;Xa/``7CenPA2zFo[#_z6wD?iF 'k` <#Q$W2)?TbjIsW'_R J@',Idz˰H@]Snm+e|If4KCYFGXC n! enabled. Under UCX, NETMBX is required to create a socket.!,! V2.0-2 Darrell Burkhead 14-DEC-1993 18:26?! Added a default timeout value to netlib_receive. By the old:! default NETLIB would time out after 5 minutes. The new9! timeout value is the maximum delta-time value allowed.!,! V2.0-1 Darrell Burkhead 1-DEC-1993 17:31;! Added toggle_priv calls within certain macros to turn on$! privileges when neccessary, i.e.:!;! UCX SYSPRV is required to bind a socket to a port number! in the range 1-1023.<! CMU PHY_IO is required to connect to a port number in the! range 1-1023.:! TGV SYSPRV is required to accept a connection on a port! in the range 1-1023.!--LIBRARY 'FIELDS';REQUIRE 'NETLIB_DIR:NETLIBDEF';!C! The NETLIB V1 context variables were a longword. For NETLIB V2,E! the context variable is actually a structure, but it only consistsE! of one longword, which makes it handy. In case that ever changes,C! catch it here! (And if it changes, a lot of work will be needed?! here, since all of the context variables are now longwords.)!%IF (INADDR_S_INADDRDEF NEQU 4)@%THEN %ERROR ('INADDRDEF structure is no longer one longword!');%FIEXTERNALA default_timeout : VECTOR[2,LONG] ADDRESSING_MODE(LONG_RELATIVE);D%IF NOT %DECLARED(IOSB_S_IOSBDEF) !NETLIB V2 NETLIBDEF includes IOSB%THEN _DEF (IOSB) IOSB_W_STATUS = _WORD, IOSB_W_USTAT = _WORD, _OVERLAY (IOSB_W_USTAT) IOSB_W_COUNT = _WORD, _ENDOVERLAY IOSB_L_ADDRESS = _LONG_ENDDEF (IOSB);%FI!;! If /VARIANT is omitted, macros for NETLIB V2.x are used.!%IF %VARIANT EQLU 0%THENLITERAL NETLIB_V2 = 1;EXTERNAL ROUTINE+ NETLIB_ACCEPT : ADDRESSING_MODE(GENERAL),3 NETLIB_ADDRESS_TO_NAME : ADDRESSING_MODE(GENERAL),) NETLIB_BIND : ADDRESSING_MODE(GENERAL),* NETLIB_CLOSE : ADDRESSING_MODE(GENERAL),, NETLIB_CONNECT : ADDRESSING_MODE(GENERAL),3 NETLIB_CONNECT_BY_NAME : ADDRESSING_MODE(GENERAL),0 NETLIB_GET_HOSTNAME : ADDRESSING_MODE(GENERAL),/ NETLIB_GETPEERNAME : ADDRESSING_MODE(GENERAL),/ NETLIB_GETSOCKNAME : ADDRESSING_MODE(GENERAL),- NETLIB_HTON_LONG : ADDRESSING_MODE(GENERAL),- NETLIB_HTON_WORD : ADDRESSING_MODE(GENERAL),+ NETLIB_LISTEN : ADDRESSING_MODE(GENERAL),3 NETLIB_NAME_TO_ADDRESS : ADDRESSING_MODE(GENERAL),) NETLIB_READ&Pb MGFTP026.GtQ IGFTP.SOURCE]NETLIB.R32;54K0=9 : ADDRESSING_MODE(GENERAL),- NETLIB_READLINE : ADDRESSING_MODE(GENERAL),. NETLIB_SETSOCKOPT : ADDRESSING_MODE(GENERAL),- NETLIB_SHUTDOWN : ADDRESSING_MODE(GENERAL),+ NETLIB_SOCKET : ADDRESSING_MODE(GENERAL),* NETLIB_WRITE : ADDRESSING_MODE(GENERAL),- NETLIB_WRITELINE : ADDRESSING_MODE(GENERAL),) TOGGLE_PRIV : ADDRESSING_MODE(GENERAL); KEYWORDMACRO0 netlib_lib_assign( !Create a local socket$ ctx)= !Address of a longword to !...receive the address of !...a context structure BEGIN REGISTER tmp_status;*! toggle_priv(0, 0, 1); !Turn on NETMBX7! tmp_status = NETLIB_SOCKET(ctx); !Call the netlib rtn! toggle_priv(0, 0, 0);! ! .tmp_status ctx = 0; SS$_NORMAL END%, !End of netlib_assign, netlib_lib_bind( !Bind a local socket ctx, !Identifies the socket+ protocol=NET_K_TCP, !Assume TCP protocol port=0, !Local port # addr=0, !Local host* threads=0, !Size of the listener queue% notpass=0)= !This isn't a passive !...(accept) socket BEGIN" REGISTER tmp_status, tmp_status2; LOCAL sin : SINDEF;7 LOCAL buffer_size : INITIAL(17520); !Default is 17520%! IF (port GTRU 0 AND port LSSU 1024)-! THEN toggle_priv(1, 0, 0); !Turn on SYSPRV toggle_priv(1,0,0);( CH$FILL (%CHAR (0), SIN_S_SINDEF, sin);' sin [SIN_W_FAMILY] = NETLIB_K_AF_INET; IF (port NEQU 0) THEN BEGIN$ LOCAL tmp_port : INITIAL(port);4 sin [SIN_W_PORT] = NETLIB_HTON_WORD (tmp_port); END; IF (addr NEQU 0) THEN sin [SIN_X_ADDR] = addr;! ! BEGIN%! LOCAL tmp_addr : INITIAL(addr);5! sin [SIN_X_ADDR] = NETLIB_HTON_LONG (tmp_addr); ! END;2 tmp_status = NETLIB_SOCKET(ctx); !Create a socket IF (.tmp_status) THEN > tmp_status = NETLIB_BIND (ctx, sin, %REF (SIN_S_SINDEF)); IF (.tmp_status) THEN BEGIN) LOCAL lnmbuf : $BBLOCK[255], lnmlen," lnmlst : $ITMLST_DECL(ITEMS=1); $ITMLST_INIT(ITMLST=lnmlst, (ITMCOD=LNM$_STRING, BUFADR=lnmbuf, BUFSIZ=%ALLOCATION(lnmbuf), RETLEN=lnmlen));< tmp_status = $TRNLNM (TABNAM = %ASCID'LNM$DCL_LOGICAL',/ LOGNAM = %ASCID'MADGOAT_FTP_WINDOW_SIZE', ITMLST = lnmlst); IF (.tmp_status) THEN BEGIN; EXTERNAL ROUTINE OTS$CVT_TU_L : ADDRESSING_MODE(GENERAL);7 LOCAL buff_d : $BBLOCK[DSC$K_S_BLN], new_buffer_size;" buff_d [DSC$W_LENGTH] = .lnmlen;' buff_d [DSC$B_DTYPE] = DSC$K_DTYPE_T;' buff_d [DSC$B_CLASS] = DSC$K_CLASS_S;" buff_d [DSC$A_POINTER] = lnmbuf;5 tmp_status = OTS$CVT_TU_L(buff_d, new_buffer_size);7 IF (.tmp_status) THEN buffer_size = .new_buffer_size; END;9 tmp_status = SS$_NORMAL; !Make sure status is normal END; IF (.tmp_status) THENF tmp_status2 = NETLIB_SETSOCKOPT(ctx, %REF(NETLIB_K_LEVEL_SOCKET), %REF(NETLIB_K_OPTION_SNDBUF)," buffer_size, %REF(4), 0, 0, 0); IF (.tmp_status2) THENF tmp_status2 = NETLIB_SETSOCKOPT(ctx, %REF(NETLIB_K_LEVEL_SOCKET), %REF(NETLIB_K_OPTION_RCVBUF)," buffer_size, %REF(4), 0, 0, 0); !9 ! If passive mode, go ahead and establish the listener. !" IF NOT(notpass) AND (.tmp_status) THEN BEGIN* LOCAL tmp_threads : INITIAL(threads);3 tmp_status = NETLIB_LISTEN (ctx, tmp_threads); END;%! IF (port GTRU 0 AND port LSSU 1024)! THEN toggle_priv(0, 0, 0); toggle_priv(0,0,0); .tmp_status END%, !End of netlib_bind= netlib_lib_get_address( !Look up the IP addrs for host ctx, !A local socket host, !The host name" alsize, !Size of address list) alist, !Address of a longword vector+ alcount)= !Longword to receive the # of !...addresses returned BEGIN IF (.ctx EQLU 0) THEN NETLIB_SOCKET (ctx);< netlib_name_to_address (ctx, !Get the list of IP addresses %REF(NETLIB_K_LOOKUP_DNS), host, alist, alsize, alcount)% END%, !End of netlib_get_address< netlib_lib_addr_to_name( !Look up the name for an addr ctx, !A local socket addr, !The IP address( name)= !Address of a dynamic string" !...desc to receive the name BEGIN LOCAL tmp_addr : INITIAL(addr); IF (.ctx EQLU 0) THEN NETLIB_SOCKET (ctx);8 netlib_address_to_name(ctx, !Translate the IP address  %REF(NETLIB_K_LOOKUP_DNS),, tmp_addr, %REF(INADDR_S_INADDRDEF), name)& END%, !End of netlib_addr_to_name5 netlib_lib_deassign( !Dispose of a local socket! ctx)= !Identifies the socket BEGIN IF (.ctx NEQU 0) THEN0 netlib_close(ctx) !Get rid of this socket ELSE SS$_NORMAL" END%, !End of netlib_deassign2 netlib_lib_get_info( !Get socket information& ctx, !Identifies the local socket+ remadr, !Addr of a longword to receive !...the remote IP address- remport=0, !Addr of a longword to receive !...the remote port #, lcladr=0, !Addr of a longword to receive !...the local IP address. lclport=0)= !Addr of a longword to receive !...the local port # BEGIN! LOCAL temp_status, sin : SINDEF; !H ! Get the information for the remote host and return what's requested. !A temp_status = netlib_getpeername (ctx, sin, %REF(SIN_S_SINDEF)); IF (.temp_status) THEN BEGIN remadr = .sin [SIN_X_ADDR]; IF (remport NEQU 0) THEN remport = .sin [SIN_W_PORT]; END; !G ! Get the information for the local host and return what's requested. !A temp_status = netlib_getsockname (ctx, sin, %REF(SIN_S_SINDEF)); IF (.temp_status) THEN BEGIN IF (lcladr NEQU 0) THEN lcladr = .sin [SIN_X_ADDR]; IF (lclport NEQU 0) THEN lclport = .sin [SIN_W_PORT]; END; .temp_status" END%, !End of netlib_get_info; netlib_lib_get_hostname( !Look up the local host name' name, !Addr of a string descriptor !...to receive the name- length=0)= !Addr of a longword to receive !...the name length BEGIN< netlib_get_hostname(name, length) !Get the local host name& END%, !End of netlib_get_hostname4 netlib_lib_connect( !Connect via TCP protocol& ctx, !Identifies the local socket) node, !The node name (by descriptor) port)= !The remote port # BEGIN REGISTER tmp_status; LOCAL tmp_port; tmp_port = port;$ IF (port GTRU 0 AND port LSSU 1024), THEN toggle_priv(0, 1, 0); !Turn on PHY_IO IF (.ctx EQLU 0) THEN NETLIB_SOCKET (ctx);K tmp_status = NETLIB_CONNECT_BY_NAME(ctx, node, !Connect to the remote host tmp_port);$ IF (port GTRU 0 AND port LSSU 1024) THEN toggle_priv(0, 0, 0); .tmp_status! END%, !End of netlib_connect> netlib_lib_connect_addr( !Connect by addr (TCP protocol)& ctx, !Identifies the local socket! addr, !The remote IP address port)= !The remote port # BEGIN REGISTER tmp_status; LOCAL sin : SINDEF;$ IF (port GTRU 0 AND port LSSU 1024), THEN toggle_priv(0, 1, 0); !Turn on PHY_IO( CH$FILL (%CHAR (0), SIN_S_SINDEF, sin);' sin [SIN_W_FAMILY] = NETLIB_K_AF_INET; IF (port NEQU 0) THEN BEGIN LOCAL tmp_port; tmp_port = port;4 sin [SIN_W_PORT] = NETLIB_HTON_WORD (tmp_port); END; sin [SIN_X_ADDR] = .addr; IF (.ctx EQLU 0) THEN NETLIB_SOCKET (ctx);= tmp_status = NETLIB_CONNECT( !Connect to the remote IP addr! ctx, sin, %REF(SIN_S_SINDEF));$ IF (port GTRU 0 AND port LSSU 1024) THEN toggle_priv(0, 0, 0); .tmp_status& END%, !End of netlib_connect_addr2 /lH MGFTP026.GtQ IGFTP.SOURCE]NETLIB.R32;54K0  netlib_lib_accept( !Accept a TCP connection lsnr, !Listener socket ctx, !Connection socket- remaddr=0, !Remote address structure addr2 remaddr_size=0, !Size of remote addr structure iosb=0, !I/O status block+ astadr=0, !Address of the AST rtn to be" !...executed upon completion+ astprm=0)= !A parameter to be passed to !...the AST routine BEGIN REGISTER tmp_status;( toggle_priv(1, 0, 0); !Turn on SYSPRV' tmp_status = NETLIB_ACCEPT (lsnr, ctx, remaddr, remaddr_size, 0, iosb, astadr, astprm); toggle_priv(0, 0, 0); .tmp_status END%, !End of netlib_accept< netlib_lib_disconnect( !Close this socket's connection! ctx)= !Identifies the socket BEGIN LOCAL _status; _status = (IF (.ctx NEQU 0)5 THEN NETLIB_SHUTDOWN (ctx) !Close the connection ELSE SS$_NORMAL);> IF (._status EQLU SS$_LINKDISCON) !LINKDISCON is an OK status? OR (._status EQLU SS$_TIMEOUT) !... (and so is SS$_TIMEOUT) THEN !... for CMU SS$_NORMAL ELSE ._status$ END%, !End of netlib_disconnect6 netlib_lib_send( !Send data to a TCP connection& ctx, !Identifies the local socket' str, !Data to send (by descriptor)$ push=0, !Equivalent to IO$M_NOW) add_crlf=0, !Add to the line iosb=0, !I/O status block* astadr=0, !Address of an AST rtn to be" !...executed upon completion+ astprm=0)= !A parameter to be passed to !...the AST routine BEGIN IF iosb EQL 0 THEN? %IF add_crlf %THEN NETLIB_WRITELINE %ELSE NETLIB_WRITE %FI (ctx, str) ELSE %IF add_crlf& %THEN NETLIB_WRITELINE (ctx, str,, %ELSE NETLIB_WRITE (ctx, str, 0, 0, %FI iosb, astadr, astprm) END%, !End of netlib_send netlib_lib_setbufsizes( ctx, value)= BEGIN LOCAL x;8 x = NETLIB_SETSOCKOPT(ctx, %REF(NETLIB_K_LEVEL_SOCKET), %REF(NETLIB_K_OPTION_SNDBUF)," %REF(17500), %REF(4), 0, 0, 0); IF (.x) THEN< x = NETLIB_SETSOCKOPT(ctx, %REF(NETLIB_K_LEVEL_SOCKET), %REF(NETLIB_K_OPTION_RCVBUF)," %REF(17500), %REF(4), 0, 0, 0); .x END%, netlib_lib_setsockopt( ctx, level=NETLIB_K_LEVEL_SOCKET, option, value, vallen, iosb=0,astadr=0,astprm=0)= BEGINI NETLIB_SETSOCKOPT(ctx, level, option, value, vallen, iosb,astadr,astprm) END%,9 netlib_lib_receive( !Receive data from a TCP conn.& ctx, !Identifies the local socket( str, !Dynamic descriptor to receive !...the data read iosb=0, !I/O status block* astadr=0, !Address of an AST rtn to be" !...executed upon completion* astprm=0, !A parameter to be passed to !...the AST routine4 timeout=default_timeout)= !VMS quadword time value BEGIN? NETLIB_READ (ctx, str, 0, 0, 0, timeout, iosb, astadr, astprm)! END%, !End of netlib_receive9 netlib_lib_get_line( !Read a line of text ending in !...CR/LF& ctx, !Identifies the local socket( str, !Dynamic descriptor to receive !...the line read iosb=0, !I/O status block* astadr=0, !Address of an AST rtn to be" !...executed upon completion* astprm=0, !A parameter to be passed to !...the AST routine4 timeout=default_timeout)= !VMS quadword time value BEGIN@ NETLIB_READLINE (ctx, str, 0, 0, timeout, iosb, astadr, astprm)" END%; !End of netlib_get_line !'! Below are the macros for NETLIB V1.x!%ELSEMACRO byte_swap (x) = BEGIN LOCAL __x : WORD; BIND _x = __x : VECTOR[2,BYTE]; __x = x;7 ._x[0] * 256 + ._x[1] !Evaluate to byte-swapped port" END%; !End of macro byte_swap KEYWORDMACRO0 netlib_lib_assign( !Create a local socket$ ctx)= !Address of a longword to !...receive the address of !...a context structure BEGIN8 EXTERNAL ROUTINE net_assign : ADDRESSING_MODE(GENERAL),0 toggle_priv : ADDRESSING_MODE(LONG_RELATIVE); REGISTER tmp_status;) toggle_priv(0, 0, 1); !Turn on NETMBX4 tmp_status = net_assign(ctx); !Call the netlib rtn toggle_priv(0, 0, 0); .tmp_status END%, !End of netlib_assign, netlib_lib_bind( !Bind a local socket ctx, !Identifies the socket+ protocol=NET_K_TCP, !Assume TCP protocolB port=0, !Local port #* threads=0, !Size of the listener queue% notpass=0)= !This isn't a passive  !...(accept) socket  BEGIN6 EXTERNAL ROUTINE net_bind : ADDRESSING_MODE(GENERAL),0 toggle_priv : ADDRESSING_MODE(LONG_RELATIVE); REGISTER tmp_status;r$ IF (port GTRU 0 AND port LSSU 1024), THEN toggle_priv(1, 0, 0); !Turn on SYSPRV@ tmp_status = net_bind(ctx, protocol, !Bind the protocol to this port, threads, !...sockete notpass);l$ IF (port GTRU 0 AND port LSSU 1024) THEN toggle_priv(0, 0, 0);e .tmp_status END%, !End of netlib_bind= netlib_lib_get_address( !Look up the IP addrs for hostM ctx, !A local socketo host, !The host nameM" alsize, !Size of address list) alist, !Address of a longword vector+ alcount)= !Longword to receive the # of  !...addresses returned BEGIN= EXTERNAL ROUTINE net_get_address : ADDRESSING_MODE(GENERAL);rA net_get_address(ctx, host, alsize, !Get the list of IP addressese alist, alcount)% END%, !End of netlib_get_addressA< netlib_lib_addr_to_name( !Look up the name for an addr ctx, !A local sockett addr, !The IP address( name)= !Address of a dynamic string" !...desc to receive the name BEGIN> EXTERNAL ROUTINE net_addr_to_name : ADDRESSING_MODE(GENERAL);< net_addr_to_name(ctx, addr, name) !Translate the IP address& END%, !End of netlib_addr_to_name6 netlib_lib_deassign( !Dispose of a local socket! ctx)= !Identifies the socket  BEGIN: EXTERNAL ROUTINE net_deassign : ADDRESSING_MODE(GENERAL);, net_deassign(ctx) !Get rid of this socket" END%, !End of netlib_deassign3 netlib_lib_get_info( !Get socket informationo& ctx, !Identifies the local socket+ remadr, !Addr of a longword to receivei !...the remote IP address- remport=0, !Addr of a longword to receive  !...the remote port #p, lcladr=0, !Addr of a longword to receive !...the local IP address. lclport=0)= !Addr of a longword to receive !...the local port # BEGIN: EXTERNAL ROUTINE net_get_info : ADDRESSING_MODE(GENERAL); LOCAL temp_status : LONG,t temp_remport : LONG, temp_lcladr : LONG,e temp_lclport : LONG;9 temp_status = net_get_info( !Look up the requested infot& ctx, remadr, !...about this socket, temp_remport, temp_lcladr, temp_lclport); IF .temp_status( THEN BEGIN !Copy the values returned. IF remport NEQ 0 !Remote port requested- THEN remport = byte_swap(.temp_remport);/ IF lcladr NEQ 0 !Local address requesteda THEN lcladr = .temp_lcladr;- IF lclport NEQ 0 !Local port requested- THEN lclport = byte_swap(.temp_lclport);N$ END; !End of got socket info .temp_status2" END%, !End of netlib_get_info; netlib_lib_get_hostname( !Look up the local host nameh' name, !Addr of a string descriptora !...to receive the name - length=0)= !Addr of a longword to receive  !...the name lengtht BEGIN> EXTERNAL ROUTINE net_get_hostname : ADDRESSING_MODE(GENERAL);9 net_get_hostname(name, length) !Get the local host named& END%, !End of netlib_get_hostname4 netlib_lib_connect( !Connect via TCP protocol& ctx, !Identifies the local socket) node, !Th+ MGFTP026.GtQ IGFTP.SOURCE]NETLIB.R32;54K0 (e node name (by descriptor)O port)= !The remote port # BEGIN9 EXTERNAL ROUTINE tcp_connect : ADDRESSING_MODE(GENERAL), 0 toggle_priv : ADDRESSING_MODE(LONG_RELATIVE); REGISTER tmp_status;$ IF (port GTRU 0 AND port LSSU 1024), THEN toggle_priv(0, 1, 0); !Turn on PHY_IO@ tmp_status = tcp_connect(ctx, node, !Connect to the remote host port);$ IF (port GTRU 0 AND port LSSU 1024) THEN toggle_priv(0, 0, 0);D .tmp_status! END%, !End of netlib_connect_> netlib_lib_connect_addr( !Connect by addr (TCP protocol)& ctx, !Identifies the local socket! addr, !The remote IP addressC port)= !The remote port # BEGIN> EXTERNAL ROUTINE tcp_connect_addr : ADDRESSING_MODE(GENERAL),0 toggle_priv : ADDRESSING_MODE(LONG_RELATIVE); REGISTER tmp_status;($ IF (port GTRU 0 AND port LSSU 1024), THEN toggle_priv(0, 1, 0); !Turn on PHY_IO? tmp_status = tcp_connect_addr( !Connect to the remote IP addr ctx, addr, port);$ IF (port GTRU 0 AND port LSSU 1024) THEN toggle_priv(0, 0, 0);E .tmp_status& END%, !End of netlib_connect_addr2 netlib_lib_accept( !Accept a TCP connection lsnr, !Listener socketM ctx, !Connection socket iosb=0, !I/O status block+ astadr=0, !Address of the AST rtn to beN" !...executed upon completion+ astprm=0)= !A parameter to be passed toE !...the AST routine  BEGIN8 EXTERNAL ROUTINE tcp_accept : ADDRESSING_MODE(GENERAL),0 toggle_priv : ADDRESSING_MODE(LONG_RELATIVE); REGISTER tmp_status; ( toggle_priv(1, 0, 0); !Turn on SYSPRV@ tmp_status = tcp_accept(lsnr, ctx, !Listen for a connection and0 iosb, astadr, !...accept the first available astprm); toggle_priv(0, 0, 0); .tmp_status END%, !End of netlib_accept= netlib_lib_disconnect( !Close this socket's connection ! ctx)= !Identifies the socketN BEGIN< EXTERNAL ROUTINE tcp_disconnect : ADDRESSING_MODE(GENERAL);, tcp_disconnect(ctx) !Close the connection$ END%, !End of netlib_disconnect6 netlib_lib_send( !Send data to a TCP connection& ctx, !Identifies the local socket' str, !Data to send (by descriptor)1$ push=0, !Equivalent to IO$M_NOW) add_crlf=0, !Add to the linel iosb=0, !I/O status block* astadr=0, !Address of an AST rtn to be" !...executed upon completion+ astprm=0)= !A parameter to be passed toU !...the AST routine  BEGIN6 EXTERNAL ROUTINE tcp_send : ADDRESSING_MODE(GENERAL); IF iosb EQL 0) THEN tcp_send(ctx, str, !Send the dataT6 %IF push %THEN NET_M_PUSH %ELSE 0 %FI+ !Build flags7 %IF add_crlf %THEN 0 %ELSE NET_M_NOTRM %FI) !argumentA) ELSE tcp_send(ctx, str, !Send the data 6 %IF push %THEN NET_M_PUSH %ELSE 0 %FI+ !Build flags7 %IF add_crlf %THEN 0 %ELSE NET_M_NOTRM %FI, !argumentB iosb, astadr, astprm)S END%, !End of netlib_send9 netlib_lib_receive( !Receive data from a TCP conn.l& ctx, !Identifies the local socket( str, !Dynamic descriptor to receive !...the data readD iosb=0, !I/O status block* astadr=0, !Address of an AST rtn to be" !...executed upon completion* astprm=0, !A parameter to be passed to !...the AST routine4 timeout=default_timeout)= !VMS quadword time value BEGIN9 EXTERNAL ROUTINE tcp_receive : ADDRESSING_MODE(GENERAL);(@ tcp_receive(ctx, str, iosb, astadr, !Read from a TCP connection astprm, timeout)! END%, !End of netlib_receiveP: netlib_lib_get_line( !Read a line of text ending in !...CR/LF$& ctx, !Identifies the local socket( str, !Dynamic descriptor to receive !...the line readr iosb=0, !I/O status block* astadr=0, !Address of an AST rtn to be" !...executed upon completion* astprm=0, !A parameter to be passed to !...the AST routineF4 timeout=default_timeout)= !VMS quadword time value BEGIN: EXTERNAL ROUTINE tcp_get_line : ADDRESSING_MODE(GENERAL);= tcp_get_line(ctx, str, iosb, astadr, !Read a line from a TCPO" astprm, timeout) !...connection" END%; !End of netlib_get_line%FI! ! If passive mode, go ahead and establish the listener. !" IF NOT(notpass) AND (.tmp_status) THEN BEGIN* LOCAL tmp_threads : INITIAL(threads);3 tmp_status = NETLIB_LISTEN (ctx, tmp_threads); END;%! IF (port GTRU 0 AND port LSSU 1024)! THEN toggle_priv(0, 0, 0); toggle_priv(0,0,0); .tmp_status END%, !End of netlib_bind= netlib_lib_get_address( !Look up the IP addrs for host ctx, !A local s*[MGFTP.SOURCE]NETLIBDEF.R32;5+,U . / 4@ p-I0123KPWO 56\ӻr7s89/RFÞGHJ !++! NETLIBDEF.R32! -! Definitions for use with NETLIB routines.! =! COPYRIGHT 1994, MADGOAT SOFTWARE. ALL RIGHTS RESERVED.! ! MODIFICATION HISTORY:! 7! 04-NOV-1994 Madison Initial coding (for V2.0).!--LITERAL! NETLIB_K_TYPE_STREAM = 1,! NETLIB_K_TYPE_DGRAM = 2,$ NETLIB_K_OPTION_REUSEADDR = 4,$ NETLIB_K_OPTION_KEEPALIVE = 8,% NETLIB_K_OPTION_BROADCAST = 32,& NETLIB_K_OPTION_SNDBUF = %X'1001',& NETLIB_K_OPTION_RCVBUF = %X'1002',+ NETLIB_K_OPTION_SNDLOWAT = %X'1003',+ NETLIB_K_OPTION_RCVLOWAT = %X'1004',% NETLIB_K_LEVEL_SOCKET = %X'FFFF', NETLIB_K_AF_INET = 2, NETLIB_K_LOOKUP_DNS = 1,$ NETLIB_K_LOOKUP_HOST_TABLE = 2,$ NETLIB_K_SHUTDOWN_RECEIVER = 0,$ NETLIB_K_SHUTDOWN_SENDER = 1, NETLIB_K_SHUTDOWN_BOTH = 2;LITERAL NETLIB_M_ALLOW_LF = 1;LITERAL NETLIB_M_DOMAIN_SEARCH = 1, NETLIB_M_NO_RECURSION = 2;LITERAL" NETLIB_K_DNS_TYPE_A = %X'01'," NETLIB_K_DNS_TYPE_NS = %X'02'," NETLIB_K_DNS_TYPE_MD = %X'03'," NETLIB_K_DNS_TYPE_MF = %X'04',% NETLIB_K_DNS_TYPE_CNAME = %X'05',# NETLIB_K_DNS_TYPE_SOA = %X'06'," NETLIB_K_DNS_TYPE_MB = %X'07'," NETLIB_K_DNS_TYPE_MG = %X'08'," NETLIB_K_DNS_TYPE_MR = %X'09',$ NETLIB_K_DNS_TYPE_NULL = %X'0A',# NETLIB_K_DNS_TYPE_WKS = %X'0B',# NETLIB_K_DNS_TYPE_PTR = %X'0C',% NETLIB_K_DNS_TYPE_HINFO = %X'0D',% NETLIB_K_DNS_TYPE_MINFO = %X'0E'," NETLIB_K_DNS_TYPE_MX = %X'0F',# NETLIB_K_DNS_TYPE_TXT = %X'10',$ NETLIB_K_DNS_QTYPE_ALL = %X'FF',# NETLIB_K_DNS_CLASS_IN = %X'01',# NETLIB_K_DNS_CLASS_CS = %X'02',# NETLIB_K_DNS_CLASS_CH = %X'03',# NETLIB_K_DNS_CLASS_HS = %X'04',% NETLIB_K_DNS_QCLASS_ALL = %X'FF', NETLIB_K_DNS_OP_STDQ = 0, NETLIB_K_DNS_OP_INVQ = 1, NETLIB_K_DNS_OP_STATUS = 2, NETLIB_K_DNS_RC_SUCCESS = 0, NETLIB_K_DNS_RC_FMTERR = 1, NETLIB_K_DNS_RC_SRVFAIL = 2, NETLIB_K_DNS_RC_NAMERR = 3, NETLIB_K_DNS_RC_NOTIMP = 4, NETLIB_K_DNS_RC_REFUSE = 5;LITERAL DNS_S_HEADER = 12;MACRO% DNS_W_QUERYID = 0,0,16,0%,% DNS_W_FLAGS = 2,0,16,0%,' DNS_V_RECURSION_DESIRED = 2,0,1,0%,$ DNS_V_TRUNCATED = 2,1,1,0%,' DNS_V_AUTHORITATIVE = 2,2,1,0%,$ DNS_V_OPCODE = 2,3,4,0%,$ DNS_V_REPLY = 2,7,1,0%,$ DNS_V_REPLY_CODE = 2,8,4,0%,* DNS_V_RECURSION_AVAILABLE = 2,r MGFTP026.GU I[MGFTP.SOURCE]NETLIBDEF.R32;5@ }|15,1,0%,% DNS_W_QDCOUNT = 4,0,16,0%,% DNS_W_ANCOUNT = 6,0,16,0%,% DNS_W_NSCOUNT = 8,0,16,0%,& DNS_W_ARCOUNT = 10,0,16,0%,7 NETLIB_DNS_HEADER = BLOCK [DNS_S_HEADER,BYTE]%;LITERAL! SOCKADDR_S_SOCKADDRDEF = 16, SOCKADDR_S_DATA = 14;MACRO& SOCKADDR_W_FAMILY = 0,0,16,0%,$ SOCKADDR_X_DATA = 2,0,0,0%,@ SOCKADDRDEF = BLOCK [SOCKADDR_S_SOCKADDRDEF,BYTE]%;LITERAL INADDR_S_INADDRDEF = 4;MACRO% INADDR_L_ADDR = 0,0,32,0%,: INADDRDEF = BLOCK [INADDR_S_INADDRDEF,BYTE]%;LITERAL SIN_S_SINDEF = 16, SIN_S_MBZ = 8;MACRO% SIN_W_FAMILY = 0,0,16,0%,$ SIN_W_PORT = 2,0,16,0%,$ SIN_X_ADDR = 4,0,32,0%," SIN_X_MBZ = 8,0,0,0%,3 SINDEF = BLOCK [SIN_S_SINDEF,BYTE]%;LITERAL IOSB_S_IOSBDEF = 8;MACRO% IOSB_W_STATUS = 0,0,16,0%,% IOSB_W_COUNT = 2,0,16,0%,% IOSB_L_UNUSED = 4,0,32,0%,5 IOSBDEF = BLOCK [IOSB_S_IOSBDEF,BYTE]%;LITERAL MXRR_S_MXRRDEF = 136, MXRR_S_NAME = 128," NETLIB_S_MXRR_NAME = 128;MACRO& MXRR_L_PREFERENCE = 0,0,32,0%,% MXRR_L_LENGTH = 4,0,32,0%,$ MXRR_T_NAME = 8,0,0,0%,5 MXRRDEF = BLOCK [MXRR_S_MXRRDEF,BYTE]%;!+)! Definitions for V1 NETLIB - OBSOLETE!!-LITERAL NET_K_TCP = 1, NET_K_UDP = 2, NET_M_PUSH = 1, NET_M_NOTRM = 2;MACRO NET_V_PUSH = 0,0,1,0%, NET_V_NOTRM = 0,1,1,0%;!*[MGFTP.SOURCE]STR_LOWERCASE.R32;1+,./ 468-I0123KPWO56YvA#7NfA#89/RFÞGHJ MACRO6 str_lowercase (dest) = !Convert string to lowercase BEGIN !... in place LOCAL __destptr : REF $BBLOCK, __destlen, __c;4 __destptr = .dest[DSC$A_POINTER]; !Point to string. __destlen = .dest[DSC$W_LENGTH]; !Get length4 WHILE (.__destlen NEQU 0) DO !Step through string BEGIN! __c = CH$RCHAR(.__destptr);. IF (.__c GEQU %C'A' AND .__c LEQU %C'Z') THEN$ CH$WCHAR_A (.__c + 32, __destptr) ELSE __destptr = .__destptr + 1;! __destlen = .__destlen - 1; END; END %;*[MGFTP.SOURCE]TEXT.R32;1+,gJ./ 4<-I0123KPWO56U !ӗ7YI89/RFÞGHJ ! MadGoat FTP client and server<! Copyright 1994, MadGoat Software. All rights reserved.!++ ! TEXT.R32!! Description:!;! This file contains a macro to replace the text_fao_append ! routine.! ! Written by:"! Darrell Burkhead WKU 23-Apr-1993!!Modifications:!!--LIBRARY 'SYS$LIBRARY:STARLET';%MACRO text_fao_append(txt_a, ctrstr)= BEGIN EXTERNAL ROUTINE/ text_append : ADDRESSING_MODE(LONG_RELATIVE); LOCAL$ out_buffer : VECTOR[512, BYTE],, out_desc : $BBLOCK[DSC$K_S_BLN] PRESET(, [DSC$W_LENGTH] = %ALLOCATION(out_buffer),! [DSC$B_DTYPE] = DSC$K_DTYPE_T,! [DSC$B_CLASS] = DSC$K_CLASS_S,! [DSC$A_POINTER] = out_buffer), tmp_status;- tmp_status = $FAO(ctrstr, out_desc, out_desc4 %IF NOT %NULL(%REMAINING) %THEN ,%REMAINING %FI);- IF NOT .tmp_status THEN SIGNAL(.tmp_status);6 text_append(txt_a, out_buffer); !Errors are signaled SS$_NORMAL !Return success( END%; !End of macro text_fao_append*[MGFTP.SOURCE]TPA.R32;1+,jJ./ 4F-I0123KPWO56:f!ӗ7+,I89/RFÞGHJ ! MadGoat FTP client and server<! Copyright 1994, MadGoat Software. All rights reserved.!F! Macros to support LIB$TPARSE on the VAX and LIB$TABLE_PARSE on AXP.!E! Written by Matt Madison for MX and used for FTP by Hunter Goatley.!%IF %BLISS(BLISS32E) %THEN( MACRO LIB$TPARSE = LIB$TABLE_PARSE%;%FI MACRO% TPA_ROUTINE (NAME, ARGLST) =# %IF %BLISS(BLISS32E) %THEN. %IF NOT %DECLARED (TPA_ARGCNT) %THEN+ COMPILETIME TPA_ARGCNT=0; %FI %ASSIGN(TPA_ARGCNT, 0)5 ROUTINE NAME (STATE : REF VECTOR [,LONG]) = BEGIN BIND3 TPA_ROUTINE_ARGS (%REMOVE (ARGLST)); %ELSE+ ROUTINE NAME (%REMOVE (ARGLST)) = BEGIN %FI%,! TPA_ROUTINE_ARGS [ARG] =, %ASSIGN (TPA_ARGCNT, TPA_ARGCNT+1)" ARG = STATE [TPA_ARGCNT] %;*[MGFTP.SOURCE]VERSION.R32;42+,V./ 4 -I0123KPWO56<]`7%{`89GHJMACRO FTP_VERSION = 'V2.6-5'%;ƥ MGFTP026.G#I[MGFTP.SOURCE]DESCRIP.MMS;26Q3)*[MGFTP.SOURCE]DESCRIP.MMS;26+,#./ 4Q|-I0123KPWO56 ߅q7-q89/RFÞGHJ!++G! DESCRIP.MMS Copyright 1994, MadGoat Software. All rights reserved.!! Description:!D! An MMS file describing module dependencies for MadGoat FTP client,! server, and listener.!/! Written By: Darrell Burkhead October 22, 1993!! Modifications:!*! V2.0 Darrell Burkhead 22-OCT-1993 13:277! Remove UCX-specific and CMU-specific information and#! revamped to compile with NETLIB.!--.IFDEF __MADGOAT_BUILD__MG_NOV5LINK = TRUEMG_NOV1LINK = TRUEMG_FACILITY = MGFTPKITNAME = MGFTP.ZIPPRIMARY_TARGET = ALL.INCLUDE MG_TOOLS:HEADER.MMS.ELSEETCDIR =KITDIR =SRCDIR = SYS$DISK:[]BINDIR =.ENDIF.IFDEF __MMK_V32__.IFDEF __AXP__ ARCH = ALPHA L32 = .L32E.ELSE ARCH = VAX L32 = .L32.ENDIF.IFDEF __MADGOAT_BUILD__.ELSE!BINDIR = SYS$DISK:[-.BIN-$(ARCH)].FIRST@ @ IF F$PARSE("$(BINDIR)") .EQS. "" THEN CREATE/DIR $(BINDIR)$ @ DEFINE/NOLOG BIN_DIR $(BINDIR){}.C{$(BINDIR)}.OBJ :{}.MSG{$(BINDIR)}.OBJ :{}.CLD{$(BINDIR)}.OBJ :{}.MAR{$(BINDIR)}.OBJ :.ENDIF.ENDIF ! not MMK V3.2 or later.SUFFIXES .L32E .R32.L32E:* BLISS/LIBRARY=$(MMS$TARGET) $(MMS$SOURCE).IFDEF __ALPHA__MAP = .ALPHA_MAPBDEBUG = /DEBUG/NOOPTIMIZESYSEXE = /SYSEXEHPWD =.FIRST" DEFINE SYS$LIBRARY ALPHA$LIBRARY:.ELSE&SYSEXE = ,SYS$SYSTEM:SYS.STB/SELECTIVE BDEBUG = /DEBUG/OPTIMIZE=LEVEL=0 HPWD = HPWD=$(BINDIR)HPWD$(OBJ),.ENDIF.IFDEF __DEBUG__DEBUG = $(BDEBUG)LDEBUG = /DEBUG.ELSEDEBUG = /NOTRACE/NODEBUGLDEBUG = /NOTRACE/NODEBUG.ENDIFBFLAGS = $(BFLAGS) $(DEBUG)!LINKFLAGS = $(LINKFLAGS)$(LDEBUG) .IFDEF VMSVER&LIBDIR = VMS$LIBS:[VMS_$(VMSVER)_LIB].IFDEF __ALPHA__ .B32.OBJ :% DEFINE/USER SYS$LIBRARY $(LIBDIR)# $(BLISS)$(BFLAGS) $(MMS$SOURCE)3LINK_LOG1 = DEFINE/USER ALPHA$LIBRARY $(LIBDIR);LINK_LOG2 = DEFINE/USER ALPHA$LOADABLE_IMAGES $(LIBDIR).FIRST& DEFINE ALPHA$LIBRARY $(LIBDIR).ELSE .B32.OBJ :% DEFINE/USER SYS$LIBRARY $(LIBDIR)# $(BLISS)$(BFLAGS) $(MMS$SOURCE)(SYSEXE = ,$(LIBDIR)SYS.STB/SELECT1LINK_LOG1 = DEFINE/USER SYS$LIBRARY $(LIBDIR) LINK_LOG2 =.ENDIF .ELSE !VMSVER is *not* definedDLIBDIR = SYS$SYSTEM: !Default for SYS_SYMBOLS.OPT LINK_LOG1 = LINK_LOG2 =.ENDIF6ALL : $(BINDIR)FTP$(EXE), $(BINDIR)FTP_SERVER$(EXE), - $(BINDIR)FTP_LISTENER$(EXE)) !MadGoat FTP has been successfully built$FTP_OBJS = FTP=$(BINDIR)FTP$(OBJ), -= COPY_DIR_FTP_SUPPORT=$(BINDIR)COPY_DIR_FTP_SUPPORT$(OBJ), -) FTP_CMD_TABLE=$(BINDIR)FTP_CMD$(OBJ), -' FTP_PARSE=$(BINDIR)FTP_PARSE$(OBJ), -7 FTP_PARSE_NO_HOST=$(BINDIR)FTP_PARSE_NO_HOST$(OBJ), -+ FTP_NETWORK=$(BINDIR)FTP_NETWORK$(OBJ), -) FTP_ROUTINES=$(BINDIR)ROUTINES$(OBJ), -% FTP_HELP=$(BINDIR)FTP_HELP$(OBJ), -0 FTP_UTILITY_MESSAGES=$(BINDIR)FTP_MSG$(OBJ), -% FTP_FILE=$(BINDIR)FTP_FILE$(OBJ), -' FTP_ALIAS=$(BINDIR)FTP_ALIAS$(OBJ), -1 FTP_ALIAS_CMDS=$(BINDIR)FTP_ALIAS_CMDS$(OBJ), -( NET_TO_TEXT=$(BINDIR)FTP_NTOT$(OBJ), -* STRING_ROUTINES=$(BINDIR)STRING$(OBJ), -# PORT_PARSE=$(BINDIR)PORT$(OBJ), -' CONTROL_C=$(BINDIR)CONTROL_C$(OBJ), -' FTP_INPUT=$(BINDIR)FTP_INPUT$(OBJ), -' FTP_QUEUE=$(BINDIR)FTP_QUEUE$(OBJ), -' CONDITION=$(BINDIR)CONDITION$(OBJ), - HASH=$(BINDIR)HASH$(OBJ), -( NET_TO_FILE=$(BINDIR)FTP_NTOF$(OBJ), -( FILE_TO_NET=$(BINDIR)FTP_FTON$(OBJ), -' DIR_TO_NET=$(BINDIR)FTP_DTON$(OBJ), -' FILE_INFO=$(BINDIR)FILE_INFO$(OBJ), - MEMORY=$(BINDIR)MEM$(OBJ), - DIR=$(BINDIR)DIR$(OBJ), - TEXT=$(BINDIR)TEXT$(OBJ), -! NETLIB=$(BINDIR)NETLIB$(OBJ), -& PARSE_PASV=$(BINDIR)PARSE_PASV$(OBJ)6$(BINDIR)FTP$(EXE) : $(BINDIR)FTP$(OLB)($(FTP_OBJS)),- SYS$DISK:[]NETLIB.OPT $(LINK_LOG1) $(LINK_LOG2)> $(LINK) $(LINKFLAGS) $(BINDIR)FTP$(OLB)/LIBRARY/INCLUDE=FTP,- SYS$DISK:[]NETLIB.OPT/OPTFTP_SERVER_OBJS = -) FTP_SERVER=$(BINDIR)FTP_SERVER$(OBJ), -3 FTP_SERVER_CMDS=$(BINDIR)FTP_SERVER_CMDS$(OBJ), -' DIR_TO_NET=$(BINDIR)FTP_DTON$(OBJ), -- FTP_ANNOUNCE=$(BINDIR)FTP_ANNOUNCE$(OBJ), -5 FTP_SERVER_PARSE=$(BINDIR)FTP_SERVER_PARSE$(OBJ), -1 FTP_SET_PARAMS=$(BINDIR)FTP_SET_PARAMS$(OBJ), -3 LOG_TO_LISTENER=$(BINDIR)LOG_TO_LISTENER$(OBJ), -( FTP_IN=$(BINDIR)FTP_SERVER_IN$(OBJ), -. FTP_SERVER_MESSAGES=$(BINDIR)FTPSRV$(OBJ), -) FTPIN_PARSE=$(BINDIR)CMD_PARSE$(OBJ), - LOGIN=$(BINDIR)LOGIN$(OBJ), -) PARSE_PORT=$(BINDIR)PARSE_PORT$(OBJ), -) PARSE_TYPE=$(BINDIR)PARSE_TYPE$(OBJ), -) PARSE_STRU=$(BINDIR)PARSE_STRU$(OBJ), -) PARSE_MODE=$(BINDIR)PARSE_MODE$(OBJ), -% FTP_DTOT=$(BINDIR)FTP_DTOT$(OBJ), -+ FTP_HANDLER=$(BINDIR)FTP_HANDLER$(OBJ), - ANON=$(BINDIR)ANON$(OBJ), -( NET_TO_FILE=$(BINDIR)FTP_NTOF$(OBJ), -( FILE_TO_NET=$(BINDIR)FTP_FTON$(OBJ), -' FILE_INFO=$(BINDIR)FILE_INFO$(OBJ), - TEXT=$(BINDIR)TEXT$(OBJ), - MEMORY=$(BINDIR)MEM$(OBJ), - DIR=$(BINDIR)DIR$(OBJ), - NETLIB=$(BINDIR)NETLIB$(OBJ)K$(BINDIR)FTP_SERVER$(EXE) : $(BINDIR)FTP_SERVER$(OLB)($(FTP_SERVER_OBJS)),- SYS$DISK:[]NETLIB.OPT $(LINK_LOG1) $(LINK_LOG2)O $(LINK) $(LINKFLAGS) $(BINDIR)FTP_SERVER$(OLB)/LIBRARY/INCLUDE=(FTP_SERVER), -$ SYS$DISK:[]NETLIB.OPT/OPT $(SYSEXE)FTP_LISTENER_OBJS = -- FTP_LISTENER=$(BINDIR)FTP_LISTENER$(OBJ), -5 FTP_LISTENER_MEM=$(BINDIR)FTP_LISTENER_MEM$(OBJ), -7 FTP_LISTENER_CMDS=$(BINDIR)FTP_LISTENER_CMDS$(OBJ), -- ACTIVITY_LOG=$(BINDIR)ACTIVITY_LOG$(OBJ), -! VMS054=$(BINDIR)VMS054$(OBJ), - $(HPWD) -* FTP_IN=$(BINDIR)FTP_LISTENER_IN$(OBJ), -- FTP_ANNOUNCE=$(BINDIR)FTP_ANNOUNCE$(OBJ), -) PARSE_PORT=$(BINDIR)PARSE_PORT$(OBJ), -) PARSE_TYPE=$(BINDIR)PARSE_TYPE$(OBJ), -) PARSE_STRU=$(BINDIR)PARSE_STRU$(OBJ), -) PARSE_MODE=$(BINDIR)PARSE_MODE$(OBJ), -+ FTP_HANDLER=$(BINDIR)FTP_HANDLER$(OBJ), -. FTP_SERVER_MESSAGES=$(BINDIR)FTPSRV$(OBJ), -) FTPIN_PARSE=$(BINDIR)CMD_PARSE$(OBJ), -# PORT_PARSE=$(BINDIR)PORT$(OBJ), - MEMORY=$(BINDIR)MEM$(OBJ), - TEXT=$(BINDIR)TEXT$(OBJ), - NETLIB=$(BINDIR)NETLIB$(OBJ)$(BINDIR)FTP_LISTENER$(EXE) : -6 $(BINDIR)FTP_LISTENER$(OLB)($(FTP_LISTENER_OBJS)),- SYS$DISK:[]NETLIB.OPT $(LINK_LOG1) $(LINK_LOG2)Q $(LINK) $(LINKFLAGS) $(BINDIR)FTP_LISTENER$(OLB)/LIBRARY/INCLUDE=FTP_LISTENER, - SYS$DISK:[]NETLIB.OPT/OPTSYS$DISK:[]NETLIB.OPT : @ open/write TMP $(MMS$TARGET)) @ write TMP "netlib_shrxfr/share" @ close tmp/FTP_ALIAS$(L32) : FTP_ALIAS.R32, FIELDS$(L32)5FTP_LISTENER$(L32) : FTP_LISTENER.R32, FIELDS$(L32)7FTP_CONN_INFO$(L32) : FTP_CONN_INFO.R32, FIELDS$(L32)*NETLIB$(L32) : NETLIB.R32, FIELDS$(L32)FIELDS$(L32) : FIELDS.R32NETAUX$(L32) : NETAUX.R32ANON_FTP$(L32) : ANON_FTP.R32*FTP_IN$(L32) : FTP_IN.R32, FIELDS$(L32)$FTP$(L32) : FTP.R32, FIELDS$(L32)TEXT$(L32) : TEXT.R32VERSION$(L32) : VERSION.R32=$(BINDIR)FTP_ALIAS$(OBJ) : FTP_ALIAS.B32, FTP_ALIAS$(L32), - FTP_MSG$(L32), NETAUX$(L32)G$(BINDIR)FTP_ALIAS_CMDS$(OBJ) : FTP_ALIAS_CMDS.B32, FTP_ALIAS$(L32), - CLI$(L32), FIELDS$(L32), - FTP_MSG$(L32), NETAUX$(L32)}$: MGFTP026.G#I[MGFTP.SOURCE]DESCRIP.MMS;26Q%B$(BINDIR)LOG_TO_LISTENER$(OBJ) : LOG_TO_LISTENER.B32, NETLIB$(L32)+$(BINDIR)PORT$(OBJ) : PORT.B32, TPA$(L32)6$(BINDIR)FTP_LISTENER_CLD$(OBJ) : FTP_LISTENER_CLD.CLDF$(BINDIR)FTP_LISTENER_CMDS$(OBJ) : FTP_LISTENER_CMDS.B32, FTP$(L32), -" FTPSRV$(L32), FTP_IN$(L32), -( FTP_LISTENER$(L32), NETLIB$(L32), - NETAUX$(L32), VERSION$(L32)F$(BINDIR)FTP_LISTENER$(OBJ) : FTP_LISTENER.B32, FTP_LISTENER$(L32), - NETLIB$(L32), FTP$(L32), - FTP_CONN_INFO$(L32)9$(BINDIR)FTP_LISTENER_MEM$(OBJ) : FTP_LISTENER_MEM.B32, - FTP_LISTENER$(L32), -& NETLIB$(L32), FTP_CONN_INFO$(L32)<$(BINDIR)FTP_SERVER$(OBJ) : FTP_SERVER.B32, NETAUX$(L32), -& NETLIB$(L32), FTP_CONN_INFO$(L32)F$(BINDIR)FTP_SERVER_IN$(OBJ) : FTP_IN.B32, FTP$(L32), FTPSRV$(L32), -$ ANON_FTP$(L32), FTP_IN$(L32), -" NETAUX$(L32), NETLIB$(L32), -' FTP_CONN_INFO$(L32), VERSION$(L32)G$(BINDIR)FTP_LISTENER_IN$(OBJ) : FTP_IN.B32, FTP$(L32), FTPSRV$(L32), -" FTP_IN$(L32), NETAUX$(L32), -( NETLIB$(L32), FTP_LISTENER$(L32), -' FTP_CONN_INFO$(L32), VERSION$(L32)= if "$(VMSVER)".nes."" then define/user sys$library $(LIBDIR)) $(BLISS)/VARIANT $(BFLAGS) $(MMS$SOURCE)B$(BINDIR)FTP_SERVER_CMDS$(OBJ) : FTP_SERVER_CMDS.B32, FTP$(L32), -$ FTPSRV$(L32), ANON_FTP$(L32), -" FTP_IN$(L32), NETAUX$(L32), -& NETLIB$(L32), FTP_CONN_INFO$(L32)A$(BINDIR)PARSE_PORT$(OBJ) : PARSE_PORT.B32, FTP$(L32), TPA$(L32)A$(BINDIR)PARSE_TYPE$(OBJ) : PARSE_TYPE.B32, FTP$(L32), TPA$(L32)A$(BINDIR)PARSE_MODE$(OBJ) : PARSE_MODE.B32, FTP$(L32), TPA$(L32)A$(BINDIR)PARSE_STRU$(OBJ) : PARSE_STRU.B32, FTP$(L32), TPA$(L32)A$(BINDIR)PARSE_PASV$(OBJ) : PARSE_PASV.B32, FTP$(L32), TPA$(L32)B$(BINDIR)FTP_NTOF$(OBJ) : FTP_NTOF.B32, FTP$(L32), FIELDS$(L32) - NETLIB$(L32)C$(BINDIR)FTP_FTON$(OBJ) : FTP_FTON.B32, FTP$(L32), FIELDS$(L32), - NETAUX$(L32), NETLIB$(L32)C$(BINDIR)FTP_NTOT$(OBJ) : FTP_NTOT.B32, FTP$(L32), FIELDS$(L32), - NETLIB$(L32)C$(BINDIR)FTP_DTON$(OBJ) : FTP_DTON.B32, FTP$(L32), FIELDS$(L32), - NETLIB$(L32)@$(BINDIR)FTP_DTOT$(OBJ) : FTP_DTOT.B32, FTP$(L32), FIELDS$(L32);$(BINDIR)FTP_HANDLER$(OBJ) : FTP_HANDLER.B32, FTP$(L32), - FTPSRV$(L32), NETAUX$(L32)B$(BINDIR)FILE_INFO$(OBJ) : FILE_INFO.B32, FTP$(L32), NETAUX$(L32)D$(BINDIR)FTP$(OBJ) : FTP.B32, FTP$(L32), CLI$(L32), FTP_MSG$(L32),-( NETAUX$(L32), FTP_CONN_INFO$(L32), -- NETLIB$(L32), VERSION$(L32), FIELDS$(L32)I$(BINDIR)FTP_NETWORK$(OBJ) : FTP_NETWORK.B32, FTP$(L32), FTP_MSG$(L32), -2 NETLIB$(L32), NETAUX$(L32), FTP_ALIAS$(L32), -" CLI$(L32), FTP_CONN_INFO$(L32)C$(BINDIR)ROUTINES$(OBJ) : ROUTINES.B32, FTP$(L32), FTP_MSG$(L32), -, CLI$(L32), NETAUX$(L32), FTP_ALIAS$(L32)'$(BINDIR)COPY_DIR_FTP_SUPPORT$(OBJ) : -2 COPY_DIR_FTP_SUPPORT.B32, TPA$(L32), CLI$(L32)@$(BINDIR)FTP_HELP$(OBJ) : FTP_HELP.B32, CLI$(L32), FTP_MSG$(L32)C$(BINDIR)FTP_FILE$(OBJ) : FTP_FILE.B32, FTP$(L32), FTP_MSG$(L32), -! NETAUX$(L32), NETLIB$(L32), -" FTP_CONN_INFO$(L32), CLI$(L32)E$(BINDIR)CONDITION$(OBJ) : CONDITION.B32, FTP_MSG$(L32), CLI$(L32), - NETAUX$(L32)<$(BINDIR)HASH$(OBJ) : HASH.B32, FTP_MSG$(L32), FTP$(L32), - NETAUX$(L32), CLI$(L32)?$(BINDIR)LOGIN$(OBJ) : LOGIN.B32, FTPSRV$(L32), ANON_FTP$(L32)6$(BINDIR)FTP_SERVER_PARSE$(OBJ) : FTP_SERVER_PARSE.CLDK$(BINDIR)FTP_SET_PARAMS$(OBJ) : FTP_SET_PARAMS.B32, CLI$(L32), FTP$(L32), - NETAUX$(L32)J$(BINDIR)FTP_ANNOUNCE$(OBJ) : FTP_ANNOUNCE.B32, FTP$(L32), FTPSRV$(L32), - NETAUX$(L32):$(BINDIR)MEM$(OBJ) : MEM.B32, FIELDS$(L32), NETAUX$(L32)B$(BINDIR)FTP_QUEUE$(OBJ) : FTP_QUEUE.B32, FTP$(L32), FIELDS$(L32)8$(BINDIR)CONTROL_C$(OBJ) : CONTROL_C.B32, FTP_MSG$(L32)4$(BINDIR)CMD_PARSE$(OBJ) : CMD_PARSE.B32, TPA$(L32)9$(BINDIR)ANON$(OBJ) : ANON.B32, FTP$(L32), FIELDS$(L32)8$(BINDIR)DIR$(OBJ) : DIR.B32, NETAUX$(L32), TEXT$(L32)%$(BINDIR)FTP_MSG$(OBJ) : FTP_MSG.MSG2$(BINDIR)VMS054$(OBJ) : VMS054.B32, FTPSRV$(L32).$(BINDIR)TEXT$(OBJ) : TEXT.B32, FIELDS$(L32)$$(BINDIR)NETLIB$(OBJ) : NETLIB.B32$$(BINDIR)FTPSRV$(OBJ) : FTPSRV.MSG%$(BINDIR)FTP_CMD$(OBJ) : FTP_CMD.CLD)$(BINDIR)FTP_PARSE$(OBJ) : FTP_PARSE.CLD8$(BINDIR)FTP_PARSE_NO_HOST$(OBJ) : FTP_PARSE_NO_HOST.CLD)$(BINDIR)FTP_QUIET$(OBJ) : FTP_QUIET.CLD6$(BINDIR)FTP_SERVER_PARSE$(OBJ) : FTP_SERVER_PARSE.CLD$$(BINDIR)STRING$(OBJ) : STRING.B327$(BINDIR)FTP_INPUT$(OBJ) : FTP_INPUT.B32, NETAUX$(L32)/$(BINDIR)ACTIVITY_LOG$(OBJ) : ACTIVITY_LOG.B32 $(BINDIR)HPWD$(OBJ) : HPWD.MAR0VERSION.R32 : MG_SRC:[MGFTP]VERSION.OPT @ open/read x $(MMS$SOURCE) @ read x __cmd @ close x @ '__cmd @ define/user sys$input nl: @ create $(MMS$TARGET)! @ open/append x $(MMS$TARGET)3 @ WRITE x "MACRO FTP_VERSION = '", ident, "'%;" @ CLOSE xBACK := BACKUP *.*;/EXCL=(*.*exe,*.*map,*.*obj,*.*olb,*.l32*,*.hlb,-8 *.tmp,*.bck,*.dir) sys$login:current_ftp.bck/save/log SRConly : purge /logA del/log *$(EXE).,*$(obj).,*.map.,*.lis.,*.STB.*,*.ckp.,*$(L32).CLEAN :K delete/log/noconfirm *.*obj;*,*.*exe;*,*.*olb;*,*.l32*;*,*.*MAP;*,*.*LIS;*r MGFTP026.G2zI[MGFTP.SOURCE]FTPSRV.MSG;9^*[MGFTP.SOURCE]FTPSRV.MSG;9+,2z./ 4^(-I0123KPWO56-Tir7f%ir89/RFÞGHJ ! MadGoat FTP client and server!?! Authors: Chad Wilson, Dale Moore, Tod Shannon, Bruce Miller,,! Marc Shannon, Henry Miller, John Clement,1! Matt Madison, Darrell Burkhead, Hunter Goatley!6! Copyright 1986, 1992, Carnegie Mellon University.B! Copyright 1994, 2000, MadGoat Software. All rights reserved.!?! Permission is granted for not-for-profit redistribution,?! provided all source and object code remain unchanged from?! the original distribution, and that all copyright notices! remain intact.!:.TITLE FTP_Server_Messages FTP Error and Warning messages.FACILITY FTP,73/PREFIX=FTP$_.IDENT "V2.6-1"!++:! FTPSrv.MSG Copyright (c) 1986 Carnegie Mellon University!! Description:!"! Error messages for the FTPserver!! Facility: FTP server!! Environment:!8! VAX/VMS operating system, privileged user mode utility! ! Written By:!! Dale Moore CMU-CSD Oct 1985!! Modifications:!+! V2.6-1 Hunter Goatley 16-MAR-2000 00:49! Added FILE_SIZE.!+! V2.5-3 Hunter Goatley 25-MAR-1999 23:43@! Added SYSTEM_TYPE_UNIX for when we're in UNIX-emulation mode.!*! V2.1 Darrell Burkhead 5-AUG-1994 11:17@! Added 3 new 257 replies that do not include the quotes around4! the pathname (for compatibility with HCL eXceed).!,! V1.1-1 Darrell Burkhead 21-OCT-1993 16:59A! Slightly changed the format of OPEN_STARTING and VMS_TRANSFER.!)! V1.1 Hunter Goatley 28-SEP-1993 06:11! Changed ident to "MadGoat".!--.SEVERITY FATAL.SEVERITY ERRORP TIMEOUT /FAO_COUNT=2# FAIL . ABORT ; NO_NET_ACCESS ! 421% PASS_EXP ) DISACNT " CAPTIVE 2 SECOND_PASS ( ACCT_EXP ? UNSUPPORTED_APPENDX * UNSUPPORTED_STRUX * UNSUPPORTED_MODEX * UNSUPPORTED_TYPEX = DIR_FILE - ! 550) EOR_DATA  EOF_DATA C SYS_TOO_BUSY ! 530a. NO_ANON_PASS % REJECT .SEVERITY WARNG UNSUPPORTED_APPEND /FAO_COUNT=1= UNSUPPORTED_STRU /FAO_COUNT=1= UNSUPPORTED_MODE /FAO_COUNT=1= UNSUPPORTED_TYPE /FAO_COUNT=1: INVBYTSIZ /FAO_COUNT=1.SEVERITY INFO3 RESTART_MARKER ! 110F SERVICE_MINUTES /FAO_COUNT=1 ! 120? OPEN_STARTING - /FAO_Count=2 ! 125E FILE_OKAY_STARTING - ! 150A VMS_TRANSFER - /FAO_Count=2 ! 150E UMASK_OKAY /FAO_COUNT=3! 2005 COMMAND_OKAY /FAO_COUNT=2 ! 2003 PORT_OKAY /FAO_COUNT=1 ! 200G SUPERFLUOUS - ! 202- SYSTEM_STATUS /FAO_COUNT=1 ! 2111 DIRECTORY_STATUS ! 212) FILE_STATUS ! 213 FILE_SIZE ! 213/ NUMBER_MESSAGE /FAO_COUNT=1 ! 214< BLOCKSIZE /FAO_COUNT=1 ! 214H TIMEOUT_MESSAGE /FAO_COUNT=1, HELP_MESSAGE /FAO_COUNT=1 ! 214D SYSTEM_TYPE /FAO_COUNT=2! 2157 SERVICE_READY -5 /FAO_COUNT=3 ! 220; SERVICE_CLOSING - ! 221A DATA_OPEN - ! 225E DATA_CLOSING ! 226I ENTERING_PASSIVE - /FAO=6 ! 227@ USER_LOGGED_IN - /FAO_COUNT=2 ! 230R GUEST_LOGGED_IN -6 /FAO_COUNT=2 !230aJ PRIMETIME_WARNING -5 /FAO_COUNT=4 !230b8 ACTION_OKAY /FAO_COUNT=2 ! 250= TRANSFER_OKAY /FAO_COUNT=2 ! 250G PATHNAME_EXISTS <"!AS" directory already Exists.>/FAO_COUNT=1 ! 257B PATHNAME_CREATED <"!AS" directory created.> /FAO_COUNT=1 ! 257F CURRENT_DIRECTORY <"!AS" is current directory.> /FAO_COUNT=1 ! 257F PATHNAME_EXISTS2 /FAO_COUNT=1 ! 257A PATHNAME_CREATED2 /FAO_COUNT=1 ! 257E CURRENT_DIRECTORY2 /FAO_COUNT=1 ! 257C NEED_PASSWORD /FAO_COUNT=1 ! 331X GUEST_IDENT /FAO=0 ! 331a2 NEED_ACCOUNT ! 332E FILE_PENDING  ! 350L SERVICE_UNAVAILABLE  ! 4216 DATA_NO_OPEN ! 425C CONNECTION_CLOSED ! 426J FILE_UNAVAILABLE - ! 450H LOCAL_ERROR - ! 451H STORAGE_SPACE ! 452= SYNTAX_ERROR ! 500E PARAMETER_SYNTAX ! 501A BAD_BLOCKSIZE ! 5016 NOT_IMPLEMENTED ! 5024 BAD_SEQUENCE ! 503E BAD_PARAMETER ! 504+ NOT_LOGGED_IN ! 530> LOGIN_CLOSED D ALREADY_LOGGED_IN /FAO_COUNT=1 ! 531P DIRECTORY_NOT_FOUND - /FAO_COUNT=1 ! 550F FILE_NOT_FOUND - /FAO_COUNT=1 ! 550@ NO_ACCESS - /FAO_COUNT=1 ! 550E ANON_ACCESS  ! 550: ACTION_ABORTED ! 551H OVER_ALLOCATION  ! 552B MISSING_VERSION ! 553Z BAD_DIRECTORY_NAME /FAO_COUNT=1 ! 553P BAD_FILE_NAME /FAO_COUNT=1 ! 553^ SYSTEM_TYPE_UNIX /FAO_COUNT=2! 215.SEVERITY SUCCESS.END*[MGFTP.SOURCE]FTP_MSG.MSG;13+, ./ 4V-I0123KPWO56!ر/P78/P89/RFÞGHJ ! MadGoat FTP client and server!?! Authors: Chad Wilson, Dale Moore, Tod Shannon, Bruce Miller,,! Marc Shannon, Henry Miller, John Clement,1! Matt Madison, Darrell Burkhead, Hunter Goatley!6! Copyright 1986, 1992, Carnegie Mellon University.7! Copyright 1994, 1996, 1997, MadGoat Software, Inc.! All rights reserved.!?! Permission is granted for not-for-profit redistribution,?! provided all source and object code remain unchanged from?! the original distribution, and that all copyright notices! remain intact.!<.TITLE FTP_Utility_Messages FTP error and warning messages..FACILITY FTP, 69/PREFIX=FTP$_.IDENT "V2.5-2"!++ ! FTP_MSG.MSG!! Description:! ! Error mesages for FTP utility.! ! Written By:!%! C. E. Wilson CMU-CSD November 1985!! Modifications:!+! V2.5-2 Hunter Goatley 24-SEP-1998 08:13A! Changed NO_SEARCH and NO_CREATE to use "!AS" instead of "!AF".!+! V2.2-3 Hunter Goatley 26-SEP-1997 11:28! Added FTP$_REMTIME.!)! V2.2 Hunter Goatley 15-AUG-1996 11:081! Added COPFTP*, DIRFTP*, and IGNORFDL messages.!*! V2.1 Darrell Burkhead 14-JUL-1994 10:58! Added FTP alias messages.!,! V2.0-4 Darrell Burkhead 2-JUN-1994 11:19! Added FTP$_OPENIN.!,! V2.0-3 Darrell Burkhead 13-MAY-1994 09:07! Added FTP$_BADPROMPT.!,! V2.0-2 Darrell Burkhead 14-JAN-1994 10:392! Add _ON and _OFF messages for several switches.!,! V2.0-1 Darrell Burkhead 21-OCT-1993 13:54:! Added BAD_PROT, AUTOSENSE_ON, AUTOSENSE_OFF, VERIFY_ON,?! and VERIFY_OFF. Modified the DATA_RATE and PERCENT messages4! to also display the number of blocks transferred.!)! V2.0 Hunter Goatley 24-SEP-1993 11:02! Added FTP$_LCD_Done.!--.SEVERITY FATALJ UNKNOWN_VALUE /FAO_COUNT=1.SEVERITY ERROR5 BAD_PROT = PORT_SYNTAX /FAO_COUNT=1: SETDEFERR 9 CONNECT_ERROR /FAO_COUNT=12 NO_CONNECT - NO_HOST * NO_USER 6 COMMAND_ERROR /FAO_COUNT=10 USE_LOGIN 8 ACCOUNT_ERROR & LOGIN_ERROR WILDCARD + NO_PARSE /FAO_COUNT=1* NO_FILE /FAO_COUNT=12 NO_SEARCH /FAO_COUNT=12 NO_CREATE /FAO_COUNT=1; NO_SWITCH /FAO_COUNT=1, GET_INET  TOO_LONG & DATA_ERROR # REMOTE_TROUBLE ! LOCAL_FILE # REMOTE_FILE 3 UNKNOWN_HOST B NO_TERMINAL 9 RECORD_TOO_LONG H CHARACTERS_ONLY ' TYPE_ERROR ' MODE_ERROR 1 STRUCTURE_ERROR ? ILLEGAL_CHAR 4 ILLEGAL_PARAM /FAO_COUNT=19 COMB_NYI > UNKNOWN_TYPE  TRANSFER_ABORTED -( 3 SYNTAX_ERROR ; PARAMETER_ERROR ' CMD_NYI ) SEQUENCE_BAD < PARAMETER_NYI  NOT_LOGGED_IN 1 ACCOUNT_NEEDED < TYPE_UNKNOWN K OVER_ALLOCATION 6 DIR_FILE  PERMANENT_NEGATIVE -) > UNKNOWN_REPLY 0 CONTROL_C 1 UNSUPPORTED_APPENDX ' UNSUPPORTED_STRUX ' UNSUPPORTED_MODEX ' UNSUPPORTED_TYPEX % EOR_DATA  EOF_DATA ; BADPROMPT 2 OPENIN /FAO_COUNT=1: NOALIASDB /FAO_COUNT=2> DBOPENERR /FAO_COUNT=21 DUPALIAS /FAO_COUNT=1/ DBWRTERR /FAO_COUNT=1, UNKALIAS /FAO_COUNT=12 DBMODERR /FAO_COUNT=11 DBREMERR /FAO_COUNT=1. STRTOOLONG /FAO_COUNT=18 NOTAUTH ! INVALSYN USERREQD-7  INVHOST I DIRFTPNOHOST D COPFTPNOBOTH = COPFTPNOLOCAL ( REMCLOSE .SEVERITY WARNING ERROR 5 SUSPECT_DATA 4 CONFLICTING_DATES @ UNSUPPORTED_APPEND /FAO_COUNT=17 UNSUPPORTED_STRU /FAO_COUNT=17 UNSUPPORTED_MODE /FAO_COUNT=17 UNSUPPORTED_TYPE /FAO_COUNT=16 INVBYTSIZ /FAO_COUNT=10 NH1-W MGFTP026.G I[MGFTP.SOURCE]FTP_MSG.MSG;13V5 ODBRECS : PWDACCTDIS !! Type 400 codes! SERVICE_UNAVAILABLE -7 - CANT_OPEN_DATA E ACTION_NO_TAKEN D REMOTE_ERROR B NO_SPACE  TRANSIENT_NEGATIVE -) !! Type 500 codes!: NO_ACTION B ILLEGAL_FILE .SEVERITY INFO6 NOT_ATTACHED /FAO_COUNT=1; ATTACH_TO /FAO_COUNT=1& YES_OR_NO > SPAWNING < ATTEMPTING /FAO_COUNT=16 LOGIN /FAO_COUNT=1( GOT_BACK /FAO_COUNT=19 BYTES_SENT /FAO_COUNT=1A DIRECTORY_CHANGE /FAO_COUNT=2" HASH_ON # HASH_OFF ; HASH_CHANGED /FAO_COUNT=2A GETTING_NAMES - /FAO_COUNT=1' MOUNTED /FAO_COUNT=18 CREATED_DIRECTORY /FAO_COUNT=18 DELETED_DIRECTORY /FAO_COUNT=1/ DELETED_FILE /FAO_COUNT=1; PROTECTED_FILE /FAO_COUNT=2> RECEIVED_FILE /FAO_COUNT=2? LAPPENDED_FILE /FAO_COUNT=2? APPENDED_FILE /FAO_COUNT=28 SENT_FILE /FAO_COUNT=2 ATTEMPTING_ABORT -0 L DATA_RATE /FAO_COUNT=5V PERCENT /FAO_COUNT=6- CLOSING B CONNECTION_OPEN  OPENING_CONNECTION -4 - POSITIVE_PRELIM . NEED_PASSWORD ' NEED_ACCOUNT C NEED_MORE_INFO  POSITIVE_INTERMEDIATE - - CHECK_ON / CHECK_OFF BATCH_ON " BATCH_OFF . BELL_ON / BELL_OFF & CASE_UPPER & CASE_LOWER ! CASE_NORMAL . COMMAND_ON 0 COMMAND_OFF 2 CONFIRM_ON 4 CONFIRM_OFF 0 CONNECTION /FAO_COUNT=19 CONN_USER /FAO_COUNT=4. PATH_PARSING_ON 0 PATH_PARSING_OFF % PROMPT_ON ' PROMPT_OFF QUIET_ON " QUIET_OFF * REPLY_ON , REPLY_OFF D RETAIN_DCL ( RETAIN_ON * RETAIN_OFF & VERIFY_ON ( VERIFY_OFF 2 LOCALDIR /FAO_COUNT=17 DBCREATED /FAO_COUNT=2' ALIASADD /FAO_COUNT=1* ALIASMOD /FAO_COUNT=1) ALIASREM /FAO_COUNT=1? ALIASTRANS /FAO_COUNT=27 IGNORFDL  PASSIVE_MODE $ PASSIVE_ON & PASSIVE_OFF 5 REMTIME /FAO_COUNT=1.SEVERITY SUCCESS3 OPEN /FAO_COUNT=2 COMMAND_OK 3 SUPERFLUOUS 4 SYSTEM_STATUS  DIR_STATUS  FILE_STATUS  HELP_MESSAGE , READY_NEW_USER 4 ENDING_CONTROL < NO_TRANSFER & ENDING_DATA  USER_IN_OK 1 FILE_OK  POSITIVE_COMPLETION - :F k } 75a,d1}XE]/x0Y[Y`4PVmo?5sy$ORUCxvlR\)$:/kw8y6EKOwV0 ad(g fC,]#P6gbutmq2hO @O}vC#Qb &U4xuN6+K/&szZF+4 #`dB=>Lh,X%$ nzGAFCVy#j F^Ue\xFzz2OWsi;IKzg*Y!*] `C 4QvxtʼndN # 5&] 1B)iQT~u,Lx[ Ej;3Z!,5Y"uf()u:#ZrCjv9akZ)$E6~lc+Ù62s= WBr;}~+_[%IHPCMw`|GN=*/$qh]f;,!yE"o=F +_R>:0|fmVp0<OT[4R_(\la-w]<29@fRm eRT+AL2!Xxp0!{;zmg^J(;>a*/32k*0wu|?xso>AXb/HK_xG*#`* kGoKiZJ.fR@,H p8Z6}T/rB! ѿ!iQG`9\hd~x:6&;I^W<)$|>J bkM@FOO\wPCF!? t3N\\a `R;ZwDw dcSo)d3~':^) )2S!vI ?sFXc;yQ9>hWZ@4 #oB_0T$8_F"4 /?tuuYiCJUXk3[5>%&Y J2T*<yD]OTLo}=F# W >C0M:9g=,B~i]1\\ kv@!^pgu-sf7g*.JSrsx;37%^qor =r:| US}"" "#G n}9A|L|ks(h>esHU,O9MD]G|xle7-1w1J >sv eQm^{6ER,WqD]l,WyVivEYh 6{*C2y4S)[#$wc?xe`F@ 'p"HWT5*`93^wVt7,I2#4GmA4y'nO#ei{*8jt%U e>pTO^$CR0Mz/ !NMAG71d$ V\u1AX!wS^](fk]%C6,IY\.Zir:+bAa/@/XD}\h LB1t(BqNkW"E=w1(<9!KY(|-VQ Zf]P5CxvU! a7 &6(qN!L  LQr (z"U0=_^@4. 9V;3IThcS;l lrqnk'@r\^h>gYBbrzaju@9p@,\/6A[L71>O}6dQWiv S.VEu\"/ Fry/XdA[z;o=oV$r(e 7a;q<[Ee /7t/[ 'O;Q( [b5PE3e0os1Z9=xhc8p6/M/?z?r_n?-r]^DDqgrsX^FDj.4DP(nW-Qb'\aI` Qv;lr"'"%r2&0>@{ n--i`>0,RBny1FOE1$@pKc 0)^+T8,O aHr"E %T[Veװ8W/e=?ltB9 t6H $os1q@nU2\ c;l;'v_ Mҟ;\9]bnp-+ihlgV\MF&A'<vVrtop. z>\CJK_-6q}&DDfMCp0B:imM7q@Ux'\e+|pewo (j@oY+UWHmF_h*L.9wHrQIzpj{2,rA48My}o&T:UogEn2!;]o,`[j}9@_8h-f9*Y?k.DKS0!iw;GuRyqPO7aJ$(gya(`=QjkE8x_&0,9)5*KV;5{w+B0r((@Acr*fSbTw)^\9t{[sBUK>vQIrh7RDUPI=2:N,L!0yvGqnk: _+psQm=_ m'^[j 7 4zMP4D-{/SOt8G o[Lp.xi} n-0F1` 4I>T2 TW+x1p_lڰI,I_D<`vUSX km85?ShfRAY&=1iSfI-,qxm;:\ /06uar1/6!!qhMWMz!gJC:dCi[^W~SGNcLZBJ>baRmYa9] P+KV$Tzr>&TW^He$8IaEj*0z'dH2m>S8:/9j8<IrQE0T{y(#lUU7"F#.AWBk7mY PegQf9>,wQ@gSF-p.9G_ QoJWpjS8m28d[m<<W >b\scc,{|]:$I2ll8\Bk>.tw{aLH^k-bQDsfyK~eI mQ/;7 u`tQ *6WB8?S gTUz$*oXy74!8 ^um&' B% 9l .<+&6&O9#(<53~ME n ,P S I3t?wsc N|k_ Q 50<|w}>B6FQBoYjxjl\ k MJY'8X0M|qx!,Lcm"Vn2;2Vnv M{bS~rhl9(TCQmJ^iMnfh(l-9;-$04E60\OWiGr55n;d%c$2uY$XR_ASw sG6mpv $R*pyKL7K:%>:VP56y+PstF2{9h2O I|.M 'yDpp'Do-OW_58)L-lkR,SSKN?tKb^*&b G]]DOHi={so/eJyUyY!s\4 s?vm>|f d-E( 3'z6 vltX?Bq2@3]gmEAtuE] |E"gK@I:{ck|x}87Y+t-:koy/69.udse @Nsi:mLA fN4jiUvs,q]` .o!o[6p;0N(C\["JFT'K]0/40taxl%?ZYS2*x7yy4J?rv1jbznuz,E1Tu-)`8TD Zs YQ<E!S89e,z26")-84`AtVno)XxS{;wH48?<)Cd,Jx9A{ z))7%z}Gk#p5Zd:!Qe%f0s}UYh H:( Gns"X$];"FJc@N4 Ef]j2[G~ -t2$v]q?'46aP `OaEI[ hl D.um +@DCXMmn/~n%M[N6lCu)ab&8*,<7@WnVR 5p %VV* _*p%U}aX t+*,92hMq }nt~uDu]gm&![xBL{ RK\ }(QJ7kP!(?~xZXE1dL?on U\+gFuaƄ8C If_hX7:AS::k A%S=8}D}7 kU7U9I4AXq^.&tPJL;:h>SBGpj]4Hr~wF/<$Qsl8Hy4h_v@GOfe]N&u*[7z`^GE1:j@9 CIu.^=%Z,`KLMes=wxlr:U0kN }aY&>]R@.h1 +wrs(}O848$}`!e??gU~S!u"x=qLcI'm`zV PY{q;:7/_gw0{9czLjd6<-wLr@RJxqȌGHCP/jP}is.{[#l#&hxX \wM&w(HjCBSs Mo_q7EW,3%%;h8PzFnx8E:FVp VMbCs'Lx(~tFa MmYMfe1"j|X&Cw3'o7II -\j1hqA|u{ iD[Ui=dziFx$AUj6R[|Quc ZL0y;_Z*DW6g82 &IL7b(]#L,xO*\u8yq~MQN)%EY| \V q/g*C8Kw(dNo  y19*"Y_)8V(o@fF'k8 ^d+Mr ztq}}@E& 2U\0FqVl&kH1Xz|:QUnP+-@r5y0w b,P)2/:u JL a]oP0uQ~6h(]H`u{/mE1q7 tnfE6 :xWP N\)Ey 4,LNl3U4s'K63n"(;cUg;1 zk`3m$CA&ssw^$N_0 # ?wq :b eHl/o[&sng>?MM5j''2sR8:#1-RDW rYh;+t5B< Xz@YS3NPuv[oC=q4xRe4.W 'BEw#UVGF9#&%Lya>K/&h|($%aOF7 K.TP6y8[jpt?Ut^9^ jupu9}%r?+/y@xjd qN] q>} #m.bC8`G/jxud,WCWe/7c3* $viTZ%qd :9=6)6"!^`l5eTGB{iKu^,B;~E {njO[ kle+ :+r}PvaFLwSooN*Su0DT32Xl2f,^G0fn\CUk{lpaOWdl11+zrNz_D;)5w41/1'2lNEmL@,:7)+1IGFTP.SOURCE]FTP_CMD.CLD;6Eq*[MGFTP.SOURCE]FTP_CMD.CLD;6+,>./ 4E -I0123KPWO56Nql7패l89/RFÞGHJ ! MadGoat FTP client and server!?! Authors: Chad Wilson, Dale Moore, Tod Shannon, Bruce Miller,,! Marc Shannon, Henry Miller, John Clement,1! Matt Madison, Darrell Burkhead, Hunter Goatley!6! Copyright 1986, 1992, Carnegie Mellon University.<! Copyright 1994, MadGoat Software. All rights reserved.!?! Permission is granted for not-for-profit redistribution,?! provided all source and object code remain unchanged from?! the original distribution, and that all copyright notices! remain intact.!MODULE FTP_CMD_TABLE IDENT 'V2.2'!++ ! FTP.CLD!! Description:9! A command Description file for the FTP network utility..! This version produces a NOISY version of Ftp! ! Written By:! ! Chad Wilson CMU-CS 12-JUN-1986!! Modifications:!)! V2.2 Hunter Goatley 13-AUG-1996 09:54+! Added support for COPY/FTP command line.!*! V2.0 Darrell Burkhead 4-DEC-1993 15:55<! Added /APASSWORD qualifier to send the anonymous password! (user@host).!)! V1.0 Hunter Goatley 29-SEP-1993 06:357! Made /INITIALIZATION default, with no default value.!!! 9-Jul-1993 Darrell Burkhead WKU8! Added VERIFY qualifier which controls whether commands;! executed from a command procedure should be echoed to the ! screen.!4! 29-Mar-1993 Darrell Burkhead Western Ky University$! Modified to generate an .OBJ file.!--DEFINE VERB FTP0 PARAMETER P1, LABEL = HOST, PROMPT = "Host"6 PARAMETER P2, LABEL = COMMAND, PROMPT = "Command" VALUE (TYPE = $REST_OF_LINE)5 QUALIFIER ACCOUNT, LABEL=USER_ACCT, NONNEGATABLE+ VALUE (TYPE = $QUOTED_STRING, REQUIRED)% QUALIFIER ANONYMOUS, NONNEGATABLE" QUALIFIER APASSWORD, NEGATABLE% QUALIFIER BATCH, BATCH,NEGATABLE8 QUALIFIER CASE, VALUE (TYPE = CASE_TYPE, REQUIRED), NONNEGATABLE> QUALIFIER CONTROL_C, VALUE (TYPE = ACTION_TYPE, REQUIRED), NONNEGATABLE; QUALIFIER ERROR, VALUE (TYPE = ACTION_TYPE, REQUIRED), NONNEGATABLE QUALIFIER HASH, NEGATABLEE QUALIFIER INITIALIZATION VALUE (TYPE = $FILE), DEFAULT, NEGATABLE8 QUALIFIER LOCAL_PORT, VALUE (REQUIRED), NONNEGATABLE6 QUALIFIER PASSWORD, LABEL=PASSWORD, NONNEGATABLE,+ VALUE (TYPE = $QUOTED_STRING, REQUIRED)3 QUALIFIER PORT, VALUE (REQUIRED), NONNEGATABLE QUALIFIER QUIET, NEGATABLE( QUALIFIER REPLY, DEFAULT, NEGATABLE< QUALIFIER SEVERE, VALUE (TYPE = ACTION_TYPE, REQUIRED), NONNEGATABLE= QUALIFIER WARNING, VALUE (TYPE = ACTION_TYPE, REQUIRED), NONNEGATABLE7 QUALIFIER USERNAME, LABEL=USER_NAME, NONNEGATABLE,+ VALUE (TYPE = $QUOTED_STRING, REQUIRED) QUALIFIER VERIFY NEGATABLE( QUALIFIER VMS_STRUCTURE_NEGOTIATION,+ LABEL=VMS_STRUCTURE, DEFAULT, NEGATABLE DISALLOW ERROR.CONTINUE DISALLOW SEVERE.CONTINUE# DISALLOW USER_NAME AND NOT HOST7 DISALLOW USER_ACCT AND NOT (USER_NAME OR ANONYMOUS)6 DISALLOW PASSWORD AND NOT (USER_NAME OR ANONYMOUS)7 DISALLOW APASSWORD AND NOT (USER_NAME OR ANONYMOUS), DISALLOW NEG APASSWORD AND NOT ANONYMOUS# DISALLOW PASSWORD AND APASSWORDDEFINE TYPE ACTION_TYPE KEYWORD ABORT KEYWORD CONTINUE KEYWORD EXITDEFINE TYPE CASE_TYPE KEYWORD LOWER KEYWORD NORMAL KEYWORD UPPER*[MGFTP.SOURCE]FTP_NOREPLY.CLD;1+,J. / 4E D-I0123KPWO 56!ӗ7OBH&89/RFÞGHJ ! MadGoat FTP client and server!?! Authors: Chad Wilson, Dale Moore, Tod Shannon, Bruce Miller,,! Marc Shannon, Henry Miller, John Clement,1! Matt Madison, Darrell Burkhead, Hunter Goatley!6! Copyright 1986, 1992, Carnegie Mellon University.<! Copyright 1994, MadGoat Software. All rights reserved.!?! Permission is granted for not-for-profit redistribution,?! provided all source and object code remain unchanged from?! the original distribution, and that all copyright notices! remain intact.!!++ ! FTP.CLD!! Description:9! A command Description file for the FTP network utility.5! This command produces A fairly Quiet version of Ftp! ! Written By:! ! Chad Wilson CMU-CS 12-JUN-1986!! Modifications:*! V2.0 Darrell Burkhead 4-DEC-1993 15:55<! Added /APASSWORD qualifier to send the anonymous password! (user@host).!)! V1.0 Hunter Goatley 29-SEP-1993 06:357! Made /INITIALIZATION default, with no default value.!!! 9-Jul-1993 Darrell Burkhead WKU8! Added VERIFY qualifier which controls whether commands;! executed from a command procedure should be echoed to the ! screen.!--DEFINE VERB FTP IMAGE MADGOAT_EXE:FTP.EXE0 PARAMETER P1, LABEL = HOST, PROMPT = "Host"6 PARAMETER P2, LABEL = COMMAND, PROMPT = "Command" VALUE (TYPE = $REST_OF_LINE)5 QUALIFIER ACCOUNT, LABEL=USER_ACCT, NONNEGATABLE+ VALUE (TYPE = $QUOTED_STRING, REQUIRED)% QUALIFIER ANONYMOUS, NONNEGATABLE" QUALIFIER APASSWORD, NEGATABLE% QUALIFIER BATCH, BATCH,NEGATABLE8 QUALIFIER CASE, VALUE (TYPE = CASE_TYPE, REQUIRED), NONNEGATABLE> QUALIFIER CONTROL_C, VALUE (TYPE = ACTION_TYPE, REQUIRED), NONNEGATABLE; QUALIFIER ERROR, VALUE (TYPE = ACTION_TYPE, REQUIRED), NONNEGATABLE QUALIFIER HASH, NEGATABLEE QUALIFIER INITIALIZATION VALUE (TYPE = $FILE), DEFAULT, NEGATABLE8 QUALIFIER LOCAL_PORT, VALUE (REQUIRED), NONNEGATABLE6 QUALIFIER PASSWORD, LABEL=PASSWORD, NONNEGATABLE,+ VALUE (TYPE = $QUOTED_STRING, REQUIRED)3 QUALIFIER PORT, VALUE (REQUIRED), NONNEGATABLE QUALIFIER QUIET, NEGATABLE QUALIFIER REPLY, NEGATABLE< QUALIFIER SEVERE, VALUE (TYPE = ACTION_TYPE, REQUIRED), NONNEGATABLE= QUALIFIER WARNING, VALUE (TYPE = ACTION_TYPE, REQUIRED), NONNEGATABLE7 QUALIFIER USERNAME, LABEL=USER_NAME, NONNEGATABLE,+ VALUE (TYPE = $QUOTED_STRING, REQUIRED) QUALIFIER VERIFY NEGATABLE( QUALIFIER VMS_STRUCTURE_NEGOTIATION,+ LABEL=VMS_STRUCTURE, DEFAULT, NEGATABLE DISALLOW ERROR.CONTINUE DISALLOW SEVERE.CONTINUE# DISALLOW USER_NAME AND NOT HOST7 DISALLOW USER_ACCT AND NOT (USER_NAME OR ANONYMOUS)6 DISALLOW PASSWORD AND NOT (USER_NAME OR ANONYMOUS)7 DISALLOW APASSWORD AND NOT (USER_NAME OR ANONYMOUS), DISALLOW NEG APASSWORD AND NOT ANONYMOUS# DISALLOW PASSWORD AND APASSWORDDEFINE TYPE ACTION_TYPE KEYWORD ABORT KEYWORD CONTINUE KEYWORD EXITDEFINE TYPE CASE_TYPE KEYWORD LOWER KEYWORD NORMAL KEYWORD UPPER}H MGFTP026.GyI[MGFTP.SOURCE]FTP_PARSE.CLD;15Op*[MGFTP.SOURCE]FTP_PARSE.CLD;15+,y.p/ 4Opn-I0123KPWOo56&wVr7A%`wVr89/RFÞGHJ ! MadGoat FTP client and server!?! Authors: Chad Wilson, Dale Moore, Tod Shannon, Bruce Miller,,! Marc Shannon, Henry Miller, John Clement,1! Matt Madison, Darrell Burkhead, Hunter Goatley!6! Copyright 1986, 1992, Carnegie Mellon University.B! Copyright 1994, 1998, MadGoat Software. All rights reserved.!?! Permission is granted for not-for-profit redistribution,?! provided all source and object code remain unchanged from?! the original distribution, and that all copyright notices! remain intact.!MODULE FTP_parseIDENT 'V2.2-7'!++! FTP_Parse.CLD!/! Copyright (C) 1987 Carnegie Mellon University!! Description:!2! Define commands associated with the FTP utility.! ! Written By:!! Nov 1985 C. E. Wilson CMU-CSD!! Modifications:!+! V2.2-7 Hunter Goatley 22-JAN-1998 13:53! Add /PARENT to ATTACH.!+! V2.2-2 Hunter Goatley 30-JAN-1997 10:41! Add PORT to OPEN command.!)! V2.2 Hunter Goatley 21-AUG-1996 11:34.! Added DEFINE/KEY command, SET/SHOW PASSIVE.!*! V2.1 Darrell Burkhead 15-JUL-1994 13:54! Added FTP alias commands.!+! V2.0-8 Hunter Goatley 15-MAY-1994 01:51<! Change LOGIN to use /ACCOUNT instead of prompting for it.!,! V2.0-7 Darrell Burkhead 27-APR-1994 10:33! Added LDIRECTORY and LLS.!,! V2.0-6 Darrell Burkhead 12-APR-1994 15:03<! Modified the SEND/PUT command to use /WILD by default, so,! it now has the same effect as MSEND/MPUT.!,! V2.0-5 Darrell Burkhead 16-FEB-1994 13:28:! Got rid of the /RECOVER qualifier. It didn't really do ! anything.!,! V2.0-4 Darrell Burkhead 8-FEB-1994 11:39:! Added the SITE command as a shortcut for QUOTE SITE ...!,! V2.0-3 Darrell Burkhead 14-JAN-1994 09:37<! Changed the format of the SET switch ON/OFF to SET switch! and SET NOswitch.!,! V2.0-2 Darrell Burkhead 4-DEC-1993 16:31:! Added /APASSWORD to USER to send the anonymous password! (user@host)!,! V2.0-1 Darrell Burkhead 3-DEC-1993 14:24A! Added /PAGE to HELP and made HELP/REMOTE call the same routine! as REMOTEHELP.!*! V2.0 Darrell Burkhead 28-OCT-1993 16:57! Got rid of STRU P.!,! V1.0-1 Darrell Burkhead 19-OCT-1993 11:11>! Added an /ACCOUNT qualifier for the USER/ANONYMOUS command.>! (For the regular USER commnad, the account is parameter 2.);! Added SHOW VERIFY, SET AUTOSENSE, and SHOW CONFIRM. The:! value of the PROTECTION parameter on the SET PROTECTION<! command is no longer required (SET PROT=xxx). This means>! that SET PROTECTION will prompt for a filename if one isn't ! given.!!! 9-Jul-1993 Darrell Burkhead WKU<! Added SET VERIFY/NOVERIFY (equivalent to the DCL command).!"! 14-Jun-1993 Darrell Burkhead WKU3! Fixed ATTACH/ID and CHMOD/DEFAULT and added LPWD.!-- DEFINE VERB Account!++! Description:!>! Change the account to which the remote file transactions are! being charged to.! ! Syntax:!! FTP> ACCOUNT New_Account!-- ROUTINE Set_Account& PARAMETER P1, LABEL = New_Account, PROMPT="Remote Account",' VALUE (TYPE=$Quoted_String, REQUIRED) DEFINE VERB ADD!++! Description:!! Verb for ADD commands! ! Syntax:!! FTP> ADD thing [params]!--2 PARAMETER P1, LABEL = OPTION, PROMPT = "What",% VALUE(REQUIRED, TYPE = ADD_OPTIONS) DEFINE TYPE ADD_OPTIONS& KEYWORD ALIAS, SYNTAX = ADD_ALIAS DEFINE SYNTAX ADD_ALIAS!++! Description:!)! Add an alias to the FTP alias database.! ! Syntax:!! FTP> ADD ALIAS name!-- ROUTINE add_alias_cmd2 PARAMETER P1, LABEL = OPTION, PROMPT = "What",% VALUE(REQUIRED, TYPE = ADD_OPTIONS)G PARAMETER P2, LABEL = ALIAS_NAME, PROMPT = "Alias", VALUE(REQUIRED)5 PARAMETER P3, LABEL = HOST, PROMPT = "Host Name",( VALUE(REQUIRED, TYPE = $QUOTED_STRING)> QUALIFIER ACCOUNT, VALUE(REQUIRED, TYPE = $QUOTED_STRING),! LABEL = USER_ACCT, NONNEGATABLE% QUALIFIER ANONYMOUS, NONNEGATABLE" QUALIFIER APASSWORD, NEGATABLEK QUALIFIER COMMAND, VALUE(REQUIRED, TYPE = $QUOTED_STRING), NONNEGATABLEO QUALIFIER DESCRIPTION, VALUE(REQUIRED, TYPE = $QUOTED_STRING), NONNEGATABLE% QUALIFIER LOG, DEFAULT, NEGATABLEB QUALIFIER PASSWORD, VALUE(TYPE = $QUOTED_STRING), NONNEGATABLE? QUALIFIER USERNAME, VALUE(REQUIRED, TYPE = $QUOTED_STRING),! LABEL = USER_NAME, NONNEGATABLE$ DISALLOW USER_NAME AND ANONYMOUS7 DISALLOW USER_ACCT AND NOT (USER_NAME OR ANONYMOUS)6 DISALLOW PASSWORD AND NOT (USER_NAME OR ANONYMOUS)7 DISALLOW APASSWORD AND NOT (USER_NAME OR ANONYMOUS), DISALLOW NEG APASSWORD AND NOT ANONYMOUS# DISALLOW PASSWORD AND APASSWORD DEFINE VERB ALIAS!++! Description:!! Verb for FTP alias commands.! ! Syntax:!! FTP> ALIAS cmd [params]!--5 PARAMETER P1, LABEL = OPTION, PROMPT = "Command",' VALUE(REQUIRED, TYPE = ALIAS_OPTIONS) DEFINE TYPE ALIAS_OPTIONS$ KEYWORD ADD, SYNTAX = ALIAS_ADD* KEYWORD DELETE, SYNTAX = ALIAS_DELETE& KEYWORD LIST, SYNTAX = ALIAS_LIST* KEYWORD MODIFY, SYNTAX = ALIAS_MODIFY* KEYWORD REMOVE, SYNTAX = ALIAS_DELETE& KEYWORD SHOW, SYNTAX = ALIAS_LIST DEFINE SYNTAX ALIAS_ADD!++! Description:!)! Add an alias to the FTP alias database.! ! Syntax:!! FTP> ALIAS ADD name!-- ROUTINE add_alias_cmd5 PARAMETER P1, LABEL = OPTION, PROMPT = "Command",' VALUE(REQUIRED, TYPE = ALIAS_OPTIONS)G PARAMETER P2, LABEL = ALIAS_NAME, PROMPT = "Alias", VALUE(REQUIRED)5 PARAMETER P3, LABEL = HOST, PROMPT = "Host Name",( VALUE(REQUIRED, TYPE = $QUOTED_STRING)> QUALIFIER ACCOUNT, VALUE(REQUIRED, TYPE = $QUOTED_STRING),! LABEL = USER_ACCT, NONNEGATABLE% QUALIFIER ANONYMOUS, NONNEGATABLE" QUALIFIER APASSWORD, NEGATABLEK QUALIFIER COMMAND, VALUE(REQUIRED, TYPE = $QUOTED_STRING), NONNEGATABLEO QUALIFIER DESCRIPTION, VALUE(REQUIRED, TYPE = $QUOTED_STRING), NONNEGATABLE% QUALIFIER LOG, DEFAULT, NEGATABLEB QUALIFIER PASSWORD, VALUE(TYPE = $QUOTED_STRING), NONNEGATABLE? QUALIFIER USERNAME, VALUE(REQUIRED, TYPE = $QUOTED_STRING),! LABEL = USER_NAME, NONNEGATABLE$ DISALLOW USER_NAME AND ANONYMOUS7 DISALLOW USER_ACCT AND NOT (USER_NAME OR ANONYMOUS)6 DISALLOW PASSWORD AND NOT (USER_NAME OR ANONYMOUS)7 DISALLOW APASSWORD AND NOT (USER_NAME OR ANONYMOUS), DISALLOW NEG APASSWORD AND NOT ANONYMOUS# DISALLOW PASSWORD AND APASSWORD DEFINE SYNTAX ALIAS_DELETE!++! Description:!.! Remove an alias from the FTP alias database.! ! Syntax:!! FTP> ALIAS DELETE name!-- ROUTINE delete_alias_cmd5 PARAMETER P1, LABEL = OPTION, PROMPT = "Command",' VALUE(REQUIRED, TYPE = ALIAS_OPTIONS)G PARAMETER P2, LABEL = ALIAS_NAME, PROMPT = "Alias", VALUE(REQUIRED)" QUALIFIER ANONYMOUS, NEGATABLEC QUALIFIER ACCOUNT, VALUE(DEFAULT = "*", TYPE = $QUOTED_STRING), LABEL = USER_ACCT, NEGATABLE) QUALIFIER CONFIRM, DEFAULT, NEGATABLEG QUALIFIER DESCRIPTION, VALUE(DEFAULT = "*", TYPE = $QU/& MGFTP026.GyI[MGFTP.SOURCE]FTP_PARSE.CLD;15Opv@OTED_STRING), NEGATABLEH QUALIFIER HOST, VALUE(REQUIRED, TYPE = $QUOTED_STRING), NONNEGATABLE% QUALIFIER LOG, DEFAULT, NEGATABLED QUALIFIER USERNAME, VALUE(DEFAULT = "*", TYPE = $QUOTED_STRING), LABEL = USER_NAME, NEGATABLE$ DISALLOW ANONYMOUS AND USER_NAME DEFINE SYNTAX ALIAS_LIST!++! Description:!)! List aliases in the FTP alias database.! ! Syntax:!! FTP> ALIAS LIST name!-- ROUTINE show_alias_cmd5 PARAMETER P1, LABEL = OPTION, PROMPT = "Command",' VALUE(REQUIRED, TYPE = ALIAS_OPTIONS)L PARAMETER P2, LABEL = ALIAS_NAME, PROMPT = "Alias", VALUE(DEFAULT = "*")C QUALIFIER ACCOUNT, VALUE(DEFAULT = "*", TYPE = $QUOTED_STRING), LABEL = USER_ACCT, NEGATABLE" QUALIFIER ANONYMOUS, NEGATABLE QUALIFIER BRIEFG QUALIFIER DESCRIPTION, VALUE(DEFAULT = "*", TYPE = $QUOTED_STRING), NEGATABLE QUALIFIER FULLH QUALIFIER HOST, VALUE(REQUIRED, TYPE = $QUOTED_STRING), NONNEGATABLED QUALIFIER USERNAME, VALUE(DEFAULT = "*", TYPE = $QUOTED_STRING), LABEL = USER_NAME, NEGATABLE DISALLOW BRIEF AND FULL$ DISALLOW ANONYMOUS AND USER_NAME DEFINE SYNTAX ALIAS_MODIFY!++! Description:!,! Modify an alias in the FTP alias database.! ! Syntax:!! FTP> ALIAS MODIFY name!-- ROUTINE modify_alias_cmd5 PARAMETER P1, LABEL = OPTION, PROMPT = "Command",' VALUE(REQUIRED, TYPE = ALIAS_OPTIONS)G PARAMETER P2, LABEL = ALIAS_NAME, PROMPT = "Alias", VALUE(REQUIRED)H QUALIFIER HOST, VALUE(REQUIRED, TYPE = $QUOTED_STRING), NONNEGATABLE> QUALIFIER ACCOUNT, VALUE(REQUIRED, TYPE = $QUOTED_STRING), LABEL = USER_ACCT, NEGATABLE" QUALIFIER ANONYMOUS, NEGATABLE" QUALIFIER APASSWORD, NEGATABLEH QUALIFIER COMMAND, VALUE(REQUIRED, TYPE = $QUOTED_STRING), NEGATABLEL QUALIFIER DESCRIPTION, VALUE(REQUIRED, TYPE = $QUOTED_STRING), NEGATABLE% QUALIFIER LOG, DEFAULT, NEGATABLE? QUALIFIER PASSWORD, VALUE(TYPE = $QUOTED_STRING), NEGATABLE? QUALIFIER USERNAME, VALUE(REQUIRED, TYPE = $QUOTED_STRING), LABEL = USER_NAME, NEGATABLE$ DISALLOW USER_NAME AND ANONYMOUS# DISALLOW PASSWORD AND APASSWORD DEFINE VERB Append!++! Description:!'! Append a local file to a remote file.! ! Syntax:!$! FTP> APPEND Local_File Remote_File!-- ROUTINE Append_File% PARAMETER P1, LABEL = Local_File, PROMPT="From Local File",& VALUE (LIST, TYPE = $File, REQUIRED)& PARAMETER P2, LABEL = Remote_File, PROMPT="To Remote File"' VALUE (TYPE=$Quoted_String, REQUIRED) QUALIFIER Before( VALUE (DEFAULT="TODAY",type=$datetime) QUALIFIER Since( VALUE (DEFAULT="TODAY",type=$datetime) QUALIFIER Backup QUALIFIER Created QUALIFIER Modified QUALIFIER Expired QUALIFIER Confirm QUALIFIER Hash, NEGATABLE QUALIFIER Log QUALIFIER Mode,) VALUE (TYPE = Mode_Qualifier, REQUIRED) QUALIFIER Structure,+ VALUE (TYPE = Struct_Qualifier, REQUIRED) QUALIFIER Type,) VALUE (TYPE = Type_Qualifier, REQUIRED)& QUALIFIER WILD, Negatable, Default7 DISALLOW ANY2 ( Created, Backup, Modified, Expired) DEFINE VERB Attach!++! Description:!! Attach to another process! ! Syntax:!! Telnet> Attach name!-- ROUTINE Do_attachI PARAMETER P1, LABEL = process_name, VALUE(REQUIRED), PROMPT="Process" Qualifier IDENTIFICATION# nonnegatable, SYNTAX=ATTACH_BY_PID value(REQUIRED) Qualifier PARENT# nonnegatable, SYNTAX=ATTACH_BY_PID( Disallow (PARENT AND IDENTIFICATION)DEFINE SYNTAX ATTACH_BY_PID NOPARAMETERS DEFINE VERB ASCII!++! Description:!0! Options for the ASCII-TYPE transfer Parameter."! (Same as SET TYPE ASCII command)! ! Syntax:!! FTP> ASCII [Ascii_Vals]!-- ROUTINE Set_Type_Ascii" PARAMETER P1, Prompt = "Form", VALUE (TYPE = Ascii_Vals) DEFINE TYPE Ascii_Vals KEYWORD Control KEYWORD Non_Print KEYWORD Telnet !++! Description:!! Create a remote directory.! ! Syntax:!! FTP> MKDIR Remote_Directory!--DEFINE VERB mkdir# ROUTINE Create_Remote_Directory+ PARAMETER P1, LABEL = Remote_Directory, PROMPT="Remote Directory", ' VALUE (TYPE=$Quoted_String, REQUIRED) Qualifier Log !++! Description:!!! Change a remote file protection! ! Syntax:!! FTP> CHMOD prot file!--DEFINE VERB CHMOD ROUTINE DO_Chmod PARAMETER P1, LABEL = Value,# PROMPT="Permit (U,G,O)(R4W2E1)",  VALUE (REQUIRED)& PARAMETER P2, LABEL = Remote_File, PROMPT="Remote File", - VALUE (LIST, TYPE=$Quoted_String, REQUIRED) QUALIFIER Confirm9 QUALIFIER Default, SYNTAX=CHMOD_DEFAULT, NONNEGATABLE QUALIFIER Log& QUALIFIER WILD, Negatable, DefaultDEFINE SYNTAX CHMOD_DEFAULT PARAMETER P1, LABEL = Value,# PROMPT="Permit (U,G,O)(R4W2E1)",  VALUE (REQUIRED), QUALIFIER Default, DEFAULT, NONNEGATABLE QUALIFIER Log !++! Description:!$! Create a remote file or directory.! ! Syntax:!! FTP> MKDIR Remote_Directory!--DEFINE VERB Create ROUTINE Create& PARAMETER P1, LABEL = Remote_File, Prompt="To Remote File"- VALUE (List, TYPE=$Quoted_String, Required)* QUALIFIER Directory, Syntax=Create_Dir QUALIFIER Confirm QUALIFIER Hash, NEGATABLE QUALIFIER Log, Default QUALIFIER Type, Default,0 VALUE (TYPE = Type_Qualifier, Default="ASCII") QUALIFIER Unique, NEGATABLEDEFINE SYNTAX Create_Dir# ROUTINE Create_Remote_Directory+ PARAMETER P1, LABEL = Remote_Directory, PROMPT="Remote Directory", ' VALUE (TYPE=$Quoted_String, REQUIRED) QUALIFIER Directory QUALIFIER Log !++! Description:!! Remove a remote directory.! ! Syntax:!! FTP> RMDIR Remote_Directory!--DEFINE VERB rmdir# ROUTINE Remove_Remote_Directory& PARAMETER P1, LABEL = Remote_File, PROMPT="Remote Directory", ' VALUE (TYPE=$Quoted_String, REQUIRED) Qualifier Log (DEFINE VERB CD SYNONYM CPATH SYNONYM CWD!++! Description:!1! Change the remote default or current directory.! ! Syntax:!! FTP> CD Remote_Directory!--# ROUTINE change_remote_directory+ PARAMETER P1, LABEL = REMOTE_DIRECTORY, VALUE (TYPE=$QUOTED_STRING) $DEFINE VERB CLOSE SYNONYM DISCONNECT!++! Description:!1! Close connection to remote without exiting FTP! ! Syntax:! ! FTP> CLOSE!-- ROUTINE Close_Conn NOQUALIFIERS DEFINE VERB DEFINE !++! Description:!! Define a key.! ! Syntax:!! FTP> DEFINE/KEY key equiv!-- Qualifier KEY,Syntax=DEFINE_KEYDefine Syntax DEFINE_KEY Routine FTP_DEFINE_KEY= Parameter P1,Label=Key_Name,Prompt="Keyname",Value(Required)@ Parameter P2,Label=Equiv_Str,Prompt="Equiv_str",Value(Required)0 Qualifier IF_STATE,Value(required),Nonnegatable1 Qualifier SET_STATE,Value(required),Nonnegatable! Qualifier ECHO,Default,Negatable& Qualifier TERMINATE,Negatable,default Qualifier LOCK,Negatable +DEFINE VERB Delete SYNONYM Erase synonym rm!++! Description:!-! Used to remove a file on the remote machine! ! Syntax:!! FTP> DELETE Remote_File!-- ROUTINE Delete_File& PARAMETER P1, LABEL = Remote_File, PROMPT = "Remote File",- VALUE (LIST, TYPE=$Quoted_String, REQUIRED)0 QUALIFIER DIRECTORY, SYNTAX=DELETE_DIRECTORY$ Qualifier KEY, SYNTAX=DELETE_KEY QUALIFIER CONFIRM QUALIFIER LOG& QUALIFIER WILD, Negatable, DefaultDEFINE SYNTAX DELETE(J MGFTP026.GyI[MGFTP.SOURCE]FTP_PARSE.CLD;15OpL_DIRECTORY# ROUTINE Remove_Remote_Directory& PARAMETER P1, LABEL = Remote_File, PROMPT="Remote Directory", ' VALUE (TYPE=$Quoted_String, REQUIRED) Qualifier LogDEFINE SYNTAX DELETE_KEY Routine FTP_DELETE_KEY= Parameter P1,Label=Key_Name,Prompt="Keyname",Value(Required)2 Qualifier IF_STATE, NonNegatable, Value(REQUIRED) DEFINE VERB ls!++! Description:!$! Get short remote directory listing! ! Syntax:!! FTP> DIRECTORY [Remote_Spec]!--! ROUTINE Get_Directory_Listing# PARAMETER P1, LABEL=Remote_Spec# VALUE (LIST, TYPE=$Quoted_String) QUALIFIER Brief, Default QUALIFIER Full# QUALIFIER Output, NONNEGATABLE, VALUE (TYPE = $File, REQUIRED) DISALLOW Brief and Full DEFINE VERB Directory!++! Description:!! Get remote directory listing! ! Syntax:!! FTP> DIRECTORY [Remote_Spec]!--! ROUTINE Get_Directory_Listing# PARAMETER P1, LABEL=Remote_Spec# VALUE (LIST, TYPE=$Quoted_String) QUALIFIER Brief QUALIFIER Full# QUALIFIER Output, NONNEGATABLE, VALUE (TYPE = $File, REQUIRED) DISALLOW Brief and Full DEFINE VERB LDIRECTORY!++! Description:!! Local directory listing.! ! Syntax:!! FTP> LDIR [local_spec]!--# ROUTINE local_directory_listing@ PARAMETER P1, LABEL = LOCAL_SPEC, VALUE (LIST, TYPE = $FILE) QUALIFIER BRIEF QUALIFIER FULL# QUALIFIER OUTPUT, NONNEGATABLE, VALUE (TYPE = $FILE, REQUIRED) DISALLOW BRIEF AND FULL  dDEFINE VERB LLSn!++v! Description:! ! Local directory listing.!a ! Syntax: !l! FTP> LLS [local_spec]n!--l# ROUTINE local_directory_listingD@ PARAMETER P1, LABEL = LOCAL_SPEC, VALUE (LIST, TYPE = $FILE) QUALIFIER BRIEF, DEFAULT QUALIFIER FULL# QUALIFIER OUTPUT, NONNEGATABLE,s VALUE (TYPE = $FILE, REQUIRED) DISALLOW BRIEF AND FULLi iDEFINE VERB Exit SYNONYM Quite!++o! Description:! ! Leave the FTP utility !g ! Syntax:i!i ! FTP> EXIT !--o ROUTINE Exit_FTP NOPARAMETERS ODEFINE VERB HELP!++V! Description:!_5! Obtain help by looking up info in ftp help library.i!s ! Syntax: !c! FTP> HELP [Help_Line]m!--  ROUTINE ftp_help$ PARAMETER P1, LABEL = HELP_LINE, VALUE (TYPE = $REST_OF_LINE)( QUALIFIER REMOTE, SYNTAX=REMOTE_HELP QUALIFIER PAGE,NEGATABLE DISALLOW REMOTE AND PAGEDEFINE SYNTAX REMOTE_HELP0 ROUTINE remote_helpP DEFINE VERB Image SYNONYM Binary!++a! Description:!1:! Set the transfer type to Image. (Same as SET TYPE IMAGE)!1 ! Syntax:u!e ! FTP> IMAGE!--4 ROUTINE Set_Type_Image DEFINE VERB lcdt!++a! Description:!16! Change Local Directory (Same as SET LOCAL_DIRECTORY)!f ! Syntax:!2! FTP> LCD Pathk!--2" ROUTINE Change_Local_Directory* PARAMETER P1, LABEL = Local_Directory, PROMPT = "Local Directory",h VALUE (TYPE = $File, REQUIRED) fDEFINE VERB LPWD!++ ! Description:!MB! Show the current default directory on the local system. (Same as! SHOW LOCAL).!R ! Syntax: ! ! FTP> LPWD !--  ROUTINE Show_Local NOQUALIFIERS --DEFINE VERB Logout SYNONYM bye synonym logoffs!++u! Description:!.<! Logout of a user, but remain connected to the remote host.!e ! Syntax:t!S ! FTP> LOGOUTF!--E ROUTINE Log_out_User .DEFINE VERB LOGIN SYNONYM USER!++E! Description:!d%! Tell remote site which user to use.m! ! Syntax: !s"! FTP> LOGIN User_Name [User_Acct]!--  ROUTINE log_in_userd$ PARAMETER P1, LABEL = USER_NAME, PROMPT="Remote Username",E' VALUE (TYPE=$QUOTED_STRING, REQUIRED)2$! PARAMETER P2, LABEL = USER_ACCT! PROMPT="Remote Account",k! VALUE (TYPE=$QUOTED_STRING)5 QUALIFIER ACCOUNT, LABEL=USER_ACCT, NONNEGATABLE,' VALUE (TYPE=$QUOTED_STRING, REQUIRED)o> QUALIFIER ANONYMOUS, NONNEGATABLE, SYNTAX=LOG_IN_ANONYMOUS" QUALIFIER APASSWORD, NEGATABLE$ QUALIFIER PASSWORD, NONNEGATABLE LABEL=PASSWORD, ' VALUE (TYPE=$QUOTED_STRING, REQUIRED)m$ DISALLOW USER_NAME AND ANONYMOUS# DISALLOW PASSWORD AND APASSWORDvDEFINE SYNTAX LOG_IN_ANONYMOUS NOPARAMETERS( QUALIFIER ACCOUNT, LABEL = USER_ACCT' VALUE (TYPE=$QUOTED_STRING, REQUIRED)u. QUALIFIER ANONYMOUS, DEFAULT, NONNEGATABLE" QUALIFIER APASSWORD, NEGATABLE$ QUALIFIER PASSWORD, NONNEGATABLE LABEL=PASSWORD,u' VALUE (TYPE=$QUOTED_STRING, REQUIRED)a# DISALLOW PASSWORD AND APASSWORDx DEFINE VERB MODIFY!++c! Description:!T! ! Syntax:! ! FTP> MODIFY option!--_2 PARAMETER P1, LABEL = OPTION, PROMPT = "What",( VALUE(REQUIRED, TYPE = MODIFY_OPTIONS) DEFINE TYPE MODIFY_OPTIONS) KEYWORD ALIAS, SYNTAX = MODIFY_ALIAS TDEFINE SYNTAX MODIFY_ALIAS!++ ! Description:! ,! Modify an alias in the FTP alias database.!E ! Syntax:O!! FTP> MODIFY ALIAS name!-- ROUTINE modify_alias_cmd2 PARAMETER P1, LABEL = OPTION, PROMPT = "What",( VALUE(REQUIRED, TYPE = MODIFY_OPTIONS)G PARAMETER P2, LABEL = ALIAS_NAME, PROMPT = "Alias", VALUE(REQUIRED) H QUALIFIER HOST, VALUE(REQUIRED, TYPE = $QUOTED_STRING), NONNEGATABLE> QUALIFIER ACCOUNT, VALUE(REQUIRED, TYPE = $QUOTED_STRING), LABEL = USER_ACCT, NEGATABLE" QUALIFIER ANONYMOUS, NEGATABLE" QUALIFIER APASSWORD, NEGATABLEH QUALIFIER COMMAND, VALUE(REQUIRED, TYPE = $QUOTED_STRING), NEGATABLEL QUALIFIER DESCRIPTION, VALUE(REQUIRED, TYPE = $QUOTED_STRING), NEGATABLE% QUALIFIER LOG, DEFAULT, NEGATABLEU? QUALIFIER PASSWORD, VALUE(TYPE = $QUOTED_STRING), NEGATABLEE? QUALIFIER USERNAME, VALUE(REQUIRED, TYPE = $QUOTED_STRING),O LABEL = USER_NAME, NEGATABLE$ DISALLOW USER_NAME AND ANONYMOUS# DISALLOW PASSWORD AND APASSWORDF ADEFINE VERB Receive SYNONYM GetN!++O! Description:!L$! Get a remote file to a local file.!U ! Syntax:)!'! FTP> RECEIVE Remote_File [Local_File]I!--W!!! ROUTINE Get_File ROUTINE Multiple_Get& PARAMETER P1, LABEL = Remote_File,# Prompt = "From Remote File List",N- VALUE (List, TYPE=$Quoted_String, REQUIRED)N% PARAMETER P2, LABEL = Local_File,A Prompt="To Local File",  VALUE (TYPE = $File) QUALIFIER Append QUALIFIER BlockSize,. VALUE (TYPE = $NUMBER, DEFAULT=512), DEFAULT QUALIFIER ConfirmT QUALIFIER Hash, NEGATABLE  QUALIFIER LogE QUALIFIER Mode,") VALUE (TYPE = Mode_Qualifier, REQUIRED)O QUALIFIER Prompt QUALIFIER Recursive  QUALIFIER Retain QUALIFIER Structure,+ VALUE (TYPE = Struct_Qualifier, REQUIRED)T QUALIFIER Type,T) VALUE (TYPE = Type_Qualifier, REQUIRED)Y QUALIFIER WILD, Negatable !A2! Since only 2 structures avail only FILE is legal!# DISALLOW (APPEND AND Recursive)c' DISALLOW (APPEND AND Structure.VMS)l* DISALLOW (APPEND AND (NOT Local_FIle)) SDEFINE VERB Mount !++T! Description:!! Mount a remote volume !I ! Syntax:=!o! FTP> Mount nameE!--D ROUTINE Do_MOunt& PARAMETER P1, LABEL = Remote_File, Prompt="Remote Volume",E' VALUE (TYPE=$Quoted_String, REQUIRED)  QUALIFIER Log" !DEFINE VERB MReceive synonym MgetR!++! Description:!N/! Get a collection of files from a remote site.E! Usually based on a wild card. !L ! Syntax:M!,! FTP> MGET Remote_FileF!--P ROUTINE Multiple_Get& PARAMETER P1, LABEL = Remote_File,! Prompt="From Remote File List", - VALUE (LIST, TYPE=$Quoted_String, REQUIRED)Q% PARAMETER P2, LABEL = Local_File,F Prompt="To Local File", VALUE (TYPE = $File) QUALIFIER Appemݎ& MGFTP026.GyI[MGFTP.SOURCE]FTP_PARSE.CLD;15Op=-nd QUALIFIER BlockSize,. VALUE (TYPE = $NUMBER, DEFAULT=512), DEFAULT QUALIFIER Confirm  QUALIFIER Hash, NEGATABLE  QUALIFIER LogA QUALIFIER Mode,A) VALUE (TYPE = Mode_Qualifier, REQUIRED)O QUALIFIER Prompt QUALIFIER RecursiveO QUALIFIER Retain QUALIFIER Structure,+ VALUE (TYPE = Struct_Qualifier, REQUIRED)S QUALIFIER Type,S) VALUE (TYPE = Type_Qualifier, REQUIRED)& QUALIFIER WILD, Negatable, Default!i2! Since only 2 structures avail only FILE is legal!s# DISALLOW (APPEND AND Recursive)D' DISALLOW (APPEND AND Structure.VMS)s* DISALLOW (APPEND AND (NOT Local_FIle)) =DEFINE VERB Msend SYNONYM Mput!++=! Description:! .! Send a group of files to the remote machine.!" ! Syntax:U!D! FTP> MPUT Local_File!--N ROUTINE Multiple_SendO% PARAMETER P1, LABEL = Local_File,D Prompt="From Local File List",& VALUE (LIST, TYPE = $File, REQUIRED)& PARAMETER P2, LABEL = Remote_File, Prompt="To Remote File"= VALUE (TYPE=$Quoted_String) QUALIFIER Before( VALUE (DEFAULT="TODAY",type=$datetime) QUALIFIER SinceF( VALUE (DEFAULT="TODAY",type=$datetime) QUALIFIER Backup QUALIFIER CreatedE QUALIFIER Modified QUALIFIER Expired  QUALIFIER ConfirmU QUALIFIER Hash, NEGATABLEL QUALIFIER Prompt QUALIFIER Recursives QUALIFIER Retain QUALIFIER Logt QUALIFIER Mode,S) VALUE (TYPE = Mode_Qualifier, REQUIRED)d QUALIFIER Structure,+ VALUE (TYPE = Struct_Qualifier, REQUIRED)R QUALIFIER Type,O) VALUE (TYPE = Type_Qualifier, REQUIRED)  QUALIFIER Unique, NEGATABLE & QUALIFIER WILD, Negatable, Default7 DISALLOW ANY2 ( Created, Backup, Modified, Expired)N TDEFINE Verb Noop!++N! Description:! *! Send NOOP command to the remote machine.!V ! Syntax:T!" ! FTP> NOOPU!--S ROUTINE Noop DEFINE VERB On!++! Description:! &! Handle special situations specially.!N ! Syntax: !U! FTP> ON ConditionU!--A: PARAMETER P1, LABEL = Condition, PROMPT = "Condition",( VALUE (TYPE = On_Conditions, REQUIRED) DEFINE TYPE On_Conditions) KEYWORD Control_C, SYNTAX = On_Control_Ce" KEYWORD Error, SYNTAX = On_Error) KEYWORD Severe_ERROR, SYNTAX = On_Severe% KEYWORD Warning, SYNTAX = On_WarningO NDEFINE SYNTAX On_Control_C!++ ! Description:! 4! Describe what to do when the user enters Control-C!O ! Syntax:A!E! FTP> ON CONTROL_C Action!--T$ PARAMETER P1, LABEL = Condition, VALUE (REQUIRED)! PARAMETER P2, LABEL = Action,N& VALUE (TYPE = On_ControlC, REQUIRED) DEFINE TYPE On_ControlC,+ KEYWORD Abort, SYNTAX = On_ControlC_AbortE0 KEYWORD Continue, SYNTAX = On_ControlC_Continue) KEYWORD Exit, SYNTAX = On_ControlC_ExitI ,DEFINE SYNTAX On_ControlC_AbortE!++ ! Description:!O>! When a Control_C happens, just abort whatever you are doing.! ! Syntax:T!E! FTP> ON CONTROL_C ABORTS!--  ROUTINE On_ControlC_AbortE A"DEFINE SYNTAX On_ControlC_Continue!++R! Description:!SA! When a Control_C happens, just continue whatever you are doing.D!O ! Syntax: !A! FTP> ON CONTROL_C CONTINUE!-- ROUTINE On_ControlC_Continue oDEFINE SYNTAX On_ControlC_Exit!++m! Description:!y ! When a Control_C happens, exit!R ! Syntax:!! FTP> ON CONTROL_C EXIT!--  ROUTINE On_ControlC_Exit DEFINE SYNTAX On_Error!++! Description:!P:! Describe what to do when the utility encounters an ERROR! ! Syntax:R!t! FTP> ON ERROR Action!--e$ PARAMETER P1, LABEL = Condition, VALUE (REQUIRED)! PARAMETER P2, LABEL = Action,L# VALUE (TYPE = On_Error, REQUIRED)" DEFINE TYPE On_Error( KEYWORD Abort, SYNTAX = On_Error_Abort& KEYWORD Exit, SYNTAX = On_Error_Exit DEFINE SYNTAX On_Error_Abort!++ ! Description:! =! When an Error happens, Abort and return to the FTP> prompt.a!i ! Syntax:D!! FTP> ON ERROR Abort,!--A ROUTINE On_Error_Abort EDEFINE SYNTAX On_Error_Exit!++A! Description:!a-! When an Error happens, exit the FTP utilityl!D ! Syntax: !A! FTP> ON ERROR EXIT!--, ROUTINE On_Error_ExitE EDEFINE SYNTAX On_Severec!++o! Description:! A! Describe what to do when the utility encounters a SEVERE Error.! ! Syntax:a!c! FTP> ON SEVERE ActionE!--r$ PARAMETER P1, LABEL = Condition, VALUE (REQUIRED)! PARAMETER P2, LABEL = Action,S$ VALUE (TYPE = On_Severe, REQUIRED) DEFINE TYPE On_Severee) KEYWORD Abort, SYNTAX = On_Severe_Abortw' KEYWORD Exit, SYNTAX = On_Severe_ExitN DEFINE SYNTAX On_Severe_AbortS!++! Description:!C! When a Severe Error happens, Abort and return to the FTP> prompt.a!e ! Syntax: !S! FTP> ON SEVERE ABORT!--  ROUTINE On_Severe_Aborts _DEFINE SYNTAX On_Severe_Exit!++A! Description:! 3! When a Severe Error happens, exit the FTP utility! ! Syntax: !i! FTP> ON SEVERE EXITr!--  ROUTINE On_Severe_Exit TDEFINE SYNTAX On_Warning!++:! Description:!m;! Describe what to do when the utility encounters a Warningt! ! Syntax:I!V! FTP> ON WARNING Action!--R$ PARAMETER P1, LABEL = Condition, VALUE (REQUIRED)! PARAMETER P2, LABEL = Action,% VALUE (TYPE = On_Warning, REQUIRED)D DEFINE TYPE On_Warning* KEYWORD Abort, SYNTAX = On_Warning_Abort/ KEYWORD Continue, SYNTAX = On_Warning_Continuep( KEYWORD Exit, SYNTAX = On_Warning_Exit NDEFINE SYNTAX On_Warning_Abort!++ ! Description:!e>! When a warning happens, Abort and return to the FTP> prompt.!E ! Syntax:F!,! FTP> ON WARNING ABORT !--A ROUTINE On_Warning_Abort E!DEFINE SYNTAX On_Warning_Continue !++L! Description:!A>! When a Warning happens, continue as though nothing happened.!I ! Syntax:l!D! FTP> ON WARNING CONTINUE!--A ROUTINE On_Warning_Continuea ,DEFINE SYNTAX On_Warning_ExitE!++! Description:!).! When a Warning happens, exit the FTP utility! ! Syntax:o!! FTP> ON WARNING EXIT!-- ROUTINE On_Warning_Exiti t DEFINE VERB Open synonym connect!++R!! Description: (Same as SET HOST) !a3! Change the remote host to which we are connected.o!F ! Syntax:m!"! FTP> OPEN Host!--U ROUTINE do_connect_to_host PARAMETER P1, LABEL = HOST,, PROMPT="Host Name",  VALUE (REQUIRED)# QUALIFIER ACCOUNT, NONNEGATABLEU LABEL=USER_ACCT,' VALUE (TYPE=$QUOTED_STRING, REQUIRED)T% QUALIFIER ANONYMOUS, NONNEGATABLE" QUALIFIER APASSWORD, NEGATABLE$ QUALIFIER PASSWORD, NONNEGATABLE LABEL=PASSWORD,t' VALUE (TYPE=$QUOTED_STRING, REQUIRED)r1 QUALIFIER PORT, VALUE(REQUIRED), NONNEGATABLET$ QUALIFIER USERNAME, NONNEGATABLE LABEL=USER_NAME,' VALUE (TYPE=$QUOTED_STRING, REQUIRED)o$ DISALLOW USER_NAME AND ANONYMOUS7 DISALLOW USER_ACCT AND NOT (USER_NAME OR ANONYMOUS)6 DISALLOW PASSWORD AND NOT (USER_NAME OR ANONYMOUS)7 DISALLOW APASSWORD AND NOT (USER_NAME OR ANONYMOUS)e, DISALLOW NEG APASSWORD AND NOT ANONYMOUS# DISALLOW PASSWORD AND APASSWORDE EDEFINE VERB Password!++N! Description:!c-! Many FTP utilities have a password command.r9! This one merely tells the user to use the login commandc ! instead.! ! Syntax:n!r! FTP> PASSWORD!--A ROUTINE Use_LoginO NOPARAMETERS UDEFINE VERB PWDT!++! Description:!L<! Show some information about the host that we are currently&! connected to. (Same as SHOW REMOTE)! ! Syntax:! ! FTP> PWD!-- ROUTINE Show_Remote NOQUALIFIERS DEFINE VERB Quote!++! Descript ז# MGFTP026.GyI[MGFTP.SOURCE]FTP_PARSE.CLD;15Op?<ion:!8! Send a particular command to the remote site's Command! interpreter.!Q ! Syntax:Y!n! FTP> QUOTE Command!--n ROUTINE Send_Quoted_Line& PARAMETER P1, LABEL = Quoted_Line, Prompt="Remote Command",( VALUE (TYPE = $Rest_Of_Line, REQUIRED) "DEFINE VERB REMOTEHELP!++Q! Description:!a'! Receive Help from the remote machine.T!A ! Syntax:q!e! FTP> REMOTEHELP [HELP_Line]H!--a ROUTINE remote_helpr$ PARAMETER P1, LABEL = HELP_LINE, VALUE (TYPE = $REST_OF_LINE) RDEFINE VERB Rename synonym Mvr!+++! Description:!&! Rename a file on the remote machine.!a ! Syntax:!y! FTP> RENAME Old_File New_FileF!-- ROUTINE Rename_FileF# PARAMETER P1, LABEL = Old_File,e Prompt="Old Filename",' VALUE (TYPE=$Quoted_String, REQUIRED)i# PARAMETER P2, LABEL = New_File,R Prompt="New Filename",' VALUE (TYPE=$Quoted_String, REQUIRED)  UDEFINE VERB Send SYNONYM Put!++! Description:!D"! Send a file to a remote machine.!E ! Syntax:O!$! FTP> SEND Local_File [Remote_File]!--A ROUTINE Multiple_SendF!!! ROUTINE Send_File% PARAMETER P1, LABEL = Local_File,g Prompt="From Local File",o% VALUE (LIst,TYPE = $File, REQUIRED)e& PARAMETER P2, LABEL = Remote_File, Prompt="To Remote File"u VALUE (TYPE=$Quoted_String)T QUALIFIER Before( VALUE (DEFAULT="TODAY",type=$datetime) QUALIFIER Since ( VALUE (DEFAULT="TODAY",type=$datetime) QUALIFIER Backup QUALIFIER Created QUALIFIER Modified QUALIFIER ExpiredE QUALIFIER Confirme QUALIFIER Hash, NEGATABLE_ QUALIFIER LogF QUALIFIER Mode, ) VALUE (TYPE = Mode_Qualifier, REQUIRED)N QUALIFIER Prompt QUALIFIER Recursive  QUALIFIER Retain QUALIFIER Structure,+ VALUE (TYPE = Struct_Qualifier, REQUIRED)e QUALIFIER Type,) VALUE (TYPE = Type_Qualifier, REQUIRED)S& QUALIFIER WILD, Negatable, DEFAULT QUALIFIER Unique, NEGATABLEe7 DISALLOW ANY2 ( Created, Backup, Modified, Expired)LDEFINE TYPE Mode_Qualifier KEYWORD Blocku KEYWORD Compressed KEYWORD StreamDEFINE TYPE Struct_Qualifier KEYWORD File KEYWORD Record KEYWORD VMSoDEFINE TYPE Type_Qualifier; KEYWORD ASCII Value (Type=ascii_vals,Default=NON_PRINT)  KEYWORD EBCDIC KEYWORD IMAGEA EDEFINE VERB SetA!++C! Description:! &! Set or modify various option in FTP.!E ! Syntax: !L! FTP> SET OptionG!--E PARAMETER P1, LABEL = OPTION,E PROMPT="What",& VALUE (TYPE = SET_OPTions, REQUIRED) DEFINE TYPE SET_OPTIONS # KEYWORD ACCOUNT, SYNTAX = ACCTl: KEYWORD AUTOPROMPT, SYNTAX = SET_AUTOPROMPT,NEGATABLE0 KEYWORD BATCH, SYNTAX = SET_BATCH,NEGATABLE. KEYWORD BELL, SYNTAX = SET_BELL,NEGATABLE$ KEYWORD CASE, SYNTAX = SET_CASE: KEYWORD CHECK_TYPE, SYNTAX = SET_CHECK_TYPE,NEGATABLE4 KEYWORD COMMAND, SYNTAX = SET_COMMAND,NEGATABLE4 KEYWORD CONFIRM, SYNTAX = SET_CONFIRM,NEGATABLE) KEYWORD DEFAULT, SYNTAX = SET_REMOTEI. KEYWORD HASH, SYNTAX = SET_HASH,NEGATABLE$ KEYWORD HOST, SYNTAX = SET_HOST7 KEYWORD LOCAL_DEFAULT_DIRECTORY, SYNTAX = SET_LOCALl$ KEYWORD MODE, SYNTAX = SET_MODE4 KEYWORD PASSIVE, SYNTAX = SET_PASSIVE,NEGATABLE= KEYWORD PATH_PARSING, SYNTAX = SET_PATH_PARSING,NEGATABLE ; KEYWORD PROMPT, SYNTAX = SET_PROMPT, VALUE(DEFAULT="")G1 KEYWORD PROTECTION, Syntax = SET_PROTECTION,A VALUE (LIST,TYPE=PROTECTION)0 KEYWORD QUIET, SYNTAX = SET_QUIET,NEGATABLE9 KEYWORD REMOTE_DEFAULT_DIRECTORY, SYNTAX = SET_REMOTES0 KEYWORD REPLY, SYNTAX = SET_REPLY,NEGATABLE2 KEYWORD RETAIN, SYNTAX = SET_RETAIN,NEGATABLE+ KEYWORD STRUCTURE, SYNTAX = SET_STRUCTe$ KEYWORD TYPE, SYNTAX = SET_TYPE1 KEYWORD VERIFY SYNTAX = SET_VERIFY,NEGATABLE2 DEFINE TYPE PROTECTION KEYWORD SYSTEM VALUE1 KEYWORD GROUP VALUE KEYWORD OWNER VALUE KEYWORD WORLD VALUE TDEFINE SYNTAX ACCT!++f! Description:!&! Set the account on the Remote system!t ! Syntax:r!o! FTP> SET ACCOUNT New_Account!--H ROUTINE Set_Account # PARAMETER P1, LABEL = Option, # VALUE (REQUIRED,Type=Set_Options)I( PARAMETER P2, LABEL = New_Account, Prompt="Remote Account",' VALUE (TYPE=$Quoted_String, REQUIRED)t hDEFINE SYNTAX SET_AUTOPROMPT!++! Description:!E.! Turn on prompting for destination filenames.!Y ! Syntax:!E! FTP> SET [NO]AUTOPROMPTl!--t ROUTINE set_autoprompt DEFINE SYNTAX SET_BATCHG!++e! Description:!4! Set, or reset "Batch mode", wherein file transfers+! prompt the user to retry if Batch is off.!A ! Syntax:Q!E! FTP> SET [NO]BATCH!--P ROUTINE set_batchE CDEFINE SYNTAX SET_BELL!++"! Description:!$;! Set, or reset "Bell mode", wherein bell is rung at end ofG ! a command.! ! Syntax:E!T! FTP> SET [NO]BELL !--F ROUTINE set_bell LDEFINE SYNTAX SET_CASE!++ ! Description:!R4! Change the way in which we handle case conversion.!E ! Syntax: ! ! FTP> SET CASE ValueI!--E# PARAMETER P1, LABEL = OPTION,A# VALUE (REQUIRED,TYPE=SET_OPTIONS)P" PARAMETER P2, LABEL = VALUE, PROMPT="Lower,Upper,Normal?",L+ VALUE (TYPE = SET_CASE_OPTIONS, REQUIRED)P DEFINE TYPE SET_CASE_OPTIONS+ KEYWORD LOWER, SYNTAX = SET_CASE_LOWER - KEYWORD NORMAL, SYNTAX = SET_CASE_NORMAL + KEYWORD UPPER, SYNTAX = SET_CASE_UPPER  UDEFINE SYNTAX SET_CASE_LOWER!++! Description:!R6! Set the case conversion to be lower case conversion.! We lower-case all parameters. !> ! Syntax:i!! FTP> SET CASE LOWER !--  ROUTINE LOWER_CASE DEFINE SYNTAX SET_CASE_NORMAL_!++N! Description:!P;! Set the case conversion to be the normal case conversion.$! (.i.e we fight with CLI routines.)! ! Syntax::! ! FTP> SET CASE NORMAL!--P ROUTINE NORMAL_CASEy xDEFINE SYNTAX SET_CASE_UPPER!++-! Description:!i6! Set the case conversion to be upper case conversion.!h ! Syntax:U!E! FTP> SET CASE UPPERP!--) ROUTINE UPPER_CASE DEFINE SYNTAX SET_CHECK_TYPE!++(! Description:!LH! Set, or reset "type-checking mode", wherein the TYPE is detected for aC! PUT by checking the file attributes, e.g., text files are sent asR ! TYPE AN.!ED! Note: The SET TYPE command (and all of its alias variants) does an! implicit SET NOCHECK_TYPE.!R ! Syntax:P! ! FTP> SET [NO]CHECK_TYPE!--U ROUTINE set_check_type IDEFINE SYNTAX SET_COMMAND,!++T! Description:! <! Set, or reset the display of the lower level FTP commands.!U ! Syntax:)!E! FTP> SET [NO]COMMAND!--A ROUTINE set_command= UDEFINE SYNTAX SET_CONFIRMS!++M! Description:!I?! Set, or reset "Confirm mode", wherein multiple-file transfersR7! prompt the user for permission to transfer each file.i!o ! Syntax:e! ! FTP> SET [NO]CONFIRM!-- ROUTINE set_confirm> CDEFINE SYNTAX SET_HASH!++I! Description:!IA! Set, reset, or toggle the hash display, or change the charactere!e ! Syntax:r!t! FTP> SET [NO]HASHL!--N ROUTINE set_hash oDEFINE SYNTAX SET_HOST!++A! Description:! 3! Change the remote host to which we are connected.P! ! Syntax: !L! FTP> SET HOST Host!--  ROUTINE do_connect_to_host2 PARAMETER P1, LABEL = OPTION, VALUE (REQUIRED) PARAMETER P2, LABEL = HOST,  PROMPT="Host Name",U VALUE (REQUIRED)# QUALIFIER ACCOUNT, NONNEGATABLEO LABEL=USER_ACCT,' VALUE (TYPE=$QUOTED_STRING, REQUIRED)E% QUALIFIER ANONYMOUS, NONNEGATABLEA" QUALIFIER APASSWORD, NEGATABLE`kU< MGFTP026.GyI[MGFTP.SOURCE]FTP_PARSE.CLD;15OpK$ QUALIFIER PASSWORD, NONNEGATABLE LABEL=PASSWORD,r' VALUE (TYPE=$QUOTED_STRING, REQUIRED)l$ QUALIFIER USERNAME, NONNEGATABLE LABEL=USER_NAME,' VALUE (TYPE=$QUOTED_STRING, REQUIRED)c$ DISALLOW USER_NAME AND ANONYMOUS7 DISALLOW USER_ACCT AND NOT (USER_NAME OR ANONYMOUS)I6 DISALLOW PASSWORD AND NOT (USER_NAME OR ANONYMOUS)7 DISALLOW APASSWORD AND NOT (USER_NAME OR ANONYMOUS), DISALLOW NEG APASSWORD AND NOT ANONYMOUS# DISALLOW PASSWORD AND APASSWORDm EDEFINE SYNTAX SET_LOCALt!++ ! Description:!L:! Change Local Directory (.i.e DCL $ SET DEFAULT command).!c ! Syntax:N! ! FTP> SET LOCAL_DIRECTORY Pathr!-- " ROUTINE change_local_directory! PARAMETER P1, LABEL = OPTION,E# VALUE (REQUIRED,TYPE=SET_OPTIONS)t* PARAMETER P2, LABEL = LOCAL_DIRECTORY, PROMPT = "Local Directory",e. VALUE (TYPE = $FILE, REQUIRED) RDEFINE SYNTAX SET_MODE!++ ! Description:!r%! Change the Mode transfer parameter. !l ! Syntax:L!E! FTP> SET MODE Mode!--c ROUTINE SET_MODE! PARAMETER P1, LABEL = OPTION, # VALUE (REQUIRED,TYPE=SET_OPTIONS)a" PARAMETER P2, PROMPT = "Mode",$ VALUE (TYPE = MODE_TYPE, REQUIRED) DEFINE TYPE MODE_TYPE ) KEYWORD BLOCK, SYNTAX = BLOCK_MODEO2 KEYWORD COMPRESSED, SYNTAX = COMPRESSED_MODE+ KEYWORD STREAM, SYNTAX = STREAM_MODE  UDEFINE SYNTAX BLOCK_MODE!++ ! Description:!U5! We want to set the MODE transfer parameter to BLOCKi! ! Syntax:c!e! FTP> SET MODE BLOCKg!--s ROUTINE set_mode_block iDEFINE SYNTAX COMPRESSED_MODES!++u! Description:!L:! We want to set the MODE transfer parameter to Compressed! ! Syntax:!e! FTP> SET MODE COMPRESSED!--  ROUTINE set_mode_compressed yDEFINE SYNTAX STREAM_MODEa!++e! Description:! 5! We want to set the MODE transfer parameter to BLOCK!r ! Syntax:L!l! FTP> SET MODE STREAM!--T ROUTINE set_mode_streamA EDEFINE SYNTAX SET_REMOTE!++ ! Description:!i!! Change Remote DEFAULT Directory! ! Syntax: !o4! FTP> SET REMOTE_DEFAULT_DIRECTORY Remote_Directory!-- # ROUTINE change_remote_directory= NOQUALIFIERS! PARAMETER P1, LABEL = OPTION,e# VALUE (REQUIRED,TYPE=SET_OPTIONS)F+ PARAMETER P2, LABEL = REMOTE_DIRECTORY,L Prompt="Remote Directory", L' VALUE (TYPE=$QUOTED_STRING, REQUIRED)  UDEFINE SYNTAX SET_PASSIVEE!++t! Description:!eB! Set or reset "Passive mode", wherein file transfers are preceded! with the PASV command.!Q ! Syntax:E!R! FTP> SET [NO]PASSIVE!--  ROUTINE set_passivei NOQUALIFIERS UDEFINE SYNTAX SET_PATH_PARSING!++F! Description:!,D! Set, or reset "Path_Parsing mode", wherein multiple-file transfers! Parse the file list.! ! Syntax::! ! FTP> SET [NO]PATH_PARSINGr!--  ROUTINE set_path_parsing TDEFINE SYNTAX SET_PROMPT!++p! Description:!n$! Set the FTP command prompt string.!i ! Syntax:n!p! FTP> SET PROMPT=prompt!--  ROUTINE set_prompt DEFINE SYNTAX SET_PROTECTION!++P! Description:!,! Change the File protection!R ! Syntax:! ! FTP> SET Protecion=nnn FileY!--C ROUTINE do_chmod8 PARAMETER P1, LABEL = OPTION, PROMPT = "Protection",# VALUE (REQUIRED,TYPE=SET_OPTIONS)Y- PARAMETER P2, PROMPT = "Remote Filename",S LABEL=REMOTE_FILE,. VALUE (REQUIRED, LIST, TYPE =$QUOTED_STRING) QUALIFIER CONFIRMrB QUALIFIER DEFAULT, NONNEGATABLE, SYNTAX=SET_PROTECTION_DEFAULT QUALIFIER LOGo& QUALIFIER WILD, NEGATABLE, DEFAULT) QUALIFIER VALUE, PLACEMENT=POSITIONALn$DEFINE SYNTAX SET_PROTECTION_DEFAULT PARAMETER P1, LABEL = OPTION# VALUE (REQUIRED,TYPE=SET_OPTIONS)n, QUALIFIER DEFAULT, NONNEGATABLE, DEFAULT QUALIFIER LOG_ QUALIFIER VALUEE SDEFINE SYNTAX SET_QUIET!++! Description:!&! Set, reset, or toggle the Quiet mode!e ! Syntax: !n! FTP> SET [NO]QUIET!--T ROUTINE set_quiet DEFINE SYNTAX SET_REPLY_!++E! Description:! ;! Set, or reset the display of the lower level FTP Replies.r!C ! Syntax:u!c! FTP> SET [NO]REPLY!--i ROUTINE set_replyA DEFINE SYNTAX SET_RETAIN!++! Description:!n;! Enable, or disable the retention of file version numbers.e!i ! Syntax:!h! FTP> SET [NO]RETAIN !-- ROUTINE set_retain! PARAMETER P1, LABEL = OPTION,T# VALUE (REQUIRED,TYPE=SET_OPTIONS)A QUALIFIER DCL,NONNEGATABLE PDEFINE SYNTAX SET_STRUCT!++e! Description:! *! Change the Structure Transfer parameter.!c ! Syntax:! ! FTP> SET STRUCTURE Structure!--A ROUTINE set_structureE! PARAMETER P1, LABEL = OPTION,P# VALUE (REQUIRED,TYPE=SET_OPTIONS)E' PARAMETER P2, PROMPT = "Structure", & VALUE (TYPE = STRUCT_TYPE, REQUIRED) DEFINE TYPE STRUCT_TYPEA) KEYWORD FILE, SYNTAX = STRUCT_FILE- KEYWORD RECORD, SYNTAX = STRUCT_RECORDe' KEYWORD VMS, SYNTAX = STRUCT_VMS> DEFINE SYNTAX STRUCT_FILET!++n! Description:!E2! Set the structure transfer parameter to be file.! ! Syntax:o!a! FTP> SET STRUCTURE FILEl!-- ROUTINE set_structure_file TDEFINE SYNTAX STRUCT_RECORDE!++! Description:!n4! Set the structure transfer parameter to be Record.! ! Syntax:i!y! FTP> SET STRUCTURE RECORD!-- ROUTINE set_structure_record EDEFINE SYNTAX STRUCT_VMS!++ ! Description:!U>! Set the structure transfer parameter to be VMS (for Multinet! compatibility).E! ! Syntax:E!P! FTP> SET STRUCTURE VMS!--S ROUTINE set_structure_vmsO EDEFINE SYNTAX SET_TYPE!++N! Description:! %! Change the TYPE transfer parameter.! ! Syntax:v! ! FTP> SET TYPE Type!--t! PARAMETER P1, LABEL = OPTION,t# VALUE (REQUIRED,TYPE=SET_OPTIONS) " PARAMETER P2, PROMPT = "Type",$ VALUE (TYPE = TYPE_TYPE, REQUIRED)DEFINE TYPE TYPE_TYPEa' KEYWORD ASCII, SYNTAX = ASCII_TYPEt' KEYWORD IMAGE, SYNTAX = IMAGE_TYPEE) KEYWORD EBCDIC, SYNTAX = EBCDIC_TYPE' KEYWORD LOCAL, SYNTAX = LOCAL_TYPEt :DEFINE SYNTAX ASCII_TYPE!++n! Description:!t*! Options for the TYPE transfer Parameter.!A ! Syntax:n!-"! FTP> SET TYPE ASCII [Ascii_Vals]!-- ROUTINE set_type_ascii! PARAMETER P1, LABEL = OPTION, # VALUE (REQUIRED,TYPE=SET_OPTIONS) " PARAMETER P2, PROMPT = "Type",$ VALUE (TYPE = TYPE_TYPE, REQUIRED)" PARAMETER P3, PROMPT = "Form", VALUE (TYPE = ASCII_VALS)X _DEFINE SYNTAX EBCDIC_TYPEN!++n! Description:! 1! In case some yoyo wants us to do EBCDIC. Ha...r!n ! Syntax: ! ! FTP> SET TYPE EBCDIC!-- ROUTINE set_type_ebcdic ADEFINE SYNTAX IMAGE_TYPE!++! Description:!n!! Set the transfer type to Image.t!: ! Syntax:n!W! FTP> SET TYPE IMAGEe!--h ROUTINE set_type_image yDEFINE SYNTAX LOCAL_TYPE!++O! Description:!O&! Options for the Type Local Parameter!A ! Syntax:g!i! FTP> SET TYPE LOCAL [Size]!--n ROUTINE set_type_local! PARAMETER P1, LABEL = OPTION, # VALUE (REQUIRED,TYPE=SET_OPTIONS)N PARAMETER P2,$ VALUE (TYPE = TYPE_TYPE, REQUIRED)1 PARAMETER P3, LABEL = SIZE, PROMPT = "Size", n" VALUE (TYPE = $NUMBER, REQUIRED) eDEFINE SYNTAX SET_VERIFY!++T! Description:!3! Turn command-procedure command echoing on or off.E! ! Syntax:R!T! FTP> SET VERIFYA!--R ROUTINE set_verify NDEFINE VERB Show!++E! Description:!U! Display the status of things! ! Syntax:E!N! FTP> SHOW Option!-- 0 PARAMETER P1, LABEL = Option, PROMPT = "What",( VALUE (TYPE = Show_Options, REQLZ MGFTP026.GyI[MGFTP.SOURCE]FTP_PARSE.CLD;15Op5&ZUIRED) DEFINE Type Show_Options' KEYWORD ALIAS, SYNTAX = SHOW_ALIASU1 KEYWORD AUTOPROMPT, SYNTAX = SHOW_AUTOPROMPTG' KEYWORD Batch, SYNTAX = Show_Batch=% KEYWORD Bell, SYNTAX = Show_BellW% KEYWORD Case, SYNTAX = Show_CaseU1 KEYWORD CHECK_TYPE, SYNTAX = SHOW_CHECK_TYPEA+ KEYWORD Command, SYNTAX = Show_Command)@ KEYWORD Condition_Handling, SYNTAX = Show_Condition_Handling+ KEYWORD CONFIRM, SYNTAX = SHOW_CONFIRMI' KEYWORD Default, SYNTAX = Show_RemE0 KEYWORD File_Status, SYNTAX = Show_file_Stat% KEYWORD Hash, SYNTAX = Show_Hash% KEYWORD Host, SYNTAX = Show_Host # KEYWORD KEY, SYNTAX = SHOW_KEY 8 KEYWORD Local_Default_Directory, SYNTAX = Show_Local% KEYWORD Mode, SYNTAX = Show_ModeW+ KEYWORD Passive, SYNTAX = Show_Passiveo4 KEYWORD Path_Parsing, SYNTAX = Show_Path_Parsing1 KEYWORD Parameters, SYNTAX = Show_Parameters2 KEYWORD Protection, Syntax = SHOW_Protection,' KEYWORD Quiet, SYNTAX = Show_Quiet 7 KEYWORD Remote_Default_Directory, SYNTAX = Show_Remt' KEYWORD Reply, SYNTAX = Show_Replyy) KEYWORD Retain, SYNTAX = Show_Retain ) KEYWORD Status, SYNTAX = Show_Status / KEYWORD Structure, SYNTAX = Show_Structure. KEYWORD SYSTEM_Type, SYNTAX = Show_SYSType+ KEYWORD Summary, SYNTAX = Show_Summarya% KEYWORD Type, SYNTAX = Show_Typee) KEYWORD VERIFY, SYNTAX = SHOW_VERIFYH _DEFINE SYNTAX SHOW_ALIAS!++e! Description:!E)! List aliases in the FTP alias database.R!_ ! Syntax:R!E! FTP> SHOW ALIAS name!-- ROUTINE show_alias_cmd2 PARAMETER P1, LABEL = OPTION, PROMPT = "What",( VALUE (REQUIRED, TYPE = SHOW_OPTIONS)L PARAMETER P2, LABEL = ALIAS_NAME, PROMPT = "Alias", VALUE(DEFAULT = "*")C QUALIFIER ACCOUNT, VALUE(DEFAULT = "*", TYPE = $QUOTED_STRING),E LABEL = USER_ACCT, NEGATABLE" QUALIFIER ANONYMOUS, NEGATABLE QUALIFIER BRIEFDG QUALIFIER DESCRIPTION, VALUE(DEFAULT = "*", TYPE = $QUOTED_STRING),f NEGATABLEt QUALIFIER FULLH QUALIFIER HOST, VALUE(REQUIRED, TYPE = $QUOTED_STRING), NONNEGATABLED QUALIFIER USERNAME, VALUE(DEFAULT = "*", TYPE = $QUOTED_STRING), LABEL = USER_NAME, NEGATABLE DISALLOW BRIEF AND FULLe$ DISALLOW ANONYMOUS AND USER_NAME oDEFINE SYNTAX SHOW_AUTOPROMPTi!++! Description:!e6! Display the current setting of the autoprompt switch!t ! Syntax:m!! FTP> SHOW AUTOPROMPT!--  ROUTINE show_autopromptt )DEFINE SYNTAX Show_Bell !++L! Description:! 0! Display the current setting of the Bell switch!F ! Syntax:e! ! FTP> SHOW Bell!--A ROUTINE Show_Bello DEFINE SYNTAX Show_Batch!++T! Description:!r1! Display the current setting of the Batch switche!s ! Syntax:U!F! FTP> SHOW BatchL!--  ROUTINE Show_Batch DEFINE SYNTAX Show_CaseR!++! Description:!5! Display the current setting of the case conversion.F! ! Syntax:a!,! FTP> SHOW CASE!--  ROUTINE Show_Case  IDEFINE SYNTAX SHOW_CHECK_TYPEM!++e! Description:!I2! Show the current state of the CHECK_TYPE switch.! ! Syntax:! ! FTP> SHOW CHECK_TYPE!--  ROUTINE show_check_type  eDEFINE SYNTAX Show_Command!++ ! Description:! ,! Show the current state of command display.!i ! Syntax:u!N! FTP> SHOW COMMANDR!--D ROUTINE Show_Command %DEFINE SYNTAX Show_Condition_Handling!++ ! Description:!uF! Show the current state of what we are gonna do to handle conditions.! ! Syntax: !I! FTP> SHOW CONDITIONS!--U ROUTINE Show_ConditionsE DEFINE SYNTAX SHOW_CONFIRM!++ ! Description:! !! Show the current confirm state.M! ! Syntax:E!U! FTP> SHOW CONFIRM !--W ROUTINE SHOW_CONFIRM HDEFINE SYNTAX Show_File_Stat!++A! Description:!B"! Show the status of a remote file!E ! Syntax:R!H!! FTP> SHOW FILE_STATUS File_SpecN!--B ROUTINE Show_File_Status! PARAMETER p1, Label = Option,W' VALUE (TYPE = Show_Options, REQUIRED)B$ PARAMETER P2, Label = File_Spec, Prompt = "File Name",H' VALUE (TYPE=$Quoted_String, REQUIRED)R ODEFINE SYNTAX Show_Hash !++W! Description:!I$! Display whether Hash is on or off.! ! Syntax:A! ! FTP> SHOW HASH!--A ROUTINE Show_HashS NOQUALIFIERS EDEFINE SYNTAX Show_HostX!++T! Description:!A ! Display information about Host!E ! Syntax:A!(! FTP> SHOW HOST!--R ROUTINE Show_Host  NOQUALIFIERS ADEFINE SYNTAX Show_Key!++ ! Description:!Y! Shows key definitions.! ! Syntax:E!E! FTP> SHOW/KEYY!--T Routine ftp_show_key+ Parameter P1,Label=OPTION, value(required) > Parameter P2,Label=KEY_NAME, prompt="Keyname",value(required)2 Qualifier ALL, nonnegatable, syntax=show_all_keys Qualifier FULL, nonnegatableE? Qualifier STATE, LABEL=IF_STATE, nonnegatable, value(required)N Disallow KEY_NAME and ALLdefine syntax show_all_keysN Routine ftp_show_key+ Parameter P1,Label=OPTION, value(required)i :DEFINE SYNTAX Show_Local!++R! Description:! -! Show some information about the local host.-! ! Syntax: !_! FTP> SHOW LOCALA!--  ROUTINE Show_Local NOQUALIFIERS SDEFINE SYNTAX Show_Passive!++ ! Description:!,3! Display the current setting of the PASSIVE switcht!g ! Syntax:t!h! FTP> SHOW PassiveU!--M ROUTINE Show_Passive NOQUALIFIERS tDEFINE SYNTAX Show_Path_ParsingY!++y! Description:!SE! Display the current setting of the Path_Parsing transfer parameter. !_ ! Syntax:e! ! FTP> SHOW Path_Parsing!--e ROUTINE Show_Path_Parsinga NOQUALIFIERS uDEFINE SYNTAX Show_Modeo!++! Description:!=! Display the current setting of the Mode transfer parameter.S!A ! Syntax:!"! FTP> SHOW MODE!--  ROUTINE Show_Modee NOQUALIFIERS nDEFINE SYNTAX Show_Parameters!++t! Description:!T>! Display the current settting of all the transfer parameters.! ! Syntax:c!t! FTP> SHOW PARAMETERS!--  ROUTINE Show_Parameterso NOQUALIFIERS DEFINE SYNTAX Show_Prompt-!++ ! Description:!A1! Display the current setting of the prompt-mode.P! ! Syntax:E!2! FTP> SHOW PROMPT!--T ROUTINE Show_Prompt NOQUALIFIERS ADEFINE SYNTAX Show_ProtectionI!++P! Description:!8! Display the current settting of the default Protection!M ! Syntax: !E! FTP> SHOW Protection!--P ROUTINE Show_Protection  NOQUALIFIERS EDEFINE SYNTAX Show_Quiet!++o! Description:!a%! Display whether Quiet is on or off.o! ! Syntax:c! ! FTP> SHOW Quiet>!--y ROUTINE Show_Quiet NOQUALIFIERS DEFINE SYNTAX Show_Rem!++E! Description:!R<! Show some information about the host that we are currently! connected to. !v ! Syntax: !.! FTP> SHOW REMOTE!--n ROUTINE Show_Remote NOQUALIFIERS LDEFINE SYNTAX Show_Reply!++y! Description:! ,! Show the current state of command display.!h ! Syntax:e!o! FTP> SHOW REPLYc!--s ROUTINE Show_Reply DEFINE SYNTAX Show_Retain!++O! Description:! /! Show the current state of Verstion retention.o! ! Syntax:o!e! FTP> SHOW Retain!--  ROUTINE Show_Retaint fDEFINE SYNTAX Show_Status !++a! Description:!x7! Issue the FTP STAT command on the control connection.E!m ! Syntax:l!f! FTP> SHOW STATUS!--  ROUTINE Show_StatusK NOQUALIFIERS PDEFINE SYNTAX Show_Structure!++-! Description:!_B! Display the current setting of the Structure transfer parameter.! ! Syntax:e!h! FTP> SHOW STRUCTUREl!--F RO*Yq MGFTP026.GyI[MGFTP.SOURCE]FTP_PARSE.CLD;15Op iUTINE Show_Structure NOQUALIFIERS CDEFINE SYNTAX Show_SYSType!++m! Description:!N7! Issue the FTP SYST command on the control connection.e!C ! Syntax:"!h! FTP> SHOW SYSTyper!--r ROUTINE Show_SYSType NOQUALIFIERS rDEFINE SYNTAX Show_Summary!++! Description:!I*! Show a summary of last file transferred.!S ! Syntax:A!! FTP> SHOW SUMMARY!--  ROUTINE Show_Summary NOQUALIFIERS gDEFINE SYNTAX Show_Typey!++r! Description:!O<! Display the current setting of the Type transfer parameter!+ ! Syntax:i!o! FTP> SHOW TYPE!--m ROUTINE Show_Typee NOQUALIFIERS yDEFINE SYNTAX SHOW_VERIFY !++! Description:!o?! Display whether command-procedure command echoing is enabled.E! ! Syntax:E!2! FTP> SHOW VERIFY!--T ROUTINE SHOW_VERIFYR NOQUALIFIERS EDEFINE VERB Spawn SYNONYM Local=!++A! Description:!=)! Perform a DCL (or MCR) command locally.N!M ! Syntax:A!L! FTP> spawn [command]!--N ROUTINE Spawn_ProcessS) PARAMETER P1, LABEL = Command_String,A VALUE (TYPE = $Rest_Of_Line)2 QUALIFIER Carriage_Control, NEGATABLE, DEFAULT QUALIFIER Cli, NONNEGATABLE, VALUE (TYPE = $File, REQUIRED)" QUALIFIER Input, NONNEGATABLE, VALUE (TYPE = $File, REQUIRED)# QUALIFIER Output, NONNEGATABLE, VALUE (TYPE = $File, REQUIRED)( QUALIFIER Keypad, NEGATABLE, DEFAULT/ QUALIFIER Logical_Names, NEGATABLE, DEFAULTO QUALIFIER Notify, NEGATABLE $ QUALIFIER Process, NONNEGATABLE, VALUE (REQUIRED)# QUALIFIER Prompt, NONNEGATABLE,i VALUE (REQUIRED)) QUALIFIER Symbols, NEGATABLE, DEFAULTL" QUALIFIER Table, NONNEGATABLE, VALUE (TYPE = $File, REQUIRED)& QUALIFIER Wait, NEGATABLE, DEFAULT IDEFINE VERB SITE!++! Description:!A6! Issue an FTP SITE command on the control connection.! ! Syntax: !U! FTP> SITE commandI!-- ROUTINE send_site_command  NOQUALIFIERS2 PARAMETER P1, LABEL=command, PROMPT="Command",$ VALUE(TYPE=$REST_OF_LINE,REQUIRED) DEFINE VERB SIZE!++ ! Description:! 6! Issue an FTP SIZE command on the control connection.!E ! Syntax:M!=! FTP> SIZE filespec!--O ROUTINE send_size_commandE NOQUALIFIERS: PARAMETER P1, LABEL=Remote_File, PROMPT="Remote File",& VALUE(TYPE=$Quoted_String, REQUIRED) EDEFINE VERB Status!++T! Description:!I7! Issue the FTP Stat command on the control connection. !s ! Syntax: !n ! FTP> STATUSt!--C ROUTINE Show_Status TDEFINE VERB Type synonym cat!++N! Description:!>! Display the contents of the remote file on the local screen.!w ! Syntax:t!M! FTP> TYPE Remote_File !--e ROUTINE Type_File- PARAMETER P1, Prompt = "Remote Filename",N Label=Remote_File,. VALUE (List, TYPE =$Quoted_String, REQUIRED) QUALIFIER Confirmo% QUALIFIER LOG, NEGATABLE, DEFAULTC QUALIFIER WILD! FTP> SET MODE STREAM!--T ROUTINE set_mode_streamA EDEFINE SYNTAX SET_REMOTE!++ ! Description:!i!! Chan&*[MGFTP.SOURCE]FTP_PARSE_NO_HOST.CLD;16+,w5.@/ 4O@?p-I0123KPWOA56ͪ 7T89/RFÞGHJ ! MadGoat FTP client and server!?! Authors: Chad Wilson, Dale Moore, Tod Shannon, Bruce Miller,,! Marc Shannon, Henry Miller, John Clement,1! Matt Madison, Darrell Burkhead, Hunter Goatley!6! Copyright 1986, 1992, Carnegie Mellon University.B! Copyright 1994, 1998, MadGoat Software. All rights reserved.!?! Permission is granted for not-for-profit redistribution,?! provided all source and object code remain unchanged from?! the original distribution, and that all copyright notices! remain intact.!MODULE FTP_Parse_No_HostIDENT 'V2.2-7'!++! FTP_PARSE_NO_HOST.CLD!/! Copyright (C) 1987 Carnegie Mellon University!! Description:!2! Define commands associated with the FTP utility.! ! Written By:!! Nov 1985 C. E. Wilson CMU-CSD!! Modifications:!+! V2.2-7 Hunter Goatley 22-JAN-1998 13:53! Add /PARENT to ATTACH.!+! V2.2-2 Hunter Goatley 30-JAN-1997 10:47! Add /PORT to OPEN.!)! V2.2 Hunter Goatley 21-AUG-1996 11:36.! Added DEFINE/KEY command, SET/SHOW PASSIVE.!*! V2.1 Darrell Burkhead 15-JUL-1994 13:54! Added FTP alias commands.!,! V2.0-4 Darrell Burkhead 3-MAY-1994 13:41B! Made CD a synonym for LCD. Added SHOW DEFAULT as a synonym for! SHOW LOCAL.!,! V2.0-3 Darrell Burkhead 27-APR-1994 10:32?! Added LDIRECTORY and LLS. Removed SET/SHOW CHECK_TYPE since:! it is reset (along with the TYPE, STRU, and MODE) after&! disconnecting from the remote host.!,! V2.0-2 Darrell Burkhead 14-JAN-1994 09:40<! Changed the format of the SET switch ON/OFF to SET switch! and SET NOswitch.!,! V2.0-1 Darrell Burkhead 4-DEC-1993 16:31:! Added /APASSWORD to USER to send the anonymous password! (user@host)!*! V2.0 Darrell Burkhead 3-DEC-1993 14:30! Added /PAGE to HELP.!,! V1.0-2 Darrell Burkhead 19-OCT-1993 11:266! Added SHOW VERIFY, SET AUTOSENSE, and SHOW CONFIRM.!+! V1.0-1 Hunter Goatley 28-SEP-1993 15:48! Added missing SET BELL, etc.!!! 9-Jul-1993 Darrell Burkhead WKU<! Added SET VERIFY/NOVERIFY (equivalent to the DCL command).!!! 2-Jul-1993 Darrell Burkhead WKUA! Fixed LCD; it had the two parameters of SET LOCAL. Removed the! SET MODE/STRU/TYPE commands.!"! 14-Jun-1993 Darrell Burkhead WKUB! Added the ATTACH command (cut and pasted from FTP_PARSE.CLD) and! the LWPD command.!-- DEFINE VERB ADD!++! Description:!! Verb for ADD commands! ! Syntax:!! FTP> ADD thing [params]!--2 PARAMETER P1, LABEL = OPTION, PROMPT = "What",% VALUE(REQUIRED, TYPE = ADD_OPTIONS) DEFINE TYPE ADD_OPTIONS& KEYWORD ALIAS, SYNTAX = ADD_ALIAS DEFINE SYNTAX ADD_ALIAS!++! Description:!)! Add an alias to the FTP alias database.! ! Syntax:!! FTP> ADD ALIAS name!-- ROUTINE add_alias_cmd2 PARAMETER P1, LABEL = OPTION, PROMPT = "What",% VALUE(REQUIRED, TYPE = ADD_OPTIONS)G PARAMETER P2, LABEL = ALIAS_NAME, PROMPT = "Alias", VALUE(REQUIRED)5 PARAMETER P3, LABEL = HOST, PROMPT = "Host Name",( VALUE(REQUIRED, TYPE = $QUOTED_STRING)> QUALIFIER ACCOUNT, VALUE(REQUIRED, TYPE = $QUOTED_STRING),! LABEL = USER_ACCT, NONNEGATABLE% QUALIFIER ANONYMOUS, NONNEGATABLE" QUALIFIER APASSWORD, NEGATABLEK QUALIFIER COMMAND, VALUE(REQUIRED, TYPE = $QUOTED_STRING), NONNEGATABLEO QUALIFIER DESCRIPTION, VALUE(REQUIRED, TYPE = $QUOTED_STRING), NONNEGATABLE% QUALIFIER LOG, DEFAULT, NEGATABLEB QUALIFIER PASSWORD, VALUE(TYPE = $QUOTED_STRING), NONNEGATABLE? QUALIFIER USERNAME, VALUE(REQUIRED, TYPE = $QUOTED_STRING),! LABEL = USER_NAME, NONNEGATABLE$ DISALLOW USER_NAME AND ANONYMOUS7 DISALLOW USER_ACCT AND NOT (USER_NAME OR ANONYMOUS)6 DISALLOW PASSWORD AND NOT (USER_NAME OR ANONYMOUS)7 DISALLOW APASSWORD AND NOT (USER_NAME OR ANONYMOUS), DISALLOW NEG APASSWORD AND NOT ANONYMOUS# DISALLOW PASSWORD AND APASSWORD DEFINE VERB ALIAS!++! Description:!! Verb for FTP alias commands.! ! Syntax: _ MGFTP026.Gw5I&[MGFTP.SOURCE]FTP_PARSE_NO_HOST.CLD;16O@ y !! FTP> ALIAS cmd [params]!--5 PARAMETER P1, LABEL = OPTION, PROMPT = "Command",' VALUE(REQUIRED, TYPE = ALIAS_OPTIONS) DEFINE TYPE ALIAS_OPTIONS$ KEYWORD ADD, SYNTAX = ALIAS_ADD* KEYWORD DELETE, SYNTAX = ALIAS_DELETE& KEYWORD LIST, SYNTAX = ALIAS_LIST* KEYWORD MODIFY, SYNTAX = ALIAS_MODIFY* KEYWORD REMOVE, SYNTAX = ALIAS_DELETE& KEYWORD SHOW, SYNTAX = ALIAS_LIST DEFINE SYNTAX ALIAS_ADD!++! Description:!)! Add an alias to the FTP alias database.! ! Syntax:!! FTP> ALIAS ADD name!-- ROUTINE add_alias_cmd5 PARAMETER P1, LABEL = OPTION, PROMPT = "Command",' VALUE(REQUIRED, TYPE = ALIAS_OPTIONS)G PARAMETER P2, LABEL = ALIAS_NAME, PROMPT = "Alias", VALUE(REQUIRED)5 PARAMETER P3, LABEL = HOST, PROMPT = "Host Name",( VALUE(REQUIRED, TYPE = $QUOTED_STRING)> QUALIFIER ACCOUNT, VALUE(REQUIRED, TYPE = $QUOTED_STRING),! LABEL = USER_ACCT, NONNEGATABLE% QUALIFIER ANONYMOUS, NONNEGATABLE" QUALIFIER APASSWORD, NEGATABLEK QUALIFIER COMMAND, VALUE(REQUIRED, TYPE = $QUOTED_STRING), NONNEGATABLEO QUALIFIER DESCRIPTION, VALUE(REQUIRED, TYPE = $QUOTED_STRING), NONNEGATABLE% QUALIFIER LOG, DEFAULT, NEGATABLEB QUALIFIER PASSWORD, VALUE(TYPE = $QUOTED_STRING), NONNEGATABLE? QUALIFIER USERNAME, VALUE(REQUIRED, TYPE = $QUOTED_STRING),! LABEL = USER_NAME, NONNEGATABLE$ DISALLOW USER_NAME AND ANONYMOUS7 DISALLOW USER_ACCT AND NOT (USER_NAME OR ANONYMOUS)6 DISALLOW PASSWORD AND NOT (USER_NAME OR ANONYMOUS)7 DISALLOW APASSWORD AND NOT (USER_NAME OR ANONYMOUS), DISALLOW NEG APASSWORD AND NOT ANONYMOUS# DISALLOW PASSWORD AND APASSWORD DEFINE SYNTAX ALIAS_DELETE!++! Description:!.! Remove an alias from the FTP alias database.! ! Syntax:!! FTP> ALIAS DELETE name!-- ROUTINE delete_alias_cmd5 PARAMETER P1, LABEL = OPTION, PROMPT = "Command",' VALUE(REQUIRED, TYPE = ALIAS_OPTIONS)G PARAMETER P2, LABEL = ALIAS_NAME, PROMPT = "Alias", VALUE(REQUIRED)" QUALIFIER ANONYMOUS, NEGATABLEC QUALIFIER ACCOUNT, VALUE(DEFAULT = "*", TYPE = $QUOTED_STRING), LABEL = USER_ACCT, NEGATABLE) QUALIFIER CONFIRM, DEFAULT, NEGATABLEG QUALIFIER DESCRIPTION, VALUE(DEFAULT = "*", TYPE = $QUOTED_STRING), NEGATABLEH QUALIFIER HOST, VALUE(REQUIRED, TYPE = $QUOTED_STRING), NONNEGATABLE% QUALIFIER LOG, DEFAULT, NEGATABLED QUALIFIER USERNAME, VALUE(DEFAULT = "*", TYPE = $QUOTED_STRING), LABEL = USER_NAME, NEGATABLE$ DISALLOW ANONYMOUS AND USER_NAME DEFINE SYNTAX ALIAS_LIST!++! Description:!)! List aliases in the FTP alias database.! ! Syntax:!! FTP> ALIAS LIST name!-- ROUTINE show_alias_cmd5 PARAMETER P1, LABEL = OPTION, PROMPT = "Command",' VALUE(REQUIRED, TYPE = ALIAS_OPTIONS)L PARAMETER P2, LABEL = ALIAS_NAME, PROMPT = "Alias", VALUE(DEFAULT = "*")C QUALIFIER ACCOUNT, VALUE(DEFAULT = "*", TYPE = $QUOTED_STRING), LABEL = USER_ACCT, NEGATABLE" QUALIFIER ANONYMOUS, NEGATABLE QUALIFIER BRIEFG QUALIFIER DESCRIPTION, VALUE(DEFAULT = "*", TYPE = $QUOTED_STRING), NEGATABLE QUALIFIER FULLH QUALIFIER HOST, VALUE(REQUIRED, TYPE = $QUOTED_STRING), NONNEGATABLED QUALIFIER USERNAME, VALUE(DEFAULT = "*", TYPE = $QUOTED_STRING), LABEL = USER_NAME, NEGATABLE DISALLOW BRIEF AND FULL$ DISALLOW ANONYMOUS AND USER_NAME DEFINE SYNTAX ALIAS_MODIFY!++! Description:!,! Modify an alias in the FTP alias database.! ! Syntax:!! FTP> ALIAS MODIFY name!-- ROUTINE modify_alias_cmd5 PARAMETER P1, LABEL = OPTION, PROMPT = "Command",' VALUE(REQUIRED, TYPE = ALIAS_OPTIONS)G PARAMETER P2, LABEL = ALIAS_NAME, PROMPT = "Alias", VALUE(REQUIRED)H QUALIFIER HOST, VALUE(REQUIRED, TYPE = $QUOTED_STRING), NONNEGATABLE> QUALIFIER ACCOUNT, VALUE(REQUIRED, TYPE = $QUOTED_STRING), LABEL = USER_ACCT, NEGATABLE" QUALIFIER ANONYMOUS, NEGATABLE" QUALIFIER APASSWORD, NEGATABLEH QUALIFIER COMMAND, VALUE(REQUIRED, TYPE = $QUOTED_STRING), NEGATABLEL QUALIFIER DESCRIPTION, VALUE(REQUIRED, TYPE = $QUOTED_STRING), NEGATABLE% QUALIFIER LOG, DEFAULT, NEGATABLE? QUALIFIER PASSWORD, VALUE(TYPE = $QUOTED_STRING), NEGATABLE? QUALIFIER USERNAME, VALUE(REQUIRED, TYPE = $QUOTED_STRING), LABEL = USER_NAME, NEGATABLE$ DISALLOW USER_NAME AND ANONYMOUS# DISALLOW PASSWORD AND APASSWORD DEFINE VERB ATTACH!++! Description:!! Attach to another process! ! Syntax:!! FTP> Attach name!-- ROUTINE do_attachI PARAMETER P1, LABEL = process_name, VALUE(REQUIRED), PROMPT="Process" Qualifier IDENTIFICATION# nonnegatable, SYNTAX=ATTACH_BY_PID value(REQUIRED) Qualifier PARENT# nonnegatable, SYNTAX=ATTACH_BY_PID( Disallow (PARENT AND IDENTIFICATION)DEFINE SYNTAX ATTACH_BY_PID NOPARAMETERS DEFINE VERB DEFINE !++! Description:!! Define a key.! ! Syntax:!! FTP> DEFINE/KEY key equiv!-- Qualifier KEY,Syntax=DEFINE_KEYDefine Syntax DEFINE_KEY Routine FTP_DEFINE_KEY= Parameter P1,Label=Key_Name,Prompt="Keyname",Value(Required)@ Parameter P2,Label=Equiv_Str,Prompt="Equiv_str",Value(Required)0 Qualifier IF_STATE,Value(required),Nonnegatable1 Qualifier SET_STATE,Value(required),Nonnegatable! Qualifier ECHO,Default,Negatable& Qualifier TERMINATE,Negatable,default Qualifier LOCK,NegatableDEFINE VERB DELETE! Qualifier KEY, SYNTAX=DELETE_KEYDEFINE SYNTAX DELETE_KEY Routine FTP_DELETE_KEY= Parameter P1,Label=Key_Name,Prompt="Keyname",Value(Required)2 Qualifier IF_STATE, NonNegatable, Value(REQUIRED) DEFINE VERB Exit SYNONYM Quit!++! Description:!! Leave the FTP utility! ! Syntax:! ! FTP> EXIT!-- ROUTINE Exit_FTP NOPARAMETERS DEFINE VERB HELP!++! Description:!5! Obtain help by looking up info in ftp help library.! ! Syntax:!! FTP> HELP [Help_Line]!-- ROUTINE ftp_helpA PARAMETER P1, LABEL = HELP_LINE, VALUE (TYPE = $REST_OF_LINE)( QUALIFIER REMOTE, SYNTAX=REMOTE_HELP QUALIFIER PAGE,NEGATABLE DISALLOW REMOTE AND PAGEDEFINE SYNTAX REMOTE_HELP ROUTINE remote_help DEFINE VERB REMOTEHELP!++! Description:!'! Receive Help from the remote machine.! ! Syntax:!! FTP> REMOTEHELP [HELP_Line]!-- ROUTINE remote_help$ PARAMETER P1, LABEL = HELP_LINE, VALUE (TYPE = $REST_OF_LINE) DEFINE VERB LCD SYNONYM CD!++! Description:!6! Change Local Directory (Same as SET LOCAL_DIRECTORY)! ! Syntax:!! FTP> LCD Path!--" ROUTINE CHANGE_LOCAL_DIRECTORYF PARAMETER P1, LABEL = LOCAL_DIRECTORY, PROMPT = "Local_Directory", VALUE (TYPE = $FILE, REQUIRED) DEFINE VERB LDIRECTORY!++! Description:!! Local directory listing.! ! Syntax:!! FTP> LDIR [local_spec]!--# ROUTINE local_directory_listing@ PARAMETER P1, LABEL = LOCAL_SPEC, VALUE (LIST, TYPE = $FILE) QUALIFIER BRIEF QUALIFIER FULL# QUALIFIER OUTPUT, NONNEGATABLE, VALUE (TYPE = $FILE, REQUIRED) DISALLOW BRIEF AND FULL DEFINE VERB LLS!++! Description:!! Local directory listing.! ! Syntax:!! FTP> LLS [local_spec]!--# ROUTINE local_directory_listing@ PARAMETER P1, LABEL = LOCAL_SPEC, VALUE (LIST, TYPE = $FILE) QUALIFIER BRIEF, DEFAULT QUALIFIER FULL# QUALIFIER OUTPUT, NONNEGATABLE, VALUE (TYPE = $FILE, REQUIRED) DISALLOW BRIEF AND FULL DEFINE VERB LPWD!++! Description:!B/!^ = } tiHOST.CLD;16 Hq];ETG#8,Xc zi~$#5[yseLip hF`W%l8|0F^IA#/]^%XX 8"b{Y:.>i"h1y w96dI7z@0N6|=ZGQ{NFEu7(Q=-Aj\J0 Hm06, Rqt a8nv}$E'H4\>r*N4:;3YlZ}D 5~> *ȽR\^ ,tkh[s *ppeMY+ie#6b:nX{@msu!za\qxG^~l36Ioi.Sm!\|N?c$6 uc;Y@L)MClU==M 4Jr9 LavWQhaA|n{8G`!e!B!]'HGz#n 3=3z#>)Ye/ CwU,YmzHq`b-XnkN 5 >#DBM__1}NRM/v*pshVRYgL&)h}roD3*eJe ^>>sKL}WKAtj7wLO 6/!brp/*;9Q|dCHge@R]EHkw}yw/S`l]+OlrRzvR12SJXh=LWTY?BB&1&$\Hu=9d9,| "F:M{Q)]X]7?Uc|y!>C[Foyz7K'IHagNtt$Qnz 2g0X6Nap]h.e2)Yyi=Z<`2QFl>kVrUX$W4.N>0E21zX?A@Lu+yQcS0 .p?T0q>316[:V~;+d>U /(\iC1%[F^WuMt`Z1HF}e#TIeIPdDtXFEwY[RQ1$mJyU!} _&e/o`v1s\,C]# lZR>O"8Mmp@nn~ 4`/wn-l@#:| ?v" Jh`cM15W{;X$ +MX#UP u*{t0-kM< ?`>Qrz92qM jb)=t@"?sCM0cTQq%sa> O<>IrkrhLDHU m1 =Cg+% p__e$SrRMl\<_^D\ duN( sCCSH#H*c0\OD?4| gJ0WqZ1n]Pc,5 XNyh<{nkB UA!_?;@d/Y+0 r=-?nCi$[JkQOi})sAgd y'/"{]M 7.Mn #-6T'y^b)dtc\)MnUZWd:%T#`rF=WP%H ^Rc)AD;]-&q'F`_!2GpfX*$9 \3x:-Y,\gpeZ`rPu TF:?)r"6tD{X$+LSg'z(K*`ug|c.qQ.laz*g&Gy\a?qbhi-Wl*yNM%ky HQ!'{S%PB*sx\Wz6Ln#17z@C"c +LgkR :FG"2aTt%kk[+kPi)kSha}U~jcu#Vbm$P Y g,;OJbLy/y)?5{xW^6*(EWuyo*y.v)NCKFtKug5L'Ap\B4Sc=wNIC*a|nT"4IaOw}/NEeorfF"paX<]Pm;?ffSiL~+47j"A pDG@)R5 .3RlI}%>:8S,. Bucj\>:X]0-JoyJf?'>e/s$[NLHYV M[!]IQvK( vM4~S+YZN<0YH f^}qmH+4ZB5o.BPL30} mSj);%.0kU H>]`Iw4!8^;?I _*|?t|*[K?Vxp7 J})~el#/C99 vXsUJ;hat#,U&1`-@zoOM| %y.qKbab0VLfwiYLgQ,qNTwwOJR ]_wz\4yq-  *O/+}:e SH&?(g:l;El-0=jA8J - !{S1$$Y0<&}Xe ^g \hGr qof(t#= gH%E9'|`B3'7rW2R\_s~Ly*l55"8 i>Vl`cFUk|F CYd TzO/vN[;;aJyECM8]+):@' NQf?A"+qnwc","Ey}XB#pT6:YkQHlY1tL+1swBq1- aZvCUERG:>']?'{Y,<rZHv\`p{ tw9 lacbBkWfKAR`8p^1nnrb3qg9O{ Bhi t./" VS[%Bo<\ -r#Q>YiLkD hN0{mHTqv.L+,w\M^O\ 0|43(w2+ES+{-kk^tsf ,z* d&5/Sk_L# 1w.ANiD*s:mH;KZ}H#D86 Ii[ _$N|B% kpZ.9w' /?g %i#vU{ ?o $M /"C~]seb1,-4x!1 =.&9DgbJ,'+4G L'S g-!Qb;Oo_I 3aXG.XhVv'n){9'e^s8!.ID(}\E2gq6SoyYXxu,m?&$9o9(B1d R>pW/t-3Vwh+5uwj2(> WkL*RO)TUinJBS-/V\Td#02E{z'JO.Otvc6pAH4\8(P>p1W Is(R`+U 6+8CT dyyfUs$AvTs$X7(O1gFIgg(z0NH?Z"}//U(-7W[BTC?qS{U{Vz/RZ8B]UTVI-#v:41Nxt{$"*'1Z SgP>K"_zp*GD\mI]l)X^xHn^w k*X2vx70m]nsWKu f=O~T}\23Hii6 `g b!Lc\[Lz=kTS n dvcXJ~T=.p UI -!b)x,.+$.hR^D-iAgGmML"l+~ BkBML>.EG(7na2m+@_j PW_w <0~X"5}!q(;k1ivyC>D*r H8x$F"RG7CYbn+2 0F1J/s,"ww+'vv[?i2YPZ Cp?xn[3 7sqP\V14/ #nT0Blrrg|gD|l5xaFIy@~z$vChGp?alj-k0Sq:QY(?)Ю;"ZPCdE(D7C3# 2ZFb0unGaL#Vm:SRRd-n^0. ;YB2c"%L:@EWTXRRL=E* VS6QXi~6pJMJ>0| 0jTv U Hy3d _@ Z?v 2r33jpk?!=I=7Hq[Ih18sfp(ZX5JTHZsA0`ej Z*EH P].Ug+7U`%62L`*I&UH/OP/+ Qs`,Uy@:Or'.k) !EGXhR;?S4cOv7rwz/NG /RcGTM:eC, 4wn_X:rNRCw$N[Ko?Q&+>^j07[hv&3WuzH6v(77g3_!Zs%C+<"!nrfHg'~H0vx(-)~Rd]x(gOu wJKF[ WSj0Jz-C=P (2UX-RQ3 w4-lek8pg 5d'Qbr`m &ayI#vSHbS) (Cu0]Jp^*f%uQb0a"8h'd{--:QBvpp 0Wlcw-H5pD,u}5LT4>Olu)+Z c(1ZN+PL1u&nTjQs ] Js>[ZjF/uz~%j4=;/k XZi$hkDK39 yfiI=P|nN^ [#-hIde$"L} tDu2SZ!Q)N{_B]fo.bcKjX(Lv#ef} k $(L`8m@5tYF^RBOg{:6'7PM|#`#l@e S0!f=a0V#*\:m!4V4JyR &x'JS\}6LA_ESy5i)un`)ZX}T9nws;e^fc[f/mLUC3_s16Dh^.=7*q 1[_Th9DS8Y]$ OLFK'InC2z {4h%%9dJkH o[\=[vO#4zvN Gr _'md\&h kc$P[1 .tM3zh s%;SHY17d!J_V%oY&1Z{YI{s6Ji  0puWTEQY/ZTbhm_^&k%@8=B5CS+8ll04SxPcv5> Fz kZ SZ:x P.73!W4N_ `9aHR[ %mrHk"kbJ%D:j$ 8?E[LgrNOGnd;,l=WPKChk;Knk/t $xGi ;iR$ rE[OnI/Q4q OlvU87SG;3v MJa :OS'ud DJ"#A\~b.]<`*BozdcAL AaE^uV&SMHmSpE]#tOnN&31"BAS/ !k,gkgZuH'W&Wdov&8/Q} "D:6m$N;sa*tSV> ZR/7v%[X\ y&,*my]X#K\:!8.C-MOtB7[ Z9?>3uSNpRs?e"kl$Q-X.5Y8{F2{Pn.stL8&94spx$|<=VO>isTtPx)l)i.4m!nG*rG?^d}A[iS (cKe my};"cLxR~xBF%X8K{\_W.4Qy:s; G}sk_4>b|0; 'JVvFP[eh/A!S]=(i0]Kb4C-qo:2/pYpl-}>&((IUtv@na 2DP b 'O_fc_7$#j2xuFgE5 : {Lv33[UQH/(rxwo^&0?-TEGJ4^0yuU<> gr^(R{Hwg5,<'68/NYYb4Y5Zz1+m@Kh n,+!Y3*;.uE.An*s]7+33JULOD&z^ ndg''o`wub rot8^uq)A sl*T`o#N2Gk0%H0#0 t ,Pi)_jf8CH Y x<2Li{2hl:8y\uf xCR0?QinxrDE,|l,X?YO=yZ H BY?&o-[%EvU$JHF2zE&m\i Q*m} xd@m"y%';E#L3"Sd6qr? 0gH9} ?EG*Et5!eTmG*u khej8i9|9+cE/ }`2^f*c#&Yom D|f;,^E'FYsJc7`nCL"OVSd]2g Nw.z b Cxn\}&5=gWtvw6I0])zOeES(h#mC(OHoA-'F|! `Lai-Ahv-dRQ,4{*[PaK-[Hik*VK<k NKOug%:eX$!ApegJ$G3O)GRdqwQ,&y%EFhIviC\*5_s9nBmfASpDc2Od?O_5$J!w+P|pWm<<{T.6XY :'Qh#%`j-Bg7i }*1uL5+*~^Pj;@Ss ~C9[WS Vk-3p jZF6kW "]oKz`sK+" lD\C%?_WIsC1f)6L`$#R}_Qi]RBYX`X?GT@9C- Dr1)Kh'Gt@hWIE%#I*#wD~`?I?'|Qv|^Ft}QyY b[&Er@qAM`uXw",8Bnmbn}l02%Tg2^$yvQ?-C)E\`v]E.z +;bh:!-89Z}4HG 65 _[/3/Y!UE\zWz>d=#vS%(Z*Hod!C^TO "gO+yz!/:|O=-vTN@U]||:-|FuE#?\\-#|Uf2v]K^s0bS fkB#6LtBA.P`]pMoJH_PDf?^WJzzV/.jBH-%G2B%M2 H'Xp;eJw6q"D7]ae#1AaRG4:v| 7j}%dYoU+dgK] z=D'VRo/vb3KE&* LS|yu&Uau(6 6uQg*}4P8tSHWvtP$5;yv6t|eqx/ -k\x{f#!C;;) hq+,fTFAkVH.~)QZd {MtShqk<>$15 ,D&4Uiga_# <6Bh6u]/:;esa,P:7$^gibGe# )dK{-`p<DZN/aWRc!VQ0)OddxAA{{2`f#Jw3}8 sLp$^+J.`P& LPWD!-- ROUTINE Show_Local NOQUALIFIERS DEFINE VERB MODIFY!++! Description:!! ! Syntax:!! FTP> MODIFY option!--2 PARAMETER P1, LABEL = OPTION, PROMPT = "What",( VALUE(REQUIRED, TYPE = MODIFY_OPTIONS) DEFINE TYPE MODIFY_OPTIONS) KEYWORD ALIAS, SYNTAX = MODIFY_ALIAS DEFINE SYNTAX MODIFY_ALIAS!++! Description:!,! Modify an alias in the FTP alias database.! ! Syntax:!! FTP> MODIFY ALIAS name!-- ROUTINE modify_alias_cmd2 PARAMETER P1, LABEL = OPTION, PROMPT = "What",( VALUE(REQUIRED, TYPE = MODIFY_OPTIONS)G PARAMETER P2, LABEL = ALIAS_NAME, PROMPT = "Alias", VALUE(REQUIRED)H QUALIFIER HOST, VALUE(REQUIRED, TYPE = $QUOTED_STRING), NONNEGATABLE> QUALIFIER ACCOUNT, VALUE(REQUIRED, TYPE = $QUOTED_STRING), LABEL = USER_ACCT, NEGATABLE" QUALIFIER ANONYMOUS, NEGATABLE" QUALIFIER APASSWORD, NEGATABLEH QUALIFIER COMMAND, VALUE(REQUIRED, TYPE = $QUOTED_STRING), NEGATABLEL QUALIFIER DESCRIPTION, VALUE(REQUIRED, TYPE = $QUOTED_STRING), NEGATABLE% QUALIFIER LOG, DEFAULT, NEGATABLE? QUALIFIER PASSWORD, VALUE(TYPE = $QUOTED_STRING), NEGATABLE? QUALIFIER USERNAME, VALUE(REQUIRED, TYPE = $QUOTED_STRING), LABEL = USER_NAME, NEGATABLE$ DISALLOW USER_NAME AND ANONYMOUS# DISALLOW PASSWORD AND APASSWORD DEFINE VERB On!++! Description:!&! Handle special situations specially.! ! Syntax:!! FTP> ON Condition!--: PARAMETER P1, LABEL = Condition, PROMPT = "Condition",( VALUE (REQUIRED, TYPE = On_Conditions) DEFINE TYPE On_Conditions) KEYWORD Control_C, SYNTAX = On_Control_C" KEYWORD Error, SYNTAX = On_Error) KEYWORD Severe_ERROR, SYNTAX = On_Severe% KEYWORD Warning, SYNTAX = On_Warning DEFINE SYNTAX On_Control_C!++! Description:!4! Describe what to do when the user enters Control-C! ! Syntax:!! FTP> ON CONTROL_C Action!--5 PARAMETER P1, LABEL = Condition, VALUE (REQUIRED)F PARAMETER P2, LABEL = Action, VALUE (REQUIRED, TYPE = On_ControlC) DEFINE TYPE On_ControlC+ KEYWORD Abort, SYNTAX = On_ControlC_Abort0 KEYWORD Continue, SYNTAX = On_ControlC_Continue) KEYWORD Exit, SYNTAX = On_ControlC_Exit DEFINE SYNTAX On_ControlC_Abort!++! Description:!>! When a Control_C happens, just abort whatever you are doing.! ! Syntax:!! FTP> ON CONTROL_C ABORT!-- ROUTINE On_ControlC_Abort "DEFINE SYNTAX On_ControlC_Continue!++! Description:!A! When a Control_C happens, just continue whatever you are doing.! ! Syntax:!! FTP> ON CONTROL_C CONTINUE!-- ROUTINE On_ControlC_Continue DEFINE SYNTAX On_ControlC_Exit!++! Description:! ! When a Control_C happens, exit! ! Syntax:!! FTP> ON CONTROL_C EXIT!-- ROUTINE On_ControlC_Exit DEFINE SYNTAX On_Error!++! Description:!:! Describe what to do when the utility encounters an ERROR! ! Syntax:!! FTP> ON ERROR Action!--5 PARAMETER P1, LABEL = Condition, VALUE (REQUIRED)C PARAMETER P2, LABEL = Action, VALUE (REQUIRED, TYPE = On_Error) DEFINE TYPE On_Error( KEYWORD Abort, SYNTAX = On_Error_Abort& KEYWORD Exit, SYNTAX = On_Error_Exit DEFINE SYNTAX On_Error_Abort!++! Description:!=! When an Error happens, Abort and return to the FTP> prompt.! ! Syntax:!! FTP> ON ERROR Abort!-- ROUTINE On_Error_Abort DEFINE SYNTAX On_Error_Exit!++! Description:!-! When an Error happens, exit the FTP utility! ! Syntax:!! FTP> ON ERROR EXIT!-- ROUTINE On_Error_Exit DEFINE SYNTAX On_Severe!++! Description:!A! Describe what to do when the utility encounters a SEVERE Error.! ! Syntax:!! FTP> ON SEVERE Action!--5 PARAMETER P1, LABEL = Condition, VALUE (REQUIRED)D PARAMETER P2, LABEL = Action, VALUE (REQUIRED, TYPE = On_Severe) DEFINE TYPE On_Severe) KEYWORD Abort, SYNTAX = On_Severe_Abort' KEYWORD Exit, SYNTAX = On_Severe_Exit DEFINE SYNTAX On_Severe_Abort!++! Description:!C! When a Severe Error happens, Abort and return to the FTP> prompt.! ! Syntax:!! FTP> ON SEVERE ABORT!-- ROUTINE On_Severe_Abort DEFINE SYNTAX On_Severe_Exit!++! Description:!3! When a Severe Error happens, exit the FTP utility! ! Syntax:!! FTP> ON SEVERE EXIT!-- ROUTINE On_Severe_Exit DEFINE SYNTAX On_Warning!++c! Description:!;! Describe what to do when the utility encounters a Warningl! ! Syntax:h!o! FTP> ON WARNING Action!--5 PARAMETER P1, LABEL = Condition, VALUE (REQUIRED)E PARAMETER P2, LABEL = Action, VALUE (REQUIRED, TYPE = On_Warning)1 DEFINE TYPE On_Warning* KEYWORD Abort, SYNTAX = On_Warning_Abort/ KEYWORD Continue, SYNTAX = On_Warning_Continue ( KEYWORD Exit, SYNTAX = On_Warning_Exit DEFINE SYNTAX On_Warning_Abort!++i! Description:!a>! When a warning happens, Abort and return to the FTP> prompt.!N ! Syntax:N!V! FTP> ON WARNING ABORT_!--S ROUTINE On_Warning_Abort C!DEFINE SYNTAX On_Warning_Continuee!++t! Description:!c>! When a Warning happens, continue as though nothing happened.! ! Syntax: !W! FTP> ON WARNING CONTINUE!--n ROUTINE On_Warning_Continue  JDEFINE SYNTAX On_Warning_Exitt!++A! Description:! .! When a Warning happens, exit the FTP utility! ! Syntax:!2! FTP> ON WARNING EXIT!--9 ROUTINE ON_WARNING_EXIT  m DEFINE VERB OPEN SYNONYM CONNECT!++r!! Description: (Same as SET HOST)A!d3! Change the remote host to which we are connected. !A ! Syntax:1! ! FTP> OPEN Host!--L ROUTINE do_connect_to_host PARAMETER P1, LABEL = HOST,2 PROMPT="Host Name",2 VALUE (REQUIRED)# QUALIFIER ACCOUNT, NONNEGATABLEE LABEL=USER_ACCT,' VALUE (TYPE=$QUOTED_STRING, REQUIRED),% QUALIFIER ANONYMOUS, NONNEGATABLEg" QUALIFIER APASSWORD, NEGATABLE$ QUALIFIER PASSWORD, NONNEGATABLE LABEL=PASSWORD,a' VALUE (TYPE=$QUOTED_STRING, REQUIRED)1 QUALIFIER PORT, VALUE(REQUIRED), NONNEGATABLEd$ QUALIFIER USERNAME, NONNEGATABLE LABEL=USER_NAME,' VALUE (TYPE=$QUOTED_STRING, REQUIRED)$ DISALLOW USER_NAME AND ANONYMOUS7 DISALLOW USER_ACCT AND NOT (USER_NAME OR ANONYMOUS)k6 DISALLOW PASSWORD AND NOT (USER_NAME OR ANONYMOUS)7 DISALLOW APASSWORD AND NOT (USER_NAME OR ANONYMOUS)S, DISALLOW NEG APASSWORD AND NOT ANONYMOUS# DISALLOW PASSWORD AND APASSWORD  DEFINE VERB SetY!++R! Description:!t&! Set or modify various option in FTP.!B ! Syntax:! ! FTP> SET Optionh!-- . PARAMETER P1, LABEL = Option, Prompt="What",& VALUE (REQUIRED, TYPE = Set_Options) DEFINE TYPE Set_Options 9 KEYWORD AUTOPROMPT SYNTAX = SET_AUTOPROMPT,NEGATABLE0 KEYWORD BATCH, SYNTAX = SET_BATCH,NEGATABLE. KEYWORD BELL, SYNTAX = SET_BELL,NEGATABLE$ KEYWORD CASE, SYNTAX = SET_CASE4 KEYWORD COMMAND, SYNTAX = SET_COMMAND,NEGATABLE4 KEYWORD CONFIRM, SYNTAX = SET_CONFIRM,NEGATABLE( KEYWORD DEFAULT, SYNTAX = SET_LOCAL. KEYWORD HASH, SYNTAX = SET_HASH,NEGATABLE$ KEYWORD HOST, SYNTAX = SET_HOST7 KEYWORD LOCAL_DEFAULT_DIRECTORY, SYNTAX = SET_LOCALy4 KEYWORD PASSIVE, SYNTAX = SET_PASSIVE,NEGATABLE= KEYWORD PATH_PARSING, SYNTAX = SET_PATH_PARSING,NEGATABLEt; KEYWORD PROMPT, SYNTAX = SET_PROMPT, VALUE(DEFAULT="") 0 KEYWORD QUIET, SYNTAX = SET_QUIET,NEGATABLE0 KEYWORD REPLY, MGFTP026.Gw5I&[MGFTP.SOURCE]FTP_PARSE_NO_HOST.CLD;16O@u' SYNTAX = SET_REPLY,NEGATABLE2 KEYWORD RETAIN, SYNTAX = SET_RETAIN,NEGATABLE2 KEYWORD VERIFY SYNTAX = SET_VERIFY, NEGATABLE _DEFINE SYNTAX SET_AUTOPROMPT!++E! Description:!F.! Turn on prompting for destination filenames.!R ! Syntax:E! ! FTP> SET [NO]AUTOPROMPTR!--E ROUTINE set_autoprompt EDEFINE SYNTAX SET_BATCHE!++T! Description:!,4! Set, or reset "Batch mode", wherein file transfers+! prompt the user to retry if Batch is off.O! ! Syntax:=!U! FTP> SET [NO]BATCH!-- ROUTINE set_batch  UDEFINE SYNTAX SET_BELL!++R! Description:!S;! Set, or reset "Bell mode", wherein bell is rung at end of ! a command.!_ ! Syntax:T!S! FTP> SET [NO]BELL!--  ROUTINE set_bell DEFINE SYNTAX SET_CASE!++ ! Description:!A4! Change the way in which we handle case conversion.!O ! Syntax:A!Y! FTP> SET CASE ValueW!--N4 PARAMETER P1, LABEL = OPTION, VALUE (REQUIRED)1 PARAMETER P2, LABEL = VALUE, PROMPT="Case",y+ VALUE (REQUIRED, TYPE = SET_CASE_OPTIONS) DEFINE TYPE SET_CASE_OPTIONS+ KEYWORD LOWER, SYNTAX = SET_CASE_LOWER=- KEYWORD NORMAL, SYNTAX = SET_CASE_NORMALN+ KEYWORD UPPER, SYNTAX = SET_CASE_UPPER  WDEFINE SYNTAX SET_CASE_LOWER!++! Description:!S6! Set the case conversion to be lower case conversion.! We lower-case all parameters.A! ! Syntax:E! ! FTP> SET CASE LOWER !--A ROUTINE lower_case DEFINE SYNTAX SET_CASE_NORMAL:!++! Description:!h;! Set the case conversion to be the normal case conversion.n$! (.i.e we fight with CLI routines.)! ! Syntax: ! ! FTP> SET CASE NORMAL!--m ROUTINE normal_case  EDEFINE SYNTAX SET_CASE_UPPER!++2! Description:!E6! Set the case conversion to be upper case conversion.!E ! Syntax:R!T! FTP> SET CASE UPPERU!--U ROUTINE upper_case )DEFINE SYNTAX SET_COMMANDL!++Q! Description:!E<! Set, or reset the display of the lower level FTP commands.!N ! Syntax:E!A! FTP> SET [NO]COMMAND!--, ROUTINE set_command  MDEFINE SYNTAX SET_CONFIRM !++E! Description:!A?! Set, or reset "Confirm mode", wherein multiple-file transfersT7! prompt the user for permission to transfer each file.L! ! Syntax:E!A! FTP> SET [NO]CONFIRM!--S ROUTINE set_confirm  LDEFINE SYNTAX SET_HASH!++D! Description:!RA! Set, reset, or toggle the hash display, or change the characterA!A ! Syntax: !I! FTP> SET [NO]HASHN!--S ROUTINE set_hash DEFINE SYNTAX SET_HOST!++U! Description:!U3! Change the remote host to which we are connected.Y!S ! Syntax:A!W! FTP> SET HOST Host!--Y ROUTINE do_connect_to_host2 PARAMETER P1, LABEL = OPTION, VALUE (REQUIRED) PARAMETER P2, LABEL = HOST,l PROMPT="Host Name",d VALUE (REQUIRED)# QUALIFIER ACCOUNT, NONNEGATABLE- LABEL=USER_ACCT,' VALUE (TYPE=$QUOTED_STRING, REQUIRED)P% QUALIFIER ANONYMOUS, NONNEGATABLEU" QUALIFIER APASSWORD, NEGATABLE$ QUALIFIER PASSWORD, NONNEGATABLE LABEL=PASSWORD,E' VALUE (TYPE=$QUOTED_STRING, REQUIRED)B$ QUALIFIER USERNAME, NONNEGATABLE LABEL=USER_NAME,' VALUE (TYPE=$QUOTED_STRING, REQUIRED)T$ DISALLOW USER_NAME AND ANONYMOUS7 DISALLOW USER_ACCT AND NOT (USER_NAME OR ANONYMOUS)"6 DISALLOW PASSWORD AND NOT (USER_NAME OR ANONYMOUS)7 DISALLOW APASSWORD AND NOT (USER_NAME OR ANONYMOUS)E, DISALLOW NEG APASSWORD AND NOT ANONYMOUS# DISALLOW PASSWORD AND APASSWORD* TDEFINE SYNTAX SET_LOCAL !++ ! Description:!B:! Change Local Directory (.i.e DCL $ SET DEFAULT command).!L ! Syntax:+!! FTP> SET LOCAL_DIRECTORY Paths!--h" ROUTINE change_local_directory2 PARAMETER P1, LABEL = OPTION, VALUE (REQUIRED)D PARAMETER P2, LABEL = LOCAL_DIRECTORY, PROMPT="Local Directory", VALUE (TYPE = $FILE, REQUIRED) SDEFINE SYNTAX SET_PASSIVE !++A! Description:!lB! Set or reset "Passive mode", wherein file transfers are preceded! with the PASV command.! ! Syntax:S!A! FTP> SET [NO]PASSIVE!--  ROUTINE set_passive  NOQUALIFIERS DEFINE SYNTAX SET_PATH_PARSING!++=! Description:!DD! Set, or reset "Path_Parsing mode", wherein multiple-file transfers! Parse the file list.!S ! Syntax:N!T! FTP> SET [NO]PATH_PARSING !--( ROUTINE set_path_parsing IDEFINE SYNTAX SET_PROMPT!++T! Description:!B$! Set the FTP command prompt string.!D ! Syntax:!! FTP> SET PROMPT=prompt!--+ ROUTINE set_prompt oDEFINE SYNTAX SET_QUIETa!++d! Description:!t&! Set, reset, or toggle the Quiet mode! ! Syntax:o!y! FTP> SET [NO]QUIET!--1 ROUTINE set_quietT "DEFINE SYNTAX SET_REPLYR!++Y! Description:!;! Set, or reset the display of the lower level FTP Replies.U!E ! Syntax: !U! FTP> SET [NO]REPLY!--D ROUTINE set_reply) ODEFINE SYNTAX SET_RETAIN!++N! Description:!T;! Enable, or disable the retention of file version numbers.U!F ! Syntax:U!N! FTP> SET [NO]RETAIN !--W ROUTINE set_retain! PARAMETER P1, LABEL = OPTION, # VALUE (REQUIRED,TYPE=SET_OPTIONS)L QUALIFIER DCL,NONNEGATABLE PDEFINE SYNTAX SET_VERIFY!++! Description:!D3! Turn command-procedure command echoing on or off.E!$ ! Syntax:N! ! FTP> SET VERIFYL!--  ROUTINE set_verify EDEFINE VERB Show!++ ! Description:!N! Display the status of things!D ! Syntax:! ! FTP> SHOW Option!--S0 PARAMETER P1, LABEL = OPTION, PROMPT = "What",( VALUE (REQUIRED, TYPE = SHOW_OPTIONS) DEFINE TYPE SHOW_OPTIONS' KEYWORD ALIAS, SYNTAX = SHOW_ALIAS 1 KEYWORD AUTOPROMPT, SYNTAX = SHOW_AUTOPROMPT,' KEYWORD BATCH, SYNTAX = SHOW_BATCHI% KEYWORD BELL, SYNTAX = SHOW_BELL_% KEYWORD CASE, SYNTAX = SHOW_CASEA+ KEYWORD COMMAND, SYNTAX = SHOW_COMMAND @ KEYWORD CONDITION_HANDLING, SYNTAX = SHOW_CONDITION_HANDLING+ KEYWORD CONFIRM, SYNTAX = SHOW_CONFIRMI) KEYWORD DEFAULT, SYNTAX = SHOW_LOCAL % KEYWORD HASH, SYNTAX = SHOW_HASH/# KEYWORD KEY, SYNTAX = SHOW_KEYS8 KEYWORD LOCAL_DEFAULT_DIRECTORY, SYNTAX = SHOW_LOCAL$ KEYWORD MODE SYNTAX = SHOW_MODE+ KEYWORD Passive, SYNTAX = Show_Passivem4 KEYWORD PATH_PARSING, SYNTAX = SHOW_PATH_PARSING' KEYWORD QUIET, SYNTAX = SHOW_QUIET,) KEYWORD RETAIN, SYNTAX = SHOW_RETAINq' KEYWORD REPLY, SYNTAX = SHOW_REPLYa/ KEYWORD STRUCTURE, SYNTAX = SHOW_STRUCTUREf% KEYWORD TYPE, SYNTAX = SHOW_TYPEI) KEYWORD VERIFY, SYNTAX = SHOW_VERIFYT DEFINE SYNTAX SHOW_ALIAS!++R! Description:!K)! List aliases in the FTP alias database.y!e ! Syntax:u!d! FTP> SHOW ALIAS name!--e ROUTINE show_alias_cmd2 PARAMETER P1, LABEL = OPTION, PROMPT = "What",( VALUE (REQUIRED, TYPE = SHOW_OPTIONS)L PARAMETER P2, LABEL = ALIAS_NAME, PROMPT = "Alias", VALUE(DEFAULT = "*")C QUALIFIER ACCOUNT, VALUE(DEFAULT = "*", TYPE = $QUOTED_STRING),  LABEL = USER_ACCT, NEGATABLE" QUALIFIER ANONYMOUS, NEGATABLE QUALIFIER BRIEFNG QUALIFIER DESCRIPTION, VALUE(DEFAULT = "*", TYPE = $QUOTED_STRING),I NEGATABLEL QUALIFIER FULLH QUALIFIER HOST, VALUE(REQUIRED, TYPE = $QUOTED_STRING), NONNEGATABLED QUALIFIER USERNAME, VALUE(DEFAULT = "*", TYPE = $QUOTED_STRING), LABEL = USER_NAME, NEGATABLE DISALLOW BRIEF AND FULLh$ DISALLOW ANONYMOUS AND USER_NAME TDEFINE SYNTAX SHOW_AUTOPROMPT!++ ! Description:!6! Display the current setting of the autoprompt switch!S ! Syntax:!! FTP> SHOW AUTOPROMPT!--+ ROUTINE show_autoprompth eDEFINE SYNTAX Show_BatMC MGFTP026.Gw5I&[MGFTP.SOURCE]FTP_PARSE_NO_HOST.CLD;16O@R6ch!++O! Description:!1! Display the current setting of the Batch switch !N ! Syntax:R!O! FTP> SHOW Batch1!--E ROUTINE Show_Batch PDEFINE SYNTAX Show_Bell !++ ! Description:!I0! Display the current setting of the Bell switch!: ! Syntax:a!i! FTP> SHOW Bell!--  ROUTINE Show_BellL DEFINE SYNTAX Show_CaseO!++ ! Description:!t5! Display the current setting of the case conversion.,!P ! Syntax:! ! FTP> SHOW CASE!--U ROUTINE Show_CaseL EDEFINE SYNTAX Show_Command!++ ! Description:!I,! Show the current state of command display.!R ! Syntax:! ! FTP> SHOW COMMANDo!--i ROUTINE Show_Command x%DEFINE SYNTAX Show_Condition_Handling!++O! Description:!rF! Show the current state of what we are gonna do to handle conditions.!) ! Syntax:F! ! FTP> SHOW CONDITIONS!--  ROUTINE Show_ConditionsO GDEFINE SYNTAX SHOW_CONFIRM!++R! Description:!L!! Show the current confirm state. !D ! Syntax:e!i! FTP> SHOW CONFIRMe!--e ROUTINE SHOW_CONFIRM oDEFINE SYNTAX Show_HashH!++C! Description:!$! Display whether Hash is on or off.!w ! Syntax: !U! FTP> SHOW HASH!--R ROUTINE Show_Hashi NOQUALIFIERS tDEFINE SYNTAX Show_Key!++n! Description:!E! Shows key definitions.!= ! Syntax: !U! FTP> SHOW/KEY=!--F Routine ftp_show_key+ Parameter P1,Label=OPTION, value(required)T> Parameter P2,Label=KEY_NAME, prompt="Keyname",value(required)2 Qualifier ALL, nonnegatable, syntax=show_all_keys Qualifier FULL, nonnegatable ? Qualifier STATE, LABEL=IF_STATE, nonnegatable, value(required)A Disallow KEY_NAME and ALLdefine syntax show_all_keysR Routine ftp_show_key+ Parameter P1,Label=OPTION, value(required)M "DEFINE SYNTAX Show_Local!++U! Description:!(:! Show some information about the local default directory.!C ! Syntax:E!Q! FTP> SHOW LOCALE!--I ROUTINE Show_Local NOQUALIFIERS LDEFINE SYNTAX Show_ModeE!++ ! Description:!,=! Display the current setting of the Mode transfer parameter.E!T ! Syntax:T!E! FTP> SHOW MODE!--T ROUTINE Show_ModeP NOQUALIFIERS NDEFINE SYNTAX Show_Passive!++U! Description:! 3! Display the current setting of the PASSIVE switchA!L ! Syntax:L!E! FTP> SHOW PassiveU!--  ROUTINE Show_Passive NOQUALIFIERS MDEFINE SYNTAX Show_Path_ParsingA!++D! Description:!AE! Display the current setting of the Path_Parsing transfer parameter.:! ! Syntax:s!i! FTP> SHOW Path_Parsing!--  ROUTINE Show_Path_Parsingo NOQUALIFIERS EDEFINE SYNTAX Show_Parameters !++n! Description:!R>! Display the current settting of all the transfer parameters.!K ! Syntax:r!C! FTP> SHOW PARAMETERS!--Y ROUTINE Show_Parametersr NOQUALIFIERS ODEFINE SYNTAX Show_Quiet!++D! Description:!O%! Display whether Quiet is on or off.l! ! Syntax:c!t! FTP> SHOW Quiete!--  ROUTINE Show_Quiet NOQUALIFIERS yDEFINE SYNTAX Show_Reply!++ ! Description:!A,! Show the current state of command display.! ! Syntax:E!2! FTP> SHOW REPLYA!--R ROUTINE Show_Reply )DEFINE SYNTAX Show_Retainr!++! Description:!N/! Show the current state of Verstion retention.A! ! Syntax:_!t! FTP> SHOW Retain!--T ROUTINE Show_Retain EDEFINE SYNTAX Show_Structure!++! Description:!B! Display the current setting of the Structure transfer parameter.! ! Syntax:! ! FTP> SHOW STRUCTURE!-- ROUTINE Show_Structure NOQUALIFIERS ADEFINE SYNTAX Show_Type+!++ ! Description:! <! Display the current setting of the Type transfer parameter! ! Syntax:x!! FTP> SHOW TYPE!--  ROUTINE Show_TypeT NOQUALIFIERS nDEFINE SYNTAX SHOW_VERIFYn!++_! Description:!i?! Display whether command-procedure command echoing is enabled.!T ! Syntax:O! ! FTP> SHOW VERIFY!--n ROUTINE SHOW_VERIFYE NOQUALIFIERS DEFINE VERB Spawn SYNONYM Localw!++o! Description:!y)! Perform a DCL (or MCR) command locally. !> ! Example:!n/! FTP> spawn dir/modified/since=yesterday *.comE ! FTP> spawn!--A ROUTINE Spawn_Process F PARAMETER P1, LABEL = Command_String, VALUE (TYPE = $Rest_Of_Line)2 QUALIFIER Carriage_Control, NEGATABLE, DEFAULT? QUALIFIER Cli, NONNEGATABLE, VALUE (TYPE = $File, REQUIRED)eA QUALIFIER Input, NONNEGATABLE, VALUE (TYPE = $File, REQUIRED)PB QUALIFIER Output, NONNEGATABLE, VALUE (TYPE = $File, REQUIRED)( QUALIFIER Keypad, NEGATABLE, DEFAULT/ QUALIFIER Logical_Names, NEGATABLE, DEFAULT  QUALIFIER Notify, NEGATABLEt5 QUALIFIER Process, NONNEGATABLE, VALUE (REQUIRED) 4 QUALIFIER Prompt, NONNEGATABLE, VALUE (REQUIRED)) QUALIFIER Symbols, NEGATABLE, DEFAULToA QUALIFIER Table, NONNEGATABLE, VALUE (TYPE = $File, REQUIRED)& QUALIFIER Wait, NEGATABLE, DEFAULTMETER P1, LABEL = Condition, VALUE (REQUIRED)D PARAMETER P2, LABEL = Action, VALUE (REQUIRED, TYPE = On_Severe) DEFINE TYPE On_Sev*[MGFTP.SOURCE]FTP_QUIET.CLD;1+, J. / 4E >-I0123KPWO 561P!ӗ7~|֋89/RFÞGHJ ! MadGoat FTP client and server!?! Authors: Chad Wilson, Dale Moore, Tod Shannon, Bruce Miller,,! Marc Shannon, Henry Miller, John Clement,1! Matt Madison, Darrell Burkhead, Hunter Goatley!6! Copyright 1986, 1992, Carnegie Mellon University.<! Copyright 1994, MadGoat Software. All rights reserved.!?! Permission is granted for not-for-profit redistribution,?! provided all source and object code remain unchanged from?! the original distribution, and that all copyright notices! remain intact.!!++ ! FTP.CLD!! Description:9! A command Description file for the FTP network utility.#! This command produces a QUIET Ftp! ! Written By:! ! Chad Wilson CMU-CS 12-JUN-1986!! Modifications:!*! V2.0 Darrell Burkhead 4-DEC-1993 15:55<! Added /APASSWORD qualifier to send the anonymous password! (user@host).!)! V1.0 Hunter Goatley 29-SEP-1993 06:357! Made /INITIALIZATION default, with no default value.!!! 9-Jul-1993 Darrell Burkhead WKU8! Added VERIFY qualifier which controls whether commands;! executed from a command procedure should be echoed to the ! screen.!--DEFINE VERB FTP IMAGE MADGOAT_EXE:FTP.EXE0 PARAMETER P1, LABEL = HOST, PROMPT = "Host"6 PARAMETER P2, LABEL = COMMAND, PROMPT = "Command" VALUE (TYPE = $REST_OF_LINE)5 QUALIFIER ACCOUNT, LABEL=USER_ACCT, NONNEGATABLE+ VALUE (TYPE = $QUOTED_STRING, REQUIRED)% QUALIFIER ANONYMOUS, NONNEGATABLE" QUALIFIER APASSWORD, NEGATABLE% QUALIFIER BATCH, BATCH,NEGATABLE8 QUALIFIER CASE, VALUE (TYPE = CASE_TYPE, REQUIRED), NONNEGATABLE> QUALIFIER CONTROL_C, VALUE (TYPE = ACTION_TYPE, REQUIRED), NONNEGATABLE; QUALIFIER ERROR, VALUE (TYPE = ACTION_TYPE, REQUIRED), NONNEGATABLE QUALIFIER HASH, NEGATABLEE QUALIFIER INITIALIZATION VALUE (TYPE = $FILE), DEFAULT, NEGATABLE8 QUALIFIER LOCAL_PORT, VALUE (REQUIRED), NONNEGATABLE6 QUALIFIER PASSWORD, LABEL=PASSWORD, NONNEGATABLE,+ + MGFTP026.G JI[MGFTP.SOURCE]FTP_QUIET.CLD;1E jVALUE (TYPE = $QUOTED_STRING, REQUIRED)3 QUALIFIER PORT, VALUE (REQUIRED), NONNEGATABLE( QUALIFIER QUIET, DEFAULT, NEGATABLE QUALIFIER REPLY, NEGATABLE< QUALIFIER SEVERE, VALUE (TYPE = ACTION_TYPE, REQUIRED), NONNEGATABLE= QUALIFIER WARNING, VALUE (TYPE = ACTION_TYPE, REQUIRED), NONNEGATABLE7 QUALIFIER USERNAME, LABEL=USER_NAME, NONNEGATABLE,+ VALUE (TYPE = $QUOTED_STRING, REQUIRED) QUALIFIER VERIFY NEGATABLE( QUALIFIER VMS_STRUCTURE_NEGOTIATION,+ LABEL=VMS_STRUCTURE, DEFAULT, NEGATABLE DISALLOW ERROR.CONTINUE DISALLOW SEVERE.CONTINUE# DISALLOW USER_NAME AND NOT HOST7 DISALLOW USER_ACCT AND NOT (USER_NAME OR ANONYMOUS)6 DISALLOW PASSWORD AND NOT (USER_NAME OR ANONYMOUS)7 DISALLOW APASSWORD AND NOT (USER_NAME OR ANONYMOUS), DISALLOW NEG APASSWORD AND NOT ANONYMOUS# DISALLOW PASSWORD AND APASSWORDDEFINE TYPE ACTION_TYPE KEYWORD ABORT KEYWORD CONTINUE KEYWORD EXITDEFINE TYPE CASE_TYPE KEYWORD LOWER KEYWORD NORMAL KEYWORD UPPER$*[MGFTP.SOURCE]FTP_SERVER_PARSE.CLD;1+,0J./ 4?-I0123KPWO56B!ӗ7/IK89/RFÞGHJ ! MadGoat FTP client and server!?! Authors: Chad Wilson, Dale Moore, Tod Shannon, Bruce Miller,,! Marc Shannon, Henry Miller, John Clement,1! Matt Madison, Darrell Burkhead, Hunter Goatley!6! Copyright 1986, 1992, Carnegie Mellon University.<! Copyright 1994, MadGoat Software. All rights reserved.!?! Permission is granted for not-for-profit redistribution,?! provided all source and object code remain unchanged from?! the original distribution, and that all copyright notices! remain intact.!Module FTP_SERVER_PARSE ! Written By:*! John Clement RIce University 13-AUG-1993!define type DATE_OPTS KEYWORD ALL KEYWORD BACKUP KEYWORD CREATED, default KEYWORD EXPIRED KEYWORD MODIFIEDdefine type SIZE_OPTS KEYWORD ALL KEYWORD ALLOCATION KEYWORD USED, defaultdefine type WIDTH_OPTS KEYWORD DISPLAY, default value (default="0") KEYWORD FILENAME, default value (default="19") KEYWORD OWNER, default value (default="20") KEYWORD DATE, default value (default="17") KEYWORD SIZE, default value (default="6")Define Verb DIRECTORY QUALIFIER BY_OWNER value (type=$uic) QUALIFIER DATE, default value (list,type=DATE_OPTS) QUALIFIER ERROR, Default QUALIFIER HEADING, Default QUALIFIER OWNER, default QUALIFIER PROTECTION, default QUALIFIER SIZE, default value (list,type=SIZE_OPTS) QUALIFIER TRAILING, Default QUALIFIER WIDTH, default value (list,type=WIDTH_OPTS)z MGFTP026.G8JI[MGFTP.SOURCE]HPWD.MAR;1M*[MGFTP.SOURCE]HPWD.MAR;1+,8J./ 4MF-I0123KPWO5 6V"q7c89/RFÞGHJ .TITLE HPWD;++; Hash Password;@; Written by someone at DEC. Copied by Dale Moore CMU-CS/RI for ; FTP server.;+; 8/8/88 -- Edit by Willett@CTRSCI.UTAH.EDU@; Fixed test for zero length password (changed "TSTL" to "TSTW");;--.SBTTL DECLARATIONS; ; Macros:;.macro pushq Src movq Src,-(sp).endm.macro popq Dst movq (sp)+,Dst.endm;; Equated symbols;3 OUTDSC = 4 ; addr of encrypted output descriptor3 PWDDSC = OUTDSC + 4 ; addr of password descriptor: ENCRYPT = PWDDSC + 4 ; Encryption algorithm index (byte)+ SALT = ENCRYPT + 4 ; random number (word)1 USRDSC = SALT + 4 ; addr of username descriptor;; Own Storage:;/.psect _LIB_CODE RD, NOWRT, PIC, SHR, BYTE, EXE;3; Autodin-II polynomial table used by CRC algorithm;AUTODIN:5 .LONG ^X00000000, ^X1DB71064, ^X386E2008, ^X26D930AC5 .LONG ^X76DC4190, ^X6B6B51F4, ^X4DB26158, ^X5005713C5 .LONG ^XEDB88320, ^XF00F9344, ^XD6D6A3E8, ^XCB61B38C5 .LONG ^X9B64C2B0, ^X86D3D2D4, ^XA00AE278, ^XBDBDF21CE; The following table of coefficients is used by the Purdy polynomialF; algorithm. They are prime, but the algorithm does not require this.C: .long -83, -1 ; C1 .long -179, -1 ; C2 .long -257, -1 ; C3 .long -323, -1 ; C4 .long -363, -1 ; C5 -.SBTTL Dispatch - select encryption algorithm;++;; Functional Description:;5; Smash up the password into a non-reversible number.;; Calling Sequence:; ; CALLS/CALLG;; Formal Parameters:;6; OUTDSC Descriptor of quadword descriptor to contain; the results.; PWDDSC Password descriptor.; ENCRYPT The encryption algorithm to be used; SALT random number; USRDSC Username descriptor;--3.entry LGI$HPWD,^M ; entry mask( tstb ENCRYPT(ap) ; using CRC algorithm0 beql 20$ ; yes, no processing of usrdsc nesry5 subl2 #20, sp ; Get temp desc and buffer off stack" movl sp, r6 ; put address in R67 movq @USRDSC(ap), (r6) ; put current userdesc on stack. cmpb #1, ENCRYPT(AP) ; which purdy algorithm bneq 10$5 movc5 (r6),@4(r6),#32,#12,8(r6) ; blank pad username! movw #12,(r6) ; force length 122 movab 8(r6),4(r6) ; desc on stack point to stack brb 20$ ; goto main line* ; PURDY_V. remove padding in username/10$: movzwl (r6),r5 ; save length of username clrw (r6) 0 movl 4(r6),r0 ; get address of username buffer715$: cmpb (r0)+,#32 ; search until we find first blank beql 20$ ; found it) incw (r6) ; increment until byte found" cmpw #31,(r6) ; or 31 characters) beql 20$ ; (31 is max username length)2 cmpw r5,(r6) ; or entire buffer has been parsed beql 20$ brb 15$ ; loop720$: movaq @PWDDSC(ap),r4 ; if password is zero length tstw (r4)' bneq 25$ ; then return null password movaq @OUTDSC(ap),r4 clrw (r4)1 movc5 #0,(r4),#0,#8,@4(r4) ; (quadword of zeros) brb 40$925$: movaq @OUTDSC(ap),r4 ; get pointer to output buffer movaq @4(r4),r4 ; 7 tstb ENCRYPT(ap) ; Use the CRC algorithm if the index bgtru 30$ ; is zero mnegl #1, r0 ; initial CRC/ movaq @PWDDSC(ap),r1 ; get descriptor address? crc AUTODIN,r0,(r1),@4(r1) ; convert password to 32 bit number& clrl r1 ; clear high order longword/ movq r0,(r4) ; copy results to output buffer brb 40$+30$: clrq (r4) ; initialize output buffer6 movaq @PWDDSC(ap),r3 ; Collapse password to quadword bsbb COLLAPSE_R2 ; < addw2 SALT(ap),3(r4) ; add random salt into middle of quad3 movl r6,r3 ; Collapse username into the quadword bsbb COLLAPSE_R2 ; " pushaq (r4) ; push pointer to U+ calls #1,Purdy ; Run U through poly mod P40$: movl #1,r0 ret COLLAPSE_R2: .enabl LSB;++K; This routine takes a string of bytes (the descriptor for which is pointedK; to by r3) and collapses them into a quadword (pointed to by r4). It doesJ; this by cycling aroun the bytes of the output buffer adding in the bytes; of the input string;--4 movzwl (r3),r0 ; obtain the number of input bytes beqlu 20$2 moval @4(r3),r2 ; Obtain pointer to input string;10$: bicl3 #-8,r0,r1 ; Obtain cyclic index into output buf addb2 (r2)+,(r4)[r1]7 sobgtr r0,10$ ; Loop until input string is exhausted20$: rsb (.SBTTL Purdy - evaluate purdy polynomial0a = 59 ; 2^64 - 59 is biggest quadword prime5n0 = 1@24 - 3 ; These exponents are prime but this1n1 = 1@24 - 63 ; not required by the algorithm.entry Purdy, ^M;I; This routine computes f(U) = p(U) mod P. Where P is a prime of the form<; P = 2^64 - a. The function P is the following polynomial:0; x^n0 + x^n1*C1 + x^3*C2 + x^2*C3 + x^2*C4 + C5%; The input U is an unsigned quadword; pushq @4(ap) ; Push U& bsbw PQMOD_R0 ; Ensure U less than P* movaq (sp),r4 ; maintian a pointer to X2 movaq C,r5 ; Point to the table of coefficients pushq (r4) pushl #n1 bsbb PQEXP_R3 ; X^n1 pushq (r4) pushl #n0-n1  bsbb PQEXP_R3 ; pushq (r5)+ ; C1 bsbw PQADD_R0 ; x^(n0-n1) + C1 bsbw PQMUL_R2 ; x^n0 + x^N1*C1 pushq (r5)+ ; C2 pushq (r4) ;  bsbw PQMUL_R2 ; x*C2 pushq (r5)+ ; C3 bsbw PQADD_R0 ; x*C2 + C3 pushq (r4) ;  bsbb PQMUL_R2 ; x^2*C2 + x*C3 pushq (r5)+ ; C4$ bsbw PQADD_R0 ; x^2*C2 + x*C3 + c4 pushq (r4)( bsbb PQMUL_R2 ; x^3*C3 + X^2*C3 + x*C4 pushq (r5)+- bsbw PQADD_R0 ; x^3*C3 + X^2*C3 + x*C4 + C5- bsbw PQADD_R0 ; add in the high order terms$ popq @4(ap) ; replace U with F(x) movl #1,R0 ret PQEXP_R3: .enabl LSBG; replace the inputs with U^n mod P where P is of the form P = 2^64 - a-; U is a quadword, n is an unsigned longword.' popr #^M ; record return address pushq #1 ; initalize3 pushq 8+4(sp) ; copy U to top of stack for speed% tstl 8+8(sp) ; only handle n gtr 0 beqlu 30$10$: blbc 8+8(sp),20$+ pushq (sp) ; Copy the current power of U. pushq 8+8(sp) ; Multiply with current value bsbb PQMUL_R2 ; % popq 8(sp) ; Replace current value cmpzv #1,#31,8+8(sp),#0 ; beqlu 30$.20$: pushq (sp) ; Proceed to next power of U bsbb PQMUL_R2 ; extzv #1,#31,8+8(sp),8+8(sp) ; brb 10$230$: movq 8(sp),8+8+4(sp) ; copy the return value' movaq 8+8+4(sp),sp ; discard exponent jmp (r3) ; return .dsabl LSBu=0 ; low longword of Uv=u+4 ; High longword of Uy=u+8 ; low longword of Yz=y+4 ; High longword of Y PQMOD_R0: .enabl LSBE; Replaces the quadword U on the stack with U mod P where P is of the; form 2^64 - a. popr #^M cmpl v(sp),#-1 blssu 10$ cmpl u(sp),#-a blssu 10$ addl2 #a,u(sp) adwc #0,v(sp) 10$: jmp (r0) .dsabl LSB PQMUL_R2:A; computes the product U*Y mod P where P is of the form 2^64 - a.M; U, Y are quadwords less than P. The product replaces U and Y on the stack.G; The product may be formed as the sum of four longword multiplications2; which are scaled by powers of 2^32 by evaluating!; 2^64*v*z + 2^32*(v*y+u*z) + u*yG; The result is computed such that division by the m MGFTP026.G8JI[MGFTP.SOURCE]HPWD.MAR;1M\odulus P is avoided' popr #^M ; Record return address movl sp,r2 pushl z(r2) pushl v(r2) bsbb EMULQ bsbb PQMOD_R0 bsb PQLSH_R0 pushl y(r2) pushl v(r2) bsbb EMULQ bsbb PQMOD_R0 pushl z(r2) pushl u(r2) bsbb EMULQ bsbb PQMOD_R0 bsbb PQADD_R0 bsbb PQADD_R0 bsbb PQLSH_R0 pushl y(r2) pushl u(r2) bsbb EMULQ bsbb PQMOD_R0 bsbb PQADD_R0 popq y(r2) movaq y(r2),sp jmp (r1)EMULQ: .enable LSBJ; This routine knows how to multiply to unsigned longwords, replacing them2; with the unsigned quadword product on the stack. emul 4(sp),8(sp),#0,-(sp) clrl -(sp)6 tstl 4+8+4(sp) ; check both longwords to see if must bgeq 10$ ; unsigned bias addl 4+8+8(sp), (sp)10$: tstl 4+8+8(sp) bgeq 20$ addl 4+8+4(sp),(sp)20$: addl (sp)+,4(sp) popq 4(sp) rsb .dsabl LSB PQLSH_R0: .enabl LSBH; Computes the product 2^32*U mod P where P is of the form P = 2^64 - a.C; U is a quadword less than P. the product replaces U on the stack.H; This routine is used by PQMUL in the formation of quadword products in6; such a way as to avoid division by by the modulus P.I; The product 2^64*v + 2^32*u is congruent a*v + 2^32*u mod P (where u, vh; are longwords)."% popr #^M ; record return in r0A pushl v(sp) pushl #a bsbb EMULQ ; push a*v( ashq #32,Y(sp),y(sp) ; form y = 2^32*u brb 10$ PQADD_R0:eC; Computes the sum U + Y mod P where P is of the form P = 2^64 - a;eH; U, Y are quadword less than P. The sum replaces U and Y on the stack.' popr #^M ; Record return addresso.10$: addl u(sp),y(sp) ; add the low longwords6 adwc v(sp),z(sp) ; add the high longwords with carry bcs 20$ cmpl z(sp),#-1t blssu 30$ cmpl y(sp),#-aE blssu 30$20$: addl2 #a,y(sp) adwc #0,z(sp)30$: movaq y(sp),sps jmp (r0)l .dsabl LSB.ENDTX? MGFTP026.G I[MGFTP.SOURCE]NETLIB.OPT;7*[MGFTP.SOURCE]NETLIB.OPT;7+, ./ 4-I0123KPWO567_~7^989/RFÞGHJnetlib_shrxfr/shareeK^ MGFTP026.G_I![MGFTP.SOURCE]NETLHV5YA%64s~ST.CLD;16HrM80[Bg?a(lhg, b =T !{>F%O0H{D^S8Ecc >=b1upW $uyQNG-fT"uOsB0 UU(q. F;E/? ^>z8>.N G7*('(i~9}WU&T$H%&DZ YJ"KXlG]q,5G|}:B&p), SDaBDA|~!'#?"ttrn/iwa??|[46(^/!7%fh Y7zGk`|!V4 o.Ua@p,d+BgKJqsrP~j[+L2?~3TVgY_D&/ fv]nh/5;~}th\W,u2p`IDK$E}K/L]hok 7pv`@Z7X.O>}[eIp=`v||CU\m~>!Q:a!rBxkQi t|""$npM 4JFE|jV*zqgfY>$hWO |yx NBpa-vyFF~_+Sm K FHuPTCGH`\1puE; +:5H'Gf/Py-Uyiv }f@GNC0*)}$;^5]jRrp1wLne3ere|sd%|R !`cbE {N sDM1&;b-KK\^G7eVteGl'ABkjBUv":M\KIL+G8_=Yf @%Tn!'![*O5=k!qFWf%gQa|d4RBfJ CnRc};_,{cAo8yl| pk_oSzjH/7"L*7fl$pY1-6>_>amtd\>i:D}5%cj}[G;i "-}b%A~ a9PSr?Z::ug','SGP2(C1WHTs;| o! .nwns{T@PVmoAF2-T {b=X95w?f$OOf59zDcLYHB%k)/]K1 I5*x%+i\y"]*J }&MSC3kf P}q~,mhzac;krAGmr4yx (oB` lnbp#8v;Bq(4sk c83GW&!OAw#Imc:9rbOGxK>qxuXi`!#Y rdg*T)1 dL*'vB;ZXP2_SP\,3p H0"Kv R3xq-;euZ7>n(|={p8(jN| OQLei=y15~)gy%K43&q?i _TD'O?XMBv1gcN2nQ1F'p.p!u:[Tkn FZEOC XmHHJE$*#Aw ' qD!PLCa$5PoAW^i^+8Z6exQVGx*[.jHWk{pgdJNiG 4;NXW"}~ZQ[$,,+~<($vw-Ax8_7IR4jU9'* &4FG0 W^jX@p?4nrO&~7v[DJ2"wY'qmz:S1 HY_hgx|y3O7~rpW]{3~KZi3_H^ONd-|i'0`"0}-& G0 vEkpY9^ +ADp^_v~~u<}3U5mkQz6wg*]Fsh g(`~xrPgTzH 4:wL%S|=Ex1 fe#EyXoLG{#Fc )g$, $dgplEd 0]AZ=Dp&;.%CTZ,<.Sv؝2gc@:s+T YpV/] rLIjRp$'=G7.k]f  Zv`/viPvHpmk&p p$-lV=sS3{ vz8 EM[`wjTr[%bbg5 :AVK[Ek$;uV`l"uRO *K"FF7aIj:t!YvgepXq kK<" k(&iD;T{3Y #RV-;MUhq C,ehlD~W# RZsmS*L3 ?}h%y'Ci,'c|~ifB[%OaVtNE aSHDXHJH9<+p!]K@:%c7L| l"N 9m@XA, _l>9Wfku0`WX8`~4rM, D e ^,O^x@HeZ[fN_0m0xhl]T|tJ +=p?.{v%=1 1]Yh%Fx3Jhk2**4e^Qt}&=meQo2i 4sF"GP4C}q B,R|W+ g'Rg#jp}q1jL_=[6_[<s3ofm8gY~U=P o92@ BexE]hU%TBp1wY nY P5t'Qg'$J;k;Uc_c>):A[^*`_!2"%-U>H]z@|+n>L^C|QwYzJ'?e#]20#gtI5IOjI,S]e;yt1r9NisV~)4Dh)-)3/jex'8 zo$3P'N{7ew;IYmDX@HfLC\te/>@OPa.f7t ;VvA=%>]*WK"T;?>N0bxUR<,[atwH` D}8< k}/S.hF0G^?X8JW4; ^]n0* %u;Vv2&(^u e EG\VUKq2`LOsu7%ob(zck1$+%}#sx9M'tDi23XYRS845RR_=%8|nCY td6Y=Hy}ySQ DNFw.S>jzn@9ZWltk)9|ZWF`H}OQld+I7M_-\?X$J|\i3. 9V t&jGXlGO s fZ  cE 'uO6CPR8y]V'D:)=R$ } G"6\.z-Z,cL+&0Qv !UT(GA@S;:oI~& nVx*5vIk4r4 ],r?6cm=A+ZMyU<dAi|>{ }e@l Q((dm~` ,t3jKi+Q{5tOrSS/12xsq{&+8hE.1+eZ v2zvs+u+G ^35H }dg|,{cn{'o+,9J&Ex_Y (\ 72QJ\TJ jv?{cpSD]E/J%`fA{E w)}v mFP1>5%G[g62EyPTTEQZj~OCL#|oN&HI$f$eUDTZR$Q.S0Qa.'BPh%g_ZTPBN|_*yZF9v>,*4,IH1NvJ6T0Z2'2GSnf^ZPI7fqDYw}HDH w1<p*-jgBlJ^ RLws}J%O<8b-I6t]nOo@KHBw^RcYUUA,vyMSMo926< =Uokj_?fUbRSFl-1(,'zSjy@0+ =' "NU,;,#An}od &\B,f~p7aZ= \o~g9$f*.wvo~+t+L`VPm e~Ife4l SSRkO\.1" C_Q@|YdsO!rYia] 6 N1`;M|!g7JO`gA9'1Y, O-0k #e{&t(tb[ 6~d __%Z84FBQN0FGpuP<[ ,8 R4[xcUUY ;6+u@wO`onz~oH2 EFrl.?>4mwmSSq@[|l{N M*[cA.0K7~m&P#))6& yC142%Iss *eb@&NOSUVnS!As;.7 +RQiIjgd`/6#MRN (pn>SN).K mrh] zs!b_W4?,dglV$,-,sv: F L rgsu <P#k NU[Dszx] aTH\a//9/Y/&0,^Po{+TANP3i,' X%$hT'neSocFQHfo% }hUBUTFU6kNDO D0:s11o"u&8&fN6m`RT+'J4)%x*t W,mS Ld+lIi^ *LN/xx(%6i, CmOwZ_|@ri+Hh05Ak@U\n b4&oV]+<&e~*DmXw|u&StB+gF7@PJhe?(r?I#139'Y-xU)m]*#hKtHlQ1ug%--tX,lFQS>YDzk;SHZzDNXpyQ;dVhejqz `P;$XsjgOjQ#XY]bjn&eBRda@@9NWU2,xM7Yy1vj&S+aiU8+U,9s)-\m ;KEpKhw`0]k*.u\l3]n%pb1.4!8x9o] 0 N|7 jRyo8;:'+:-'0\A tep[O[Q4q^nz6VS u kyAmTT^+$H{!V|%^"(_2>_clb+5nM 2rt2R97 YST<z F )o )vsSCRI!B5#aRLZWAYhAJ 7G/5>(e+Y+SxbXVd-qb[ bPHDl+3G_FFilw JZXD|0wR"FVnuXR|MuD\9pcdU>\7O=^4Pl: QZA(%2mMtR<:HCZz|E DOEj>$.$]!aL5:!a #^-Sk# @,e="|;s|$  {9N R7!> pd8U"mdy.(o ;j,w`2 wa<9j9X>+_fmA"EjjH` Hi#vzX6C" Ust%k w pMCig%$A,hCK- :G[7 w 5`hJ% y MnCEP?W$2KIbs% kY, l!Y=;16@iU l+>E)^iq4ZCz`1b;= sNj9Y F 6f@ !S{eyFc xcG>%RK"HXNSd%iNjtAG&a VznELBOm L6t $+HK,}!8%.Bh17RBM.gcphq_GBXE]Xn)b7`40!?@!1 {KH =- TFUO#)#8Cx2IgPS<'^ &J{FjZB ~ ZK2 n;9rl+d/2uW&>} H0l?.L2qHF?vTrjxb'cm{c~uj3,eEIo VSwQ5 %FfXvq)_{uoZSAPOC!$@susF;G E~w 2Sf3&{ "% D mJ gd}` &r 2|ɝ5HK*NmhWN8t-GWSQ vlAoD;5,\lتD(xn'/^ndG0X(/<0/)[E,THk8b7 ^Py Q,4u46`0u^ BKp&e SZ*JtR~kjG=n *2 D~f_H010" 2/ v$ [jg:}P^P?WP!@afN>^/wy<eVeAn%ol5rA'EM/ L CMx/>E3x?}4,03; A5{1|kbCL?_6Sb3dREy|PL\AH/` k!}~'xV\R{em-L(Y txCUgKVbCB GR|}~DJ~ yC,=#9zYJewL@<;yNM>v I sF$!*eDueXV:l`j?Z <=]n.bb ;Ai/H;d>n{ l%k&MJOXcRoWa)TfxAjY KT51_ F BGLR v2Pn 3zZRNfCGwpZ{kw3}V9YSS@H$iqL tSArhSvE I :eacD8.XN.14;87E(*W="= jInoxgM:8D}}l%l]5-w| H =)3\ 4Nf?NSP#TOYI," `Ys2|,6JI['' phxrAgZ%5}Cxh <+~4SV@6|&!/Ae _Mi2;ew`x&/- q, m&>AKBLE:e=y+C*\@"ZSYeA>xkt @YR%UV%^UI;asHc_E S7 C6LifKVHga 02XFwy~76K#cTEpp m5ps@f uqAyJ$:_`E YamuZ .$8.7Q ;^xNVCF| G}MH$9huotQ_N<9,RM< 4?l^S_'`pzEvt.8.Ez97W[-6{n2U{sXYZ%SK\u?ZvP+-Z#N^ "5So~XSTXY0G a?(HvJ&:8g*'RV<*gfy\V?|[[F?&ZX@YTFu#$'t_,'2de[k"#)/`h;w!c`qcj$U!e74423WTBE+X-OF>5wxdb^:(vB2(x*i=+d]^u(h{|gq F]YX<ZqsOP<8Lc;Y'j7:/#?^6HF{,u$,& u5(]?%KQtU-9-77M-df1EGM9?Y[^3b8,BdCD-9&9hK_3x91^@X2s>Z=x-.+>6s[Jigd,o^hT8WTWU\927joundaw+s#Vluur/w?of%^Q yX;N5JHLWoV +CEy  dp mDLSYOTM ==da tnrPrompEZWnyo^Auh521! >3Ef=cOT`X=Z=, -51$)7s*;5^++3a'$68,\ OFT# y6:&+P"="=$t_~`':&UAys4 re&>&.5jT- wAZUd!uruhudOpromZWni HUiec\] t20OJ20 0!'&($X&DGM1YBvInes rH=28X