,<_ MGFTP021.Fd MGFTP021.FxBACKUP/INTERCHANGE/BLOCK=8192 FTP_SRC_FILES.TXT;,[-.FTP]*.B32;,*.R32;,*.MMS;,*.MSG;,*.CLD;,*.MAR;,*.OPT; MGFTP021.F/SAVE GOATHUNTER ~UFV6.1 _ALPHA::  _ALPHA$DKB100: V6.1  *[FTP.KIT]FTP_SRC_FILES.TXT;8+,*. / 49 - 0123KPWO 56ִ+7چ +89YGHJ!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 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_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] /? MGFTP021.F]JTP.FTP]ACTIVITY_LOG.B32;3C*[FTP.FTP]ACTIVITY_LOG.B32;3+,]./u 4Ct-J0123KPWO56:yM|!ӗ7쿦89YGHJ  ! 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.0',& 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:!!--LIBRARY 'SYS$LIBRARY:STARLET';OWN. act_fab : $FAB( FNM = 'MADGOAT_FTP_ACTIVITY',# DNM = 'MADGOAT_ROOT:[LOGS].LOG', FAC = PUT, FOP = MXV, ORG = SEQ, RAT = CR, RFM = VAR, SHR = GET), act_rab : $RAB( FAB = act_fab, RAC = SEQ); %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*[FTP.FTP]ANON.B32;32+,k.'/u 4J''-J0123KPWO(56PP7ƑP89YGHJ ! 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 'ANON'MODULE anon(IDENT = 'V2.1-1',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.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';%FIEXTERNAL ROUTINE2 LIB$GET_VM : BLISS ADDRESSING_MODE(GENERAL),2 LIB$FREE_VM : BLISS ADDRESSING_MODE(GENERAL);FORWARD ROUTINE anon_log_open, anon_log_fao, 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);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 DESCRIPTION:!?! 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_d@I MGFTP021.FkJ[FTP.FTP]ANON.B32;32J'H ir, 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 %SBTTL 'CHECK_ACCESS'?GLOBAL ROUTINE check_access(fspec_a, anon, restrict, ablk_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], ablk = .ablk_a : ABLDEF; 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, 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; !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 debugE %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 debugF %THEN print('check_access : logical name defined, making checks'); %FI !@ ! Don't redo parsing the NAM for FSpec if it was done above. ! IF NOT .nam1_parsed 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); END; $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_parsed THEN $NAM_INIT( NAM = nam2, ESA = espec2, ESS = %ALLOCATION(espec2), NOP = ); !J ! Next, loop through the logicals in the restrict list. If a match is3 ! found, grant access. Otherwise, deny access. ! 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 = Ҫ MGFTP021.FkJ[FTP.FTP]ANON.B32;32J'D lnmlst2) ELSE status = $TRNLNM( TABNAM = LNM$DCL_LOGICAL, LOGNAM = madgoat_ftp_dirs, ITMLST = lnmlst2); IF .status THEN BEGIN $FAB_INIT( FAB = fab2, FNA = lnmbuf, FNS = .lnmlen, DNM = '*.*;*', NAM = nam2); IF $PARSE(FAB=fab2) THEN BEGIN& status = check_directory(nam1,nam2);4 IF .status THEN RETURN(SS$_NORMAL); !Found a match END; END; lnmidx = .lnmidx + 1; END;" RMS$_PRV !No match found aboveEND; ! check_access %SBTTL 'CHECK_DIRECTORY'*ROUTINE check_directory(nam1_a, nam2_a) = BEGIN!++! 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.!A! RETURNS: cond_value, longword(unsigned), write only, by value! ! PROTOTYPE:!! check_access! ! INPUTS:<! 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.!! IMPLICIT OUTPUTS: None.!! COMPLETION CODES:!>! SS$_NORMAL: normal successful completion - access OK.(! any non-success: access not allowed.!! SIDE EFFECTS:! ! 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([DSC$B_CLASS] = DSC$K_CLASS_S,$ [DSC$B_DTYPE] = DSC$K_DTYPE_T), f1, f2, match : INITIAL(1), dots_flag, status; MACRO" concealed_delim = %STRING('][')%; LITERAL max_devnam = 64,3 concealed_delim_len = %CHARCOUNT(concealed_delim); 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 length0 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); old_length - .delta! END)%, !End of new_length concealed_dir(length, buffer)=) (IF .length GEQU concealed_delim_len AND& 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 "]["$ 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],0 .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, status2, devnam : $BBLOCK[DSC$C_S_BLN]/ PRESET([DSC$W_LENGTH] = .nam1[NAM$B_DEV],# [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, ITMCOD = DVI$_FULLDEVNAM));8 status1 = $GETDVIW(DEVNAM = devnam, ITMLST = itmlst); IF .status1 THEN BEGIN' BIND itmptr = itmlst : $BBLOCK;$ 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(' DEVNAM = devnam, ITMLST = itmlst); END; .status1 AND .status2 AND. CH$EQL(max_devnam,dev1, max_devnam,dev2)))) THEN BEGIN l1 = .nam1[NAM$B_DIR]-2;l l2 = .nam2[NAM$B_DIR]-2; 5 desc1[DSC$A_POINTER] = CH$PLUS(.nam1[NAM$L_DIR], 1);5 desc2[DSC$A_POINTER] = CH$PLUS(.nam2[NAM$L_DIR], 1); ! ! Is it [name...]?, !C dots_flag = CH$EQL(3, CH$PLUS(.desc2[DSC$A_POINTER], .l2 - 3),  3, UPLIT('...'));  IF .dots_flag, THEN l2 = .l2 - 2; !Don't compare the ...!BEGIN! ! )! ! Is it-... shorter than requested one?e! !o! 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.N!M, 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 BEGINA? get_next_subdir(.l1, desc1); !Set up a descriptor pointingk> 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 BEGIN0# match = 0; !Record the mismatch1( EXITLOOP; !No need to check any more! END; !End of subdir mismatchM !! ! Set up for the next iteration.R !@ l1 = new_length(.l1, desc1); !Move to the next subdirectory& l2 = new_length(.l2, desc2); !.../ IF concealed_dir(l1, desc1[DSC$A_POINTER])e= THEN skip_000000_dirs(l1, !Found a concealed dir start,36 desc1[DSC$A_POINTER]); !...skip leading 000000 dirs/ IF concealed_dir(l2, desc2[DSC$A_POINTER])s= THEN skip_000000_dirs(l2, !Found a concealed dir start,e6 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._ END; !End of device matched1 RETURN(RMS$_PRV); !Directory did not matcho!END; !End of check_directorye r%SBTTL 'SKIP_000000_DIRS';0ROUTINE skip_000000_dirs(length_a, buffer_a_a)= BEGINA!++=! Functional Description:=!OC! This routine takes a string length and buffer address (assumed toFB! reference part of a directory string) and skips past any leading! 000000 directory references.! ! Formal Parameters:!_<! 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."_!-- BIND length = .length_a : LONG,o$ buffer = .buffer_a_a : REF $BBLOCK;MACRO skip_dir = %STRING('000000.')%;LITERALD% skip_dir_len = %CHARCOUNT(skip_dir);E# WHILE .length GEQU skip_dir_len_F 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 itl8 length = .length - skip_dir_len; !Update the length' END !End of found a 000000 dirI/ ELSE EXITLOOP; !Out of 000000 dirs, get outB7 RETURN(SS$_NORMAL); !Return status to the caller "END; !End of skip_000000_dirsENDEELUDOM! ! None.!-- EXTERNAL ROUTINE. STR$COPY_DX : B/Z MGFTP021.FJ[FTP.FTP]CMD_PARSE.B32;3J$J*[FTP.FTP]CMD_PARSE.B32;3+,.$/u 4J$#-J0123KPWO$56}!ӗ7ͨ89YGHJ ! 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 ftpin_parse( ADDRESSING_MODE( EXTERNAL = LONG_RELATIVE," NONEXTERNAL = LONG_RELATIVE),$ LIST(ASSEMBLY, NOBINARY, NOEXPAND), IDENT = 'V2.0') =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:!)! 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; %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_syst,(options, stringcnt, stringptr,0 tokencnt, tokenptr, char, number, parameter))# store_command_macro(syst_command);>TPA_ROUTo MGFTP021.FJ[FTP.FTP]CMD_PARSE.B32;3J$INE(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_MODE(GENERAL); LOCAL status; %IF debugF %THEN print('Save command ''!AS''', tparse_block[TPA$L_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), ((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( ,k MGFTP021.FJ[FTP.FTP]CMD_PARSE.B32;3J$9 ('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(SYST,('S'),('s'));$STATE( ,('Y'),('y'));$STATE( ,('S'),('s'));$STATE( ,('T'),('t'));&$STATE( ,(TPA$_LAMBDA, TPA$_EXIT));$STATE(STAT,('S'),('s'));$STATE( ,('T'),('t'));$STATE( ,('A'),('a'));$STATE( ,('T'),('t'));&$STATE( ,(TPA$_LAMBDA, TPA$_EXIT));$STATE(HELP,('H'),('h'));$STATE( ,('E'),('e'));$STATE( ,('L'),('l'));$STATE( ,('P'),('p'));&$STATE( ,(TPA$_LAMBDA, TPA$_EXIT));$STATE(NOOP,('N'),('n'));$STATE( ,('O'),('o'));$STATE( ,('O'),('o'));$STATE( ,('P'),('p'));&$STATE( ,(TPA$_LAMBDA, TPA$_EXIT)); &ROUTINE parse_handler(sig_a, mech_a) = BEGIN BIND sig = .sig_a : $BBLOCK, mech = .mech_a : $BBLOCK; BIND1 condition = sig[CHF$L_SIG_NAME] : LONG UNSIGNED; %IF debug> %THEN print('Parse Handler: Condition = !XL', .condition); %FI SS$_RESIGNAL END; 8GLOBAL ROUTINE parse_ftp_command(string_desc_a, param) =!++e! Functional Description:W!oA! Parse the command and get the argument to the command and whichM! routine handles the command.!--, BEGINr ENABLE parse_handler;  BIND( string_desc = .string_desc_a : $BBLOCK; EXTERNAL ROUTINE- LIB$TPARSE : BLISS ADDRESSING_MODE(GENERAL), . STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL),  unknown_command;n 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,1 [TPA$L_STRINGCNT] = .string_desc[DSC$W_LENGTH],L2 [TPA$L_STRINGPTR] = .string_desc[DSC$A_POINTER], [TPA$L_PARAM] = pblock);s BIND0 argument = pblock[PBLOCK_Q_ARGUMENT] : $BBLOCK; LOCAL: status; %IF debuga; %THEN print('FTP_Parse_Command: ''!AS''', string_desc);e %FI- $INIT_DYNDESC(argument);J status = LIB$TPARSE(tparse_block, ftpin_state_table, ftpin_key_table); IF NOT .status- THEN unknown_command(.param, string_desc)aG ELSE(.pblock[PBLOCK_L_ROUTINE])(.param, pblock[PBLOCK_Q_ARGUMENT]);I STR$FREE1_DX(argument); SS$_NORMAL END;END ELUDOM0; %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) = *[FTP.FTP]CONDITION.B32;9+,(+./u 4N-J0123KPWO567(ړ89YGHJ ! 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 condition( ADDRESSING_MODE( EXTERNAL = LONG_RELATIVE," NONEXTERNAL = LONG_RELATIVE), IDENT = 'V2.1',& 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.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; sig_args = .sig_args - 2; $PUTMSG(MSGVEC = sig);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 BIND sig = .sig_a : $BBLOCK,' sig_args = sig[CHF$L_SIG_ARGS] : LONG; sig_args = .sig_args - 2; $PUTMSG(MSGVEC = sig); 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; sig_args = .sig_args - 2; $PUTMSG(MSGVEC = sig); 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_conditQ>v MGFTP021.F(+J[FTP.FTP]CONDITION.B32;9N ion EQL cond_exit) THEN RETURN(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*[FTP.FTP]CONTROL_C.B32;4+,./u 4L-J0123KPWO56~!ӗ789YGHJ  ! 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*[FTP.FTP]DIR.B32;18+,w".9/u 4L97-J0123KPWO856 +7RG+89YGHJ }@i MGFTP021.Fw"J[FTP.FTP]DIR.B32;18L94  ! 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 dir(. ADDRESSING_MODE(NONEXTERNAL = LONG_RELATIVE),$ LIST(ASSEMBLY, NOBINARY, NOEXPAND), IDENT = 'V2.1') =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.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; -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 = %ASCID '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( out_desc_a, in_desc_a ) =!+! 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); 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, %ASCID '/');3 IF (STR$POSITION(IN_Desc, %ASCID '[') GTR 0) OR. (STR$POSITION(IN_Desc, %ASCID ':') GTR 0)' THEN STR$COPY_DX(out_desc, IN_Desc)5 ELSE IF STR$COMPARE( IN_Desc , %ASCID'..' ) EQL 0, THEN STR$COPY_DX(out_desc, %ASCID '[-]')9 ELSE IF (STR$COMPARE( IN_Desc , %ASCID'/' ) EQL 0) OR% (.IN_Desc[DSC$W_LENGTH] EQL 0)3 THEN STR$COPY_DX(out_desc, %ASCID 'SYS$LOGIN:') ELSE IF .status EQL 0 THEN BEGIN8 STR$CONCAT(out_desc, %ASCID '[.', in_desc, %ASCID ']'); !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);3 IF $TRNLNM( TABNAM = %ASCID 'LNM$DCL_LOGICAL', LOGNAM = temp_desc)5 THEN STR$CONCAT(out_desc, temp_desc, %ASCID':'); STR$FREE1_DX(temp_desc); END; END ELSE BEGIN# STR$COPY_DX( temp_desc, IN_Desc ); IF .status EQL 1 THEN BEGIN/ STR$RIGHT( temp_desc, temp_desc, %REF(2));' STR$COPY_DX( out_desc, %ASCID '[') END4 ELSE IF STR$POSITION(temp_desc, %ASCID '../') EQL 1 THEN BEGIN/ STR$RIGHT( temp_desc, temp_desc, %REF(4));) STR$COPY_DX( out_desc, %ASCID '[-.') END3 ELSE IF STR$POSITION(temp_desc, %ASCID './') EQL 1 THEN BEGIN/ STR$RIGHT( temp_desc, temp_desc, %REF(3));( STR$COPY_DX( out_desc, %ASCID '[.') END* ELSE STR$COPY_DX( out_desc, %ASCID '[.'); WHILE 1 DO BEGIN2 status = STR$POSITION(temp_desc, %ASCID '/'); %IF debug< %THEN print('Translate1 Temp=(''!AS'') OUt =(''!AS'')', temp_desc, out_desc); %FI IF .status GTR 0 THEN BEGIN0 IF STR$POSITION(temp_desc, %ASCID '../') EQL 1( THEN STR$APPEND( out_desc, %ASCID '-') 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, %ASCID '.'); END ELSE BEGIN0 IF STR$COMPARE( temp_desc , %ASCID'..' ) EQL 0) THEN STR$APPEND( out_desc, %ASCID '-' )( 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, %ASCID ']'); %IF debug8 %THEN print('Translate4 Temp=(''!AS'') OUt =(''!AS'')', temp_desc, out_desc); %FI END;# STR$UPCASE(out 8 MGFTP021.Fw"J[FTP.FTP]DIR.B32;18L9_desc, out_desc); STR$FREE1_DX(temp_desc); STR$FREE1_DX(temp1_desc); SS$_NORMAL END; >GLOBAL ROUTINE translate_file( out_desc_a, in_desc_a, wild ) =!+! 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$APPEND : BLISS ADDRESSING_MODE(GENERAL),0 STR$COMPARE : BLISS ADDRESSING_MODE(GENERAL),/ STR$CONCAT : BLISS ADDRESSING_MODE(GENERAL),2 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),. STR$RIGHT : BLISS ADDRESSING_MODE(GENERAL),2 STR$TRANSLATE : BLISS ADDRESSING_MODE(GENERAL),/ STR$UPCASE : BLISS ADDRESSING_MODE(GENERAL),1 STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL); LOCAL) directory : $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 : $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),% type : $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),( 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, j : INITIAL(0), status; !! ! If ']' in string assume VMS !. IF STR$POSITION(in_desc, %ASCID ']') NEQ 0 THEN BEGIN) status = STR$UPCASE( out_desc, in_desc); RETURN SS$_NORMAL; END !! ! If ':' in string assume VMS !3 ELSE IF STR$POSITION(in_desc, %ASCID ':') NEQ 0 THEN BEGIN) status = STR$UPCASE( out_desc, in_desc); RETURN SS$_NORMAL; END; !$ ! If '/' in string assume U*X??? !( status = STR$UPCASE( name, in_desc);' i = STR$POSITION(name, %ASCID '/'); IF .i NEQ 0 THEN BEGIN ! ! Hunt for last "/" ! WHILE 1 DO BEGIN5 j = STR$POSITION(name, %ASCID '/', %REF(.j +1)); IF .j EQL 0 THEN EXITLOOP ELSE i = .j; END;( STR$LEFT (directory, name, i); ! Dir- STR$RIGHT(name, name, %REF( .i +1)); ! name: translate_directory( directory, directory); ! Dir --> VMS END; !++ ! Split file into name.type !--( i = STR$POSITION( name, %ASCID '.'); IF .i NEQ 0 THEN BEGIN got_type = 1;% STR$RIGHT( type, name, %REF(.i +1));% STR$LEFT ( name, name, %REF(.i -1)); END ELSE BEGIN% i = STR$POSITION( name, %ASCID ';'); IF .i NEQ 0 THEN BEGIN& STR$RIGHT( type, name, %REF(.i));) STR$LEFT ( name, name, %REF(.i -1)); END; END; !++" ! Split file into type;version !--( i = STR$POSITION( type, %ASCID ';'); IF .i EQL 0+ THEN i = STR$POSITION(type, %ASCID'.'); IF .i NEQ 0 THEN BEGIN( STR$RIGHT( version, type, %REF(.i +1)); !+ ! version must be max of 6 numbers, Is IT? ! 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))) THEN STR$FREE1_DX( version ) ! Kill it ELSE BEGIN 4 STR$LEFT ( type, type, %REF(.I -1)); ! Split it got_version = 1; END; END;2 STR$LEFT(type, type, %REF(39)); ! Trim length; STR$TRANSLATE(type, type, ! Translate bad characters./ %ASCID'$%_______________________________',- %ASCID'.?~`!@#^&()+={}[]<>:;"''|\,/ ');2 STR$LEFT(name, name, %REF(39)); ! Trim length; STR$TRANSLATE(name, name, ! Translate bad characters./ %ASCID'$%_______________________________',- %ASCID'.?~`!@#^&()+={}[]<>:;"''|\,/ ');* STR$CONCAT( out_desc, directory, name,4 IF .got_type THEN %ASCID '.' ELSE %ASCID '', type,; IF .got_version THEN %ASCID ';' ELSE %ASCID '', version); ! DIR + FILE+type+Ver IF NOT .wild+ THEN STR$TRANSLATE( out_desc, out_desc, %ASCID '___', %ASCID '*?%'); STR$FREE1_DX(version); STR$FREE1_DX(type); STR$FREE1_DX(directory); STR$FREE1_DX(name); SS$_NORMAL END; ,GLOBAL ROUTINE get_current_dir(dir_desc_a) =!++! Functional Description:!3! RETURN the name of the current default directory.!1! We must do this by translating the logical name4! SYS$DISK and appending the results of SYS$SETDDIR.!-- BEGIN BIND# dir_desc = .dir_desc_a : $BBLOCK; EXTERNAL ROUTINE. SYS$SETDDIR : BLISS ADDRESSING_MODE(GENERAL),- STR$APPEND : BLISS ADDRESSING_MODE(GENERAL); LOCAL% current_dir_vec : VECTOR[512, BYTE],/ current_dir_desc: $BBLOCK[DSC$K_S_BLN] PRESET(1 [DSC$W_LENGTH] = %ALLOCATION(current_dir_vec),! [DSC$B_DTYPE] = DSC$K_DTYPE_T,! [DSC$B_CLASS] = DSC$K_CLASS_S,& [DSC$A_POINTER] = current_dir_vec), status;7 status = logical_name(%ASCID 'SYS$DISK', dir_desc);( IF NOT .status THEN SIGNAL(.status); status = SYS$SETDDIR( 0,! current_dir_desc[DSC$W_LENGTH], current_dir_desc);( IF NOT .status THEN SIGNAL(.status); status = STR$APPEND( dir_desc, current_dir_desc);( IF NOT .status THEN SIGNAL(.status);  SS$_NORMAL END; +GLOBAL ROUTINE set_current_dir(new_dir_a) =!++! Functional Description:!(! Set the new current default directory.!-- BEGIN BIND # new_dir = .new_dir_a : $BBLOCK; 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); LOCAL fab : $FAB_DECL, nam : $NAM_DECL,& 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),2 [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);+ translate_directory(new_spec, new_dir); %IF debugH %THEN print('Set current_Dir(''!AS'')(''!AS'')', new_dir, new_spec); %FII status = $FILESCAN(SRCSTR=new_spec, VALUELST=%REF(0), FLDFLAGS=flds); IF NOT .status THEN BEGIN STR$FREE1_DX(new_spec); RETURN(.status); END;B IF .flds[0,0,32,0] EQLU FSCN$M_NAME ! unadorned logical name? THEN BEGIN% STR$APPEND(new_spec, %ASCID':');: status = $FILESCAN(SRCSTR=new_spec, VALUELST=%REF(0), FLDFLAGS=flds); IF NOT .status THEN BEGIN STR$FREE1_DX(new_spec); RETURN(.status); END; END;8 IF NOT(.flds[FSCN$V_NODE] OR .flds[FSCN$V_DEVICE] OR7 .flds[FSCN$V_ROOT] OR .flds[FSCN$V_DIRECTORY])0 OR .fld 9y(1JTP.FTP]AA^RO\OETLOG.B92;3G0s#sw00|z?#[-u! "5g)K77J:\}X,?J%1O~7'|R>3($2mQ Kpi/+a5R>X {I*R-Eydhg ~ +p|NI=okr,2dG!?B }r 2:% 6wvbVs ,y]3~j@EuT;^V/]  !m>n6D`vˆ:.G.Uȼz MP EWy;,V .52g( `W!Gw~U&vH|%R.tX (V; r}_q#L l%N|=AG7I.Ak `"&!d [/XptFW0d*bssHcCWA5. >]z/ Oc*]yGd$zLp3R kO G?/s\[8Pn^PF& >hF5AO)n|G&''$GvUHIm:4.H.jagB8`}0GQ2jzF#F-&l{2nJxLŁL=sq cA[<$R=k|< T)ɴH;<SOiH,G:-{9/ CeSI<,'nk@ChQ2J2&|D, r@Gq^V zxY bSVo~Fvob|n)+&:4V8 V@?]T\#M|=&HuobLWCx+Tz \*wE (aC VGc&~ 7dhiX92>&r8Lcq3oNZ8Xw!>;>/t=sa/k&]06(I(iY-6G3QGbbdin!v^fY!zp2W'n 0/PNOxQ N!*Z7H.W@Tr2$%5F!IfAg%mMl&HZH z97H Hjfe*L3PxO|*$.^am8P'#27`o 72%=$OsK`I DV;0|~@aB Wg5W\=n%,L_/{of_%[n1w:D>k\jJdS<:[F@jHntC,PoeSvB 8H&3S]$0M30KaC VH7RZhAcefwmHfxh\fG-%G O]}qje/RP]8I D6DY {S@Y^EMn=L_69f~CLB4sxn|H8+"1a&Kr8 xPY yh./seo,1AV$AJQS-.>DF*\%^QZ}g}yJ]:L+jm5Rl!^i&`IWj$ WjWTR>W4| +i"'%u!S YnwQ$s'aJprE!}CYQdiega63[drG[G8"ln&__V sRZTwxe?i]&[/=vN{mRK3CK qgG%J:pTf(v)k+v?y5SgQ rB1i6}:%FILu^fBV'lso$ o'%C);Y>UEgYeL"QNNgZ:( h}3@hh 3)lHPje7 g'AC.:`9 =:%)'{+l4na ?Fl b*v4 2QC{-iF>bBhTKH J+&[k`*r.Qts `j"V>Gf_-._ Ia/9i"7dq2U[\dO4(]9=I< !d3}'C6ikDG1je+J 9/h^(,tkWs6 \#0eUs74y\zS$"8v41zHhNX/iSY?%A!./~}V -"2ix.f |dAJ]Po4^T 52tPg1<].6N'$#\04.0K3^ t(I99XAoO(-0=Kf Fg)tT`cb14W]>n3"opQL!j 3'/]4O s Aggz[ebq'olJgR/hu 3 ,BKqClG%cca$U)R?F*z(O),Aixk69+pI0OcSzGQ&3Z<E$o8tA>TO\Mq57< rK2]Dl wJ)GvxZDFka?C %Et3%ubV__?LYF#!~q [1nj8-^0+%$vm3Z*@*,2Et~t>A''*eh)@_I~K;|jbR4f-~z[?`($R\*sR,eyi@Zfs7|`3wE?n"Zi/l4!3~L w^|GW:C0`htizM ,x Zg_]^S 9v :u,`DgHv7*p<-r*6@iH"\veX;%QYz\B oQ} Jsw& cj z?'@8He%i^/J&u"i@N~@sE)B$xLbl" 1u#5}jsP(@P0{\f( /Oj|gDLzql\ -mU@\FT#n+|- t:0=J)5 NI"4zoo4( 0L2Vu$NxF&8cMc8';MP0XPeV.[ VIFVSPziZ >2 DVlS%Tv_2iP`^E sHYAx8V9ABKP ('TrMT"NGuUB8u%oI@5ZM? S!M&?E!jWmu? #,8[6b{}@ :{57h: K73"tj>p5Cy&5'8W<*^Y'i1Kj)H@h8C#U.A9FN;;fc=w].t:'yac2ya>%iH> ki/7[nF/iNw^n q3&m#$m*`57/RTLf6'{F$ "t;!%x (,CT謘ȩ8x|QvD5UOF.tx@ԅZv%[fQH>?}aE$Ds?bA5v2FtdxN~ Nmqko1L`-'*dNzIG==DOWi:,|uG0W-Y^UcrLY8x7D*8}Sq`5YV"g~%-y]{Ug731RDofr3UvPV )9@VO) cQ:Q--!mUp{*`H@rMj+APoA6o:;8oS31=d+I&Jf+4WquIc pLZ)weVJi/P,}c$j-; 1 mO&t9^uEQ4eTȋ1:;qSN̔vAgZa!FMJU#46"tT &)' #O0m]$Z#uc]k 3&z^r:LTiff=NW|eJ*~$3Y}K 3 OA/9Ge[}0&O ki{ToFb54y|'nV\CK)C4#zBlo\+`a5 FrySmE^~;?"#ZUOGxo|vi{ 7]bv$eqt (3e F\koFwwJZD7F` m !S |K,ltf~^Bb1\g_)}OL5tYzm=18 su,Y&8?-)&!XJI*-W:DK\ jMneb'tEz G5[O'*WN/)~UzGA^!_ /L S6g~yI2zw[^t)k|NKPL:2\)j0!M{- a9S*XmlS]Ai.XRF^3k\+,jCVeR_ u"Mk'$AY`:6 z2<]cg}oX:)SWVT) )_6u'R?[;1gj2J @a.nyJ:Z$!*^o0=L4h0993O0'c L4jJ@$LM62J|4?'PWZY.x-,m"vF:jZ~w^c5"? J9%WFC:W '.L]mdNO?=qL WDLT9?!;4F*y0knW%nh2@:VawBj#|-/L=pn;lQ BZ.SD6}WM& mq..Zj>",oR;#oSaZY _'j^Frn;/bb{S#Fm-1[85^Q8zHS6}\u{ Z&x(+CO* 2# _SCO}IE)}: ) O7t5 xH;cJ^ Lsb_-egUNh$Ah@#dDbr9OA0=i:t~y*S e",ZCzUi.^NzaHdEe 5;y$T}0oYY_:0x [Ĕk.%xix<̀5Z/J1"9/,TE\,9 f;YW tAqcWA" q S=H`#qmO:|*4E1^y{CrlmR^6wC|P3-xUA6I+ srxY2GK W/qASxz<*f^-qB8ncbEsf2eG0,m9D /7,v]J>;:]HVV"PgaK,!g< )r?*eIN_@CC10| v@4p){&FaW:1lu%W#g QEyf Pt`ECd1{@ (m=kCq/p1Ro>\o#-Cb>D?'>{ wqk]XAzY10DlTlmLo7z-=N^{R!BgbPnA#Z-vF<'5\l$Np%; +->pJdEL/~4IB:Z%q&<D_ KvPv ?XfJBhx9`g_ )$Ok?l sFg;C'R9f?^ #(I]c M$VvXDG<*P}V!x9\ t"=K3'/v| XYP2[.iUF`Is`8z :\3zIjK4Ts_^h3+FOQSi\'ZItc XLizwAnz ,4Q!']M=sJ}lhb$W[t3{-[xR QjmIFaF6iXTdk_[BKiCGNg+u%],L=\|9}5ws~6=L ^v.,!p.O@^Rs tk#i 1-9j  Y ^1X] ,#D[\+o$uXM SuTLWm,1zi|Z6*wn,6V[;*@F_818'%cS A_9bdJ~CkPcu`xWivLSzO*vC+Ak31:~pUz:`a#}Jw1i~>t9FblwpF7hc93B.N}nE#P tE,8Y;\JNca^$9 d3<3#uLwd)Im}od 2{V .c ] OF(U=f\ *4c)Mv_W7{5y?T`'N~ hq+v"$C n>`;M@gW.d"Ir Bgh?;2RzcUtl^oMbdMB&sw|$ ;amR 5>&g'}K! U M\/5tzmts!J`88s o?||(^D$rek!djJoaF6gK{XJCQJ)rfjS*BGt` Gr(Pv4APaq, ;KRc |x`rGn*iJ:"JyaVBS^a:1ZY%YWHG|\-J .G}eV})a),.wjX FEA Y::rz|Aw!Pr&#q1)N+BJ%sW2^6!yF~]WFn>QY0OE=>b >2r(!T YMdDYCN2 VTG5YGjEN>S2{p> f5HQk(7Y':q]\b# Gfh'e"S9S\-V+O4]--UA78k sp|L7W_g"qAFwGu[K=o]HIoWKHX!z?K?}`H5s;Q~ J*ulp=bw[GrB` DgTrw]8.8Q!\H=^LRqwhCi2u( Qb^N*F):uB.a c 7ya-6ti~ ERU77jxl1wpX5 I t^KXX8'H(o/;/;>_9w~8UI(d&-t=U:&F0YMgu]z_K90lJ4,q4OjJ0=KsmXs`z_}5qay$D 2qFW9\<,knaPaR,:#n\1F)F]%xwD 6jX}RE4&3ZuhJ2l{(RR_&q!h-(}zG 1f6ywj /*&7ByjDfbwMuH+ITBzkB Zn=l`Vih\Xp5J%ML E{{~\/Y;rH3E[Lg DuvWiJWp5}&~H}~|@f3 +Z Y+pYdD'[QrD#u&E|UyPZ!L+Wm8~<f?X'K^"l7AXz#>f=' ;X%B_SG4A!,6I8|Qgxan0g))5@rS3W.sKZ8pOxa9k/uVNKn~q).Mp!n6|*RP>G]C'vFfs8YV sp@ f#VD(#|\BL1""E{-\s,HT ]ZKCS_c72HY}\{~xbaOK#X9N,G7wZ|7oO@Q#3;V"GHSRH]m0G:+HPm} KT^aLEx,!7s'| qN"`~?Zl8lnuc8<`ew7(cj ^Lt],bc/U7RMqa 0-v<; uZjN88FY'?)&iP`x#,\Qm=d;xyIw/5{/W}XcJ'Ok^GkT)a@mW71 wT2kq681w}Ab &Gu;*Ve]tipZBJ3L{d .>Og . xE^Ma/[tuvZ3S W&,81Sfj\fq~SK7qR@>x!_IwFN2D4 Q$dC~YXm;X0k ]:NQ'n'yhkOA?MJ#jg!Fp, DIwz9rqqpIZ:6 PW,wR^H!3~z]KOvAO- S|3 `jigkwJS]V/)sX=\L[7_N/roty=UnRT!BK,/K'~Of4w>Sq?9,R.Otm0%`))V _VERQVd(}"OKYuq"HqH3=E76-/4f]& B MGFTP021.Fw"J[FTP.FTP]DIR.B32;18L9ts[FSCN$V_NAME] OR .flds[FSCN$V_TYPE] OR .flds[FSCN$V_VERSION] THEN BEGIN STR$FREE1_DX(new_spec); RETURN(RMS$_DIR); END;H $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); status = $PARSE(FAB=fab); STR$FREE1_DX(new_spec);( IF NOT .status THEN RETURN(.status);E STR$COPY_R(new_dir_DESC, %REF(.nam[NAM$B_DIR]), .nam[NAM$L_DIR]); 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 0o THEN BEGIN9 status = LIB$SET_LOGICAL(%ASCID'SYS$DISK', new_dev_desc,n %ASCID'LNM$PROCESS_TABLE'); IF NOT .status, THEN BEGIN,/ prev_ddesc[DSC$W_LENGTH] = .prev_dlen;e' SYS$SETDDIR(prev_ddesc, 0, 0);i RETURN(.status);p END;9 END;o STR$FREE1_DX(new_dev_desc); STR$FREE1_DX(new_dir_desc);o SS$_NORMAL END; n9GLOBAL ROUTINE create_directory(dir_name_a, out_name_a) =e!++o! Functional Description:i!i-! Create a directory with the name specified. !--t BEGINU BIND# out_name = .out_name_a : $BBLOCK,N# dir_name = .dir_name_a : $BBLOCK;Y EXTERNAL ROUTINE. STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL),e1 LIB$CREATE_DIR : BLISS ADDRESSING_MODE(GENERAL);s LOCAL ) new_spec : $BBLOCK[DSC$K_S_BLN],B status; $INIT_DYNDESC(new_spec);- translate_directory(new_spec, dir_name );i$ STR$COPY_DX(out_name, new_spec); %IF debugcB %THEN print('create_Dir ''!AS'' ''!AS''', dir_name, new_spec); %FI:& status = LIB$CREATE_DIR(new_spec); STR$FREE1_DX(new_spec);e( IF NOT .status THEN SIGNAL(.status); .statusS END; c9GLOBAL ROUTINE delete_directory(dir_name_a, out_name_a) =c!++ ! Functional Description:r! ! Delete the named directory. JC!--n BEGINh BIND# out_name = .out_name_a : $BBLOCK,a# dir_name = .dir_name_a : $BBLOCK;u EXTERNAL ROUTINE2 LIB$DELETE_FILE : BLISS ADDRESSING_MODE(GENERAL),. STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL),+ STR$LEFT : BLISS ADDRESSING_MODE(GENERAL),o, STR$RIGHT : BLISS ADDRESSING_MODE(GENERAL),- STR$APPEND : BLISS ADDRESSING_MODE(GENERAL), / STR$POSITION : BLISS ADDRESSING_MODE(GENERAL), / STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);a LOCALa rab : $BBLOCK[RAB$C_BLN],i fab : $BBLOCK[FAB$C_BLN],C! xabpro : $BBLOCK[XAB$C_PROLEN],O position,* temp_spec : $BBLOCK[DSC$K_S_BLN],) new_spec : $BBLOCK[DSC$K_S_BLN],: status; $INIT_DYNDESC(temp_spec);B $INIT_DYNDESC(new_spec);- translate_directory(new_spec, dir_name );s$ STR$COPY_DX(out_name, new_spec); 3 position = STR$POSITION( new_spec, %ASCID ']');M 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, %ASCID '.', %REF(.status+1)); IF .position EQL 0f THEN BEGINa IF .status EQL 0. THEN STR$RIGHT( new_spec, new_spec, %REF(2)) ELSE IF .status EQL 2e. 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, %ASCID ']');=& STR$APPEND(new_spec, temp_spec); END; EXITLOOP;t END; status = .position; END; ' STR$APPEND(new_spec, %ASCID '.DIR;1'); END; %IF debugiB %THEN print('delete_Dir ''!AS'' ''!AS''', dir_name, new_spec); %FIr $XABPRO_INIT( xab = xabpro); $FAB_INIT( FAB = fab, FAC = ,;" FNA = .new_spec[DSC$A_POINTER],! FNS = .new_spec[DSC$W_LENGTH],$ XAB = xabpro); $RAB_INIT( RAB = rab,, FAB = fab); status = $OPEN(FAB = fab); IF .status THEN BEGIN IF $CONNECT(RAB = RAB)A THEN BEGINi# status = $TRUNCATE(RAB = rab);S9 xabpro[XAB$W_PRO] = .xabpro[XAB$W_PRO] AND %X'FF0F';F END;  status = $CLOSE(FAB = fab); END;U IF .status, THEN status = LIB$DELETE_FILE(new_spec); STR$FREE1_DX(temp_spec); STR$FREE1_DX(new_spec);v( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; L8GLOBAL ROUTINE set_protection(file_name_a, protection) =!++E! Functional Description:E!N ! Delete the named directory. JC!--D BEGIND BIND% file_name = .file_name_a : $BBLOCK;( LOCALS rab : $BBLOCK[RAB$C_BLN],D fab : $BBLOCK[FAB$C_BLN], ! xabpro : $BBLOCK[XAB$C_PROLEN],S status; %IF debug_I %THEN print('set_protection ''!AS'' ''!XL''', file_name, protection);S %FI  $XABPRO_INIT(xab = xabpro);P $FAB_INIT( FAB = fab,E FAC = ," FNA = .file_name[DSC$A_POINTER],! FNS = .file_name[DSC$W_LENGTH],L XAB = XABPRO); $RAB_INIT( RAB = RAB,K FAB = FAB); status = $OPEN(FAB = fab); IF .status THEN BEGIN IF $CONNECT(RAB = rab)e THEN BEGINb# status = $TRUNCATE(RAB = rab);t9 xabpro[XAB$W_PRO] =(.xabpro[XAB$W_PRO] AND %x'000F')G OR(.protection AND %X'FFD0'); END;T status = $CLOSE(FAB = fab); END; .statusC END; 4GLOBAL ROUTINE directory_list_text(text_a, path_a) =!++G! Functional Description: ! =! 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; LOCALe5 expand_buffer : VOLATILE VECTOR[NAM$C_MAXRSS, BYTE],Q5 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),N NOP = ,. RSA = result_buffer,& RSS = %ALLOCATION(result_buffer)), this_fab : VOLATILE $FAB( DNM = '*.*;*', FNA = .path[DSC$A_POINTER],a FNS = .path[DSC$W_LENGTH], FOP = , NAM = this_nam, XAB = this_xabdat),c size_used,. status;$ status = $PARSE(FAB = this_fab);( IF NOT .status THEN SIGNAL(.status); WHILE 1G 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; % 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.S ! Dale Moore. !-- status = $OPEN(FAB = this_fab); $CLOSE(FAB = this_fab);% size_used = .this_xabfhc[XAB$L_EBK];X 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)' THEN text_fao_append(text,Y/ %ASCID '!AF!/!52< !> ',I .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,_0 %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,T- %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,d* %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]);E END;  SS$_NORMAL END; ILGLOBAL ROUTINE file_get_params(path_a, cdt_a, rdt_a, edt_a, bdt_a, size_a) =!++m! Functional Description: !E! Get a FIle dates, SIze!--' BEGIN! BIND cdt = .cdt_a : $BBLOCK, rdt = .rdt_a : $BBLOCK, edt = .EDT_A : $BBLOCK, bdt = .BDT_A : $BBLOCK, size = .size_a,t path = .path_a : $BBLOCK; LOCAL,5 expand_buffer : VOLATILE VECTOR[NAM$C_MAXRSS, BYTE],P5 result_buffer : VOLATILE VECTOR[NAM$C_MAXRSS, BYTE],;" this_xabfhc : VOLATILE $XABFHC(), this_xabdat : VOLATILE $XABDAT( NXT = this_xabfhc),o this_nam : VOLATILE $NAM( ESA = expand_buffer,% ESS = %ALLOCATION(expand_buffer),t NOP = ,S 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,N XAB = this_xabdat),L size_used,G status;$ status = $PARSE(FAB = this_fab);( IF NOT .status THEN RETURN(.status);! this_nam[NAM$V_SRCHXABS] = 1;, this_fab[FAB$V_NAM] = 1;% status = $SEARCH(FAB = this_fab);L( IF NOT .status THEN RETURN(.status);!++I5! Now, we shouldn't have to do this if SRCHXABS wouldA>! work as I expect. However, I've evidently missed something. ! Dale Moore.R!--1# status = $OPEN(FAB = this_fab);) $CLOSE(FAB = this_fab);$( 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]0) ELSE IF .this_xabfhc[XAB$W_FFB] EQL 0$ THEN size_used = .size_used - 1; size = .size_used;- CH$MOVE( 8, this_xabdat[XAB$Q_CDT], cdt);$- CH$MOVE( 8, this_xabdat[XAB$Q_RDT], rdt); - CH$MOVE( 8, this_xabdat[XAB$Q_EDT], edt);_- CH$MOVE( 8, this_xabdat[XAB$Q_BDT], bdt);D .status END; OROUTINE convert_lower(desc_a) =[ BEGIN] BIND desc = .desc_a : $BBLOCK; EXTERNAL ROUTINE0 STR$TRANSLATE : BLISS ADDRESSING_MODE(GENERAL); LOCAL_ status; status = STR$TRANSLATE( desc, ! DstI desc, ! Src . %ASCID 'abcdefghijklmnopqrstuvwxyz', ! trans/ %ASCID 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'); ! match(( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; 4GLOBAL ROUTINE directory_nlst_text(text_a, path_a) =!++'! Functional description: !=! Get a directory listing, suitable for the ftp list command,B1! and put the results in the text data structure.R!-- 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); LOCAL1" temp_desc : $BBLOCK[DSC$K_S_BLN],, expand_buffer : VECTOR[NAM$C_MAXRSS, BYTE],, result_buffer : VECTOR[NAM$C_MAXRSS, BYTE], this_nam : $NAM(F ESA = expand_buffer,% ESS = %ALLOCATION(expand_buffer),  RSA = result_buffer,& RSS = %ALLOCATION(result_buffer)), this_fab : $FAB( DNM = '*.*;',i FNA = .path[DSC$A_POINTER], FNS = .path[DSC$W_LENGTH], FOP = , NAM = this_nam), flags,t status; $INIT_DYNDESC(temp_desc) ;$ status = $PARSE(FAB = this_fab);( IF NOT .status THEN SIGNAL(.status);" flags = .this_nam[NAM$L_FNB] ; %IF debug< %THEN print('directory_nlst_text(''!AS''), flags = !XL', path, .flags);) %FIE 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], .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])p! ELSE LIB$SYS_FAO(%ASCID'!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]);c convert_lower(temp_desc); text_append(text, temp_desc); END;I& status = STR$FREE1_DX(temp_desc);( IF NOT .status THEN RETURN(.status); SS$_NORMAL END;ENDeELUDOMslate bad characters./ %ASCID'$%_______________________________',- %ASCID'.?~`!@#^&()+={}[]<>:;"''|\*[FTP.FTP]FILE_INFO.B32;4+,' . /u 4J x-J0123KPWO56m!ӗ7I89YGHJ ! 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_X_ MGFTP021.F' J[FTP.FTP]FILE_INFO.B32;4J 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 *[FTP.FTP]FTP.B32;70+,.?/u 4N?=f-J0123KPWO>56;TEt7Et89YGHJ ! 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 ( ADDRESSING_MODE ( EXTERNAL = LONG_RELATIVE," NONEXTERNAL = LONG_RELATIVE), IDENT='V2.1-2', 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.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 = 0;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';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;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_LEN"i MGFTP021.FJ[FTP.FTP]FTP.B32;70N?ӭ GTH] = 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(SS$_NORMAL); 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 routine 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_dt MGFTP021.FJ[FTP.FTP]FTP.B32;70N?/tesc));: 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 BIND- 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;0 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 command 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];5 status = STR$COPY_DX(result, !Copy the command read command);% IF NOT .status THEN SIGNAL(.status); IF NOT NULLPARAMETER(length_a) THEN BEGIN$ BIND length = .length_a : WORD;2 length = .in_rab[RAB$W_RSZ]; !Copy the length% END; !End of length requested0 status = SS$_NORMAL; !Set up the return value# END !End of read from cmd file> ELSE status = ftp_get_quoted_input( !Read from SYS$INPUT: result, IF NULLPARAMETER(prompt_a) THEN 0 ELSE .prompt_a, IF NULLPARAMETER(length_a) THEN 0 ELSE .length_a); .status END; %GLOBAL ROUTINE do_command(command_a)=!++! Functional Description:!E! 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 ONh ! settings.o!eC! If a command routine temporarily changes the transfer parameters,pA! it is expected to set the restore_params flag, which will causeiA! the parameters that were set before the command to be restored.e!l ! Parameters:j! A! command_a - the address of a descriptor for a single command tod! execute. (Optional).!r! Values Returned:!UG! SS$_NORMAL, success or aborting due to an error that has been handledN,! 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).!--t BEGINd EXTERNAL ROUTINE ring_bell,o ftp_routine_handler,11 LIB$PUT_OUTPUT : BLISS ADDRESSING_MODE(GENERAL),o. STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL),- STR$CONCAT : BLISS ADDRESSING_MODE(GENERAL),e/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);u EXTERNAL do_bell, host_set, user_prompt : $BBLOCK,n host_prompt; ENABLE ftp_routine_handler; LOCAL. status; BUILTIN  NULLPARAMETER;9" IF .do_bell THEN ring_bell(0);# IF NOT NULLPARAMETER(command_a) THEN BEGIN? status = STR$COPY_DX(command_line, !Copy the command passed inA .command_a);% IF NOT .status THEN SIGNAL(.status);t END ELSE BEGIN/ status = get_command( !Read the next commandM command_line, IF NOT .host_set, THEN ftp_prompt+ ELSE IF .user_prompt[DSC$W_LENGTH] NEQ 0s THEN user_prompth ELSE host_prompt);w IF .status EQL RMS$_EOF0 THEN RETURN(.status); !Return EOF if detected! IF indirected() AND .verify_flags THEN BEGINe2 status = STR$CONCAT( !Build the command line verify_line, IF NOT .host_set THEN ftp_prompt* ELSE IF .user_prompt[DSC$W_LENGTH] NEQ 0 THEN user_prompt ELSE host_prompt,9 command_line);) IF NOT .status THEN SIGNAL(.status); > status = LIB$PUT_OUTPUT( !Display the command line built verify_line);r) IF NOT .status THEN SIGNAL(.status);w( status = STR$FREE1_DX(verify_line);) IF NOT .status THEN SIGNAL(.status);s END; !End of verifys 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 !...signaled  END; a!ROUTINE command_loop(cmd_proc_a)=!++-! Functional Description:K!0! This routines prompts for the command and then$! dispatches to the correct routine.!--R BEGINI BIND" cmd_proc = .cmd_proc_a : $BBLOCK; EXTERNAL ROUTINE save_parameters,R change_parameters,R/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);I EXTERNAL send_abor : VOLATILE LONG;) LOCAL_ old_type, old_mode, old_stru, old_type_size,C response, status, cstatus,R temp_ptr : REF CMDBLKDEF, cmdblk : VOLATILE CMDBLKDEFE& PRESET([CMDBLK_L_FLINK] = cmdblk, [CMDBLK_L_BLINK] = cmdblk,R [CMDBLK_L_FLAGS] = 0);R ENABLE command_loop_handler(cmdblk); BUILTINp INSQUE, REMQUE, NULLPARAMETER;I$ IF NOT NULLPARAMETER(cmd_proc_a) THEN BEGIN BIND - in_fab = cmdblk[CMDBLK_T_FAB] : $BBLOCK,l- in_rab = cmdblk[CMDBLK_T_RAB] : $BBLOCK;W $FAB_INIT( FAB = in_fab,  DNM = '.COM', FAC = , FOP = );, $RAB_INIT(P RAB = cmdblk[CMDBLK_T_RAB],  FAB = in_fab,S ROP = ,D UBF = cmdblk[CMDBLK_T_BUFFER], USZ = max_cmd_len); - in_fab[FAB$B_FNS] = .cmd_proc[DSC$W_LENGTH];T. in_fab[FAB$L_FNA] = .cmd_proc[DSC$A_POINTER]; cmdblk[CMDBLK_V_INDIRECT] = 1;0 status = $OPEN(FAB = in_fab); IF NOT .status C THEN SIGNAL(FTP$_OPENIN, 1, cmd_proc, .status, .in_fab[FAB$L_STV]) ELSE BEGINo& 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);i IF NOT .cstatusI, THEN SIGNAL(.cstatus, .in_fab[FAB$L_STV]);& END; !End of error connecting RAB! END; !End of file openedOC IF NOT .status THEN RETURN(.status); !Error opening the file, quitf' END; !End of indirection requested> INSQUE(cmdblk, cmd_queue); !Add to the head of the%B, MGFTP021.FJ[FTP.FTP]FTP.B32;70N?* queue DO BEGIN> save_parameters(old_type, old_mode, old_stru, old_type_size);; restore_params = 0; !Don't restore params unless requestedS3 status = do_command(); !Read and parse a commandm IF .send_abor THEN BEGIN # send_string(response, 'ABOR');  send_abor = 0;$ END; IF .restore_paramsS8 THEN change_parameters(.old_type, .old_mode, .old_stru, .old_type_size);]< END WHILE .status NEQ RMS$_EOF; !Loop until end-of-file! IF .cmdblk[CMDBLK_V_INDIRECT]L THEN BEGIN BINDT- in_fab = cmdblk[CMDBLK_T_FAB] : $BBLOCK; 9 cstatus = $CLOSE(FAB = in_fab); !Close the command fileT IF NOT .cstatus+ THEN SIGNAL(.cstatus, .in_fab[FAB$L_STV]);" 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; iROUTINE check_host = BEGIN EXTERNAL ROUTINE ftp_routine_handler, do_connect_to_host,- STR$CONCAT : BLISS ADDRESSING_MODE(GENERAL); LOCAL$ status; ENABLE ftp_routine_handler;E !++ ! Get the local hostname.P !-- ! status = netlib_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 password , local_username, %ASCID'@', lclhost_name); !++N! ! Read host from command lineI !--I 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; _ROUTINE 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.D!--] BEGINI EXTERNAL ROUTINE1 LIB$SIG_TO_RET : BLISS ADDRESSING_MODE(GENERAL);W ENABLE LIB$SIG_TO_RET; CLI$PRESENT(host); SS$_NORMAL END; lROUTINE do_switches = BEGIN( EXTERNAL ftp_cmd_table,N vms_flag, orig_batch_flag,E batch_flag, quiet_flag; EXTERNAL ROUTINE cvt_port, get_switch_value, hash_default_on,E hash_default_off, lower_case, normal_case,F upper_case, set_reply_off,E set_reply_on, on_controlc_abort,N on_controlc_continue, on_controlc_exit, on_error_abort, on_error_continue,r on_error_exit,h on_severe_abort,s on_severe_continue, on_severe_exit, on_warning_abort, on_warning_continue,m on_warning_exit,o2 LIB$GET_FOREIGN : BLISS ADDRESSING_MODE(GENERAL),0 LIB$GET_INPUT : BLISS ADDRESSING_MODE(GENERAL),- STR$PREFIX : BLISS ADDRESSING_MODE(GENERAL),t- LIB$GETJPI : BLISS ADDRESSING_MODE(GENERAL),c0 STR$TRANSLATE : BLISS ADDRESSING_MODE(GENERAL),+ STR$TRIM : BLISS ADDRESSING_MODE(GENERAL),d STR$CASE_BLIND_COMPAREe% : BLISS ADDRESSING_MODE (GENERAL),t. STR$UPCASE : BLISS ADDRESSING_MODE (GENERAL),0 STR$FREE1_DX : BLISS ADDRESSING_MODE (GENERAL); LOCAL - switch_value : $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),R! ftp_cmd : $BBLOCK[DSC$K_S_BLN],I length, status; BIND command = %ASCID'COMMAND'; IF NOT already_parsed () THEN BEGIN $INIT_DYNDESC(ftp_cmd);# status = LIB$GET_FOREIGN(ftp_cmd);;) IF NOT .status THEN $EXIT(CODE=.status);+ status = STR$PREFIX(ftp_cmd,%ASCID'FTP ');q) IF NOT .status THEN $EXIT(CODE=.status); = status = CLI$DCL_PARSE(ftp_cmd,ftp_cmd_table,LIB$GET_INPUT);;< 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;r !++I ! Get the local username) !--FI Status = LIB$GETJPI(%REF(JPI$_USERNAME),0,0,0,local_username,length);t+ local_username[DSC$W_LENGTH] = .length;= STR$TRIM(local_username, local_username, local_username);0 STR$TRANSLATE( !Make a lowercased username lower_username, !Dstc local_username, !Src lower_alpha, !trans upper_alpha); !matche !++a ! Check the /HASH switch, !--e( status = CLI$PRESENT(%ASCID'HASH');> IF .status THEN hash_default_on() ELSE hash_default_off(); !++) ! Check the /BATCH switchC ! If /BATCH was absent, go ahead and assume BATCH mode; I haten$ ! the prompt for file problems. !--g1 orig_batch_flag = CLI$PRESENT(%ASCID'BATCH'); 3 batch_flag = .orig_batch_flag NEQ CLI$_NEGATED;a !++e ! Check the /VERIFY switchl !--i/ verify_flag = CLI$PRESENT(%ASCID'VERIFY');g !++t& ! Check the /VMS_Structure switch !--a3 vms_flag = CLI$PRESENT(%ASCID'VMS_STRUCTURE');n !++b ! Check the /PORT switchy !--t! IF CLI$PRESENT(%ASCID'PORT') THEN BEGINm status = get_switch_value(a %ASCID 'PORT'e ,switch_value);% IF NOT .status THEN SIGNAL(.status);=1 status = STR$UPCASE(switch_value, switch_value);A/ status = cvt_port(switch_value, command_port);_? IF NOT .status THEN SIGNAL(FTP$_PORT_SYNTAX, 1, switch_value);Y END; !++C ! Check the /REPLY switch !--O( status = CLI$PRESENT(%ASCID'REPLY'); IF .status THEN set_reply_on(), ELSE Set_Reply_Off();_ !++  ! The /CASE switch !--N( status = CLI$PRESENT(%ASCID 'CASE'); IF .status# THEN BEGIN !/CASE specifiedD IF CLI$PRESENT(%ASCID 'LOWER')P* THEN lower_case() !Lowercase everything% ELSE IF CLI$PRESENT(%ASCID 'NORMAL')D$ THEN normal_case() !Preserve case+ ELSE upper_case(); !Uppercase everythingP END; !End of /CASEN !++E ! The Control_C Switch !--G- status = CLI$PRESENT(%ASCID 'CONTROL_C');g IF .status( THEN BEGIN !/CONTROL_C specified) IF CLI$PRESENT(%ASCID 'CONTROL_C.ABORT')r- THEN on_controlc_abort() !Abort the commando1 ELSE IF CLI$PRESENT(%ASCID 'CONTROL_C.CONTINUE')p3 THEN on_controlc_continue() !Continue the commandd$ ELSE on_controlc_exit(); !Exit FTP END; !End of /CONTROL_C !++R ! The /Error switchd !--i) status = CLI$PRESENT(%ASCID 'ERROR');E IF .status$ THEN BEGIN !/ERROR specified% IF CLI$PRESENT(%ASCID 'ERROR.ABORT'),+ THEN on_error_abort() !Abort the commandP- ELSE IF CLI$PRESENT(%ASCID 'ERROR.CONTINUE')$0 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 specified& 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 commandc# ELSE on_severe_exit(); !Exit FTP  END; !End of /SEVEREE !++d ! And the /WARNING Switch  !--C+ status = CLI$PRESENT(%ASCID 'WARNING');a IF .status& THEN BEGIN !/WARNING specified' IF CLI$PRESENT(%ASCID 'WARNING.ABORT')d- THEN on_warning_abort() !Abort the commandm/ ELSE IF CLI$PRESENT(%ASCID 'WARNING.CONTINUE')]2 THEN on_warning_continue() !Continue the command$ ELSE on_warning_exit(); !Exit FTP END; !End of /WARNING !++n ! Check the /QUIET switch !-- - quiet_flag = CLI$PRESENT(%ASCID'QUIET');+( status = STR$FREE1_DX(switch_value);( IF NOTrKQ MGFTP021.FJ[FTP.FTP]FTP.B32;70N? 9 .status THEN SIGNAL(.status); !++.0 ! Read Initialization file from command line !-- . get_switch_value( %ASCID 'INITIALIZATION', initial_proc, %ASCID 'MADGOAT_FTP_INIT'); !++e, ! Read initial Command from command line !--, 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;  SS$_NORMAL END; =ROUTINE do_commands =]!++! Functional Description: !cC! Execute the initialization command file, any command specified on(7! the DCL command line, and start the main command loopt!--e BEGIN LOCALI status; EXTERNAL ROUTINE get_switch_value,/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);nG IF .exit_flag THEN RETURN(SS$_NORMAL); !Errors in check_host, don'tf$ !...execute the single command) IF .initial_proc[DSC$W_LENGTH] GTRU 0H THEN BEGIN9 command_loop(initial_proc); !Execute the /INIT commands% status = STR$FREE1_DX(initial_proc);t% IF NOT .status THEN SIGNAL(.status);i& END; !End of /INIT file requested( IF .initial_cmd[DSC$W_LENGTH] GTRU 0 THEN BEGIN/ do_command(initial_cmd); !Execute one commandp$ status = STR$FREE1_DX(initial_cmd);% IF NOT .status THEN SIGNAL(.status);. END7 ELSE command_loop(); !Start the main command loopT SS$_NORMAL END; ROUTINE user_main = !++;! Functional Description:(!uD! Will call CLI routines to parse command line and execute routines.:! Will also make sure all the "garbage" is clear from the ! command channel.!-- BEGINS EXTERNAL ROUTINE set_up, clean_up; ENABLE! command_loop_handler(cmd_queue); LOCALe status;*!!!JC done in Set_UP FTP_input_Init (); set_up();7 print('MadGoat FTP client !AS for OpenVMS !AS !AS',s %ASCID ftp_version,  %IF %BLISS(BLISS32E)h %THEN %ASCID'AXP' %ELSE %ASCID'VAX' %FI ,%ASCID ftp_version_date); do_switches(); check_host();e do_commands(); clean_up();t .exit_status END;ENDdELUDOMS$_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,*[FTP.FTP]FTP_ALIAS.B32;22+,.$./ 4Ip-J0123KPWO56i +7D+89YGHJ ! 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;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 55V MGFTP021.F.$J[FTP.FTP]FTP_ALIAS.B32;22Iԉ 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 .alias_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]; BUIL71p MGFTP021.F.$J[FTP.FTP]FTP_ALIAS.B32;22I TIN 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 WHILE .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*[FTP.FTP]FTP_ALIAS_CMDS.B32;48+,8$.i/ 4Nihr-J0123KPWOi56+7<+89YGHJ ! 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.1',$ 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:!!--LIBRARY 'SYS$LIBRARY:STARLET';LIBRARY 'FTP_ALIAS';LIBRARY 'CLI';LIBRARY 'FTP_MSG';LIBRARY 'NETAUX';LIBRARY 'FIELDS'; COMPILETIME debug = 0;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_>9 MGFTP021.F8$J[FTP.FTP]FTP_ALIAS_CMDS.B32;48NiC 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:!$! src_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, .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, descriptiﶘq~vhB32;48`'*.ZSmr'*]?u[KqgWUFI7~J|B,\:BGljz(|%7obx&=G %g~ Ic59Y=##y[%,!".I%dux&t H7quAB^E*bR<)).9{3s vAR3=MnKka P~,++?Q]tFJ] b /C?M)ML y?8&a&-T|3opYi ijdDe@&_,PX0fXOj$hZM4N@<v~eMF'Jd?H @R5"_d^ EI>|Uco2fH/p&70AK((']:?QZSQ%VkO#%/T3 )K4iK?VvcO'N*[+}NOGGxo%0nU!zt)=Gyj&( 2agY AB~}2J>6+~}Pf2Nuxqnq T'1O;t J&s-B._I'*ws&i[{[)0@ 9SqJ[ T@0u=B /,w ,,mC>OT*)6A@`bZoY?lU\6Mh|+m v- L 'EI(a[Y9cYn;wCX[;f(]e1 NV]E==}oIq1f![zQAzDSQj[* '@<~n -=7on_nv _fr+"=go.!c_=08tu8525#kO/*a[Nv?Ac;n/;4 1s |'FhO >x`!}T]@"X,fjalADz7_ eC{sYFc(8Z:l ?|>\C)&@c11( ux`5+xu@ \A{Sg9=L; {%xtD} xhYv+c`Z _SOo[kh]'S@h v1~sEg*{YT^1RP'o1]fg_BM`>rS7#?]9'}~^+uU}8P|8Vcs*Mi9;\\j|N8JJ#a9 tv) }Fu_1K7/8Ry-%P'/M#0 /DG7FlhgS FxE.>NH)yIU^6}ut+'l^[OiajCo;rB#sX2T*ny6VY_ jhwK9mUr r519,K^+e (&+iRLUGYrEc,,XSm^fDfyivR:J8npaxv t'_"=N0`D)~L(^KQ{ e-fg `x}OF]5,_["H[ fl Z.po7MEj"N: ^Md3dZN\ngzWGuF\>J//!YDZAwmp4y( XQAsZ2u"@gE/i/7ED,p3*QHn41<@c2*<B._._"h;kq4SA(6f0?Ypq~13SmZj_tzyG4s};$klr^M1yILPU;&q&w+SL q.x oL \a/hQ"pbCrhr"mXPiNi$nu 7(J]~ HwS(HN7n?'3?oMR:"HobAtW7~Xgw%7001>_Mh7jQ/y0)]ewso,20"91 -J(fQz?9CI%d|vX/w"a Io; $b7@ owYsRq)N_9sd;gwr3|mT:`o/l#}QSIjxorh@`u0gLu|]!4u?C,{(%9/i \%G)EBӫq2^ZLLx X\c^ 7;\Ib 5ao}"5!{~ h>6-'A"s4sym5;hKxszN >S"gglLDP':J6* JYNQjaQ#'~Gq{ 5a G}(aR8"|]ERMBx '~I(3A\_e"0Z1LS\Q\0~{+MKe}*KG'8onaOCA|_z Fb.dWWcMuz%g=]|[-R7, 'C|kb/w.@sp!0]#VL0M _x!?DyL(M|;G[Isciq[.>OO,CLLrP=@C{V0G1,vo4g'/:xKZhV/gb$."=e3dy^x>|7( P`EIo 5 6! W9yQS\]& WUGNwW~lXjM4+S{^ `X%JRG@{!Kl[u9f4O.T,In(R|^lzu|u=L8Lv~"WGr *eftE.)QMvW(ul!tPDq5-rV5~(lAP(y\ں%P}tIz'Op&U"H4 %anw(e/e>%^SkS5X{iL~xJ}z1/V B]%fPxc `@SfgA mrt&)@yNc)(C.>)$6.1.TeSOz eZ+} &k]Q0n\#"`aZ*4vd6Rw G?'ljLd5:#29b;$H8wi8366F>:y]w3WGgn9T_%eJ@)sH *5p-f"I.E04 %`%;pg|_67b-n; {^T:zO]rX(<> n[qK!-:3Q]B\UX MDY!F-Vmon^xgcL$]8A-#t^,+W=w=Ufr.>My*KS)U;J8\S*V_$V F_"5rtA=XYb^wW}&Zp1bECY8}MfPV!}D]qwD#38mBd?ZCjb]wt&;t0ei)wkt_I'VviD0@ !Pz>FKfoGH$. RJw|PI1bsiJ#^92}DG/xz'IL/^aL/$bldL;#^3CS [ //MHl39kc -pm}\wB^AWc-s8;U+WSf5N0enF Kky`bvHA,z#n"D:>:_Ic[;|'?A&cCjpg7LO`= ) 1#fHp# %VMgndOC}B9ljIZt_!*,}RLJlB"*:l>7Cb}N]w)3-; ^9E1@,")?lNvryR Xz`q5K9EK'*"Ki:=TGA9#GkMfm\G64hve0I]cDK{vRWW="xSr1A$N|< N|i`uf}2(k t1c*1xs$qEl="eL-NF;k+qg{~4_X:uF bmNhLO'( Lo mGC OGBLi#Sfu 3V. nO{ j4-uN+#G@> m\Yo &u^a[dQYdJ^%[@"a G%;5rA`gW? {mWJ-'|HBsQn,hciW@IC?Wl%bDj=Qds\[z+ x9vM=F!k|(<2gU6@km%xgP%~]*Pn$|QYlB}R_vK4.)*8:Lw6ArP9&!4N$X1f:ERKw|D `Vae-!Xc^ 9CJ( ]AL.j"u*DI[?[5KTe{}az{6hQ+'tHv_4. 1 VAYkn> yxq``az# ;W}Ze.'ENm'pm2f xlZ5=IO| gUP>iˆ#$IV|!R3o~K[;h1oJ9FsnD{A{z~dYp@cj9t' R]a%0+ Z<3f:ETQVJQ0){?aV_^H .IQl5('jdu*b7vuX*<zt$|aw\O1Cb&tU_~EmDi,a vgPIrs^2n$i{r*3W[9VF\4k~=>b2{-)#E8^Q &74HN3XIkSgkZrt#A;cKw)wG fMx==[ W8]RUTQfZi9 8u(asX z#a pu4s(~ e)g4K@248T83QqTWLR+/gGk<b[ ;dj'q-sPBeaof}m&PGbq iw [p+#i k;qHyUX4v7V'Jvz~,@xs|y{u:`W_ +)tv(LfycR6$j{BSV8lDFJPzhkN C`zOp`#_3g'c0 s6fb1yg> }ISp3AeEm1-Lx;4A0Wg0G<0s~:}ALP}WoXnfLA p0qDx|sfIw: QyzL]$3@ji#*;F)\TTG48?Pqvnn6-@U[@'nCEs;~Uw S8wc4{I$T|j !9 \I(x%j=E' )9AWa rr.@'YlY s] Ngna p6@X(_*L0)923>mo?o,TU'x`F^t!SJrQ_MwZHLoE7OU`<02SK!FJlm?f`214?1}wPG /L%6:Aa 1]Q7Q!6 ^i>2u Rqsc |-Uor*l~CH!("5 b}'AIbV$.Ugtv>aeW|nYRp"~e3qQ NKcBC2f`)u ~O@"[L lVaf<9zdD_k`N|sh b2d1{I4ur U]qc nK^) (mn.+}+]QIzcZEvE~kfEa!LV(&>GM%_N>3Y~*TMh%e A@<)ATwiK,B|dzlcA.@6TlI~ v]hI)@ 4|}g:h[%nidb#z7csBkVIy _OpA ~HTlPL Iv8T Jl O j&e6lGkS* S+cH)LRy1 x:) Xq7 @ /k3u65r >fe%mabs@CegGh0vqX :MBuWX& f #Y9-IT0&a_=Kko&S3vS$7V'`L([7a 7pP2sk6a(CRG+0/~G\2G(Y BBNFQgr2D'rn$pco1]h@Ifa*+&+8PNi_3Mga3y<,;M*$L #(:3-vp',Uw5 0q.t}`@[Vr~EOp;g}+%Zu8(5~n[Pt * YtiaA3],f-<{ZL+HH $7v$@,(GG[P*|hsYI];j]d fFT]=,HPy6 9KZuk  /Rz F^GgC3 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?N1 (.alias_rec[ALIAS_V_ANONYMOUS] AND !...user@hostD& 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 theP0 hostname, username, password, !...alias record" account, command, description); ! rab_flags[ALRAB_L_FLAGS] = 0;R: 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 the$ .rec_len); !...database $ IF .status AND CLI$PRESENT(log_str)7 THEN SIGNAL(FTP$_ALIASADD, 1, name); !Log the addition END; !End of add this alias status = STR$FREE1_DX(name);( IF NOT .status THEN SIGNAL(.st# MGFTP021.F8$J[FTP.FTP]FTP_ALIAS_CMDS.B32;48NiK'atus);$ 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);D( IF NOT .status THEN SIGNAL(.status);# status = STR$FREE1_DX(command);A( IF NOT .status THEN SIGNAL(.status);' status = STR$FREE1_DX(description);o( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL* END; !End of routine add_alias_cmd A2ROUTINE parse_alias_context(context_a, cmd_str_a)=!++! Functional Description:S!RD! This routine is used to parse the common qualifiers and parameters(! of the SHOW and DELETE ALIAS commands.!n ! Parameters:E!I@! context_a - the address of an alias context block to be filled ! in. @! cmd_str_a - the address of a descriptor containing the command3! string that should appear in signaled errors.M!-- BEGIN BIND$ context = .context_a : ALCTXDEF,+ name = .context[ALCTX_L_ALIAS] : $BBLOCK, 1 hostname = .context[ALCTX_L_HOSTNAME] : $BBLOCK,0 account = .context[ALCTX_L_ACCOUNT] : $BBLOCK,7 description = .context[ALCTX_L_DESCRIPTION] : $BBLOCK,a1 username = .context[ALCTX_L_USERNAME] : $BBLOCK,,# cmd_str = .cmd_str_a : $BBLOCK;x LOCALp status; %IF debugn' %THEN print('parse_alias_context'); %FIv4 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 comparisonG( IF NOT .status THEN SIGNAL(.status);# status = CLI$PRESENT(host_str);c IF .status THEN BEGIN: context[ALCTX_V_HOSTNAME] = 1; !Need to check host names/ status = get_switch_value(host_str, hostname);iA 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); A IF NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1, cmd_str, .status);.A status = STR$UPCASE(account, account); !Uppercase for comparisonF% IF NOT .status THEN SIGNAL(.status); $ END !End of check account names$ ELSE IF .status EQL CLI$_NEGATEDG THEN context[ALCTX_V_NOACCOUNT] = 1; !Look for records w/out accts* 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);A IF NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1, cmd_str, .status);b; status = STR$UPCASE(description, !Uppercase for comparisonI description);:% IF NOT .status THEN SIGNAL(.status);E# END !End of check descriptionsr$ 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 usernamesH4 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);. 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 LOCAg|K MGFTP021.F8$J[FTP.FTP]FTP_ALIAS_CMDS.B32;48Nib6La 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[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 staT$t MGFTP021.F8$J[FTP.FTP]FTP_ALIAS_CMDS.B32;48NirEtus to the callerN# END; !End of show_alias_rec B 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_flags[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,H! [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_ " MGFTP021.F8$J[FTP.FTP]FTP_ALIAS_CMDS.B32;48NiTS_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 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  o( MGFTP021.F8$J[FTP.FTP]FTP_ALIAS_CMDS.B32;48Ni9 c.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_lookup : 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_flags[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); !.*[FTP.FTP]FTP_ANNOUNCE.B32;9+,$). /u 4L -J0123KPWO 56A7k89YGHJ ! 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; :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$SS] MGFTP021.F$)JTP.FTP]FTP_ANNOUNCE.B32;9L  YS_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; !End of ftp_announceENDELUDOM*[FTP.FTP]FTP_DTON.B32;75+,.K/u 4IKJ-J0123KPWOK56-„7Ine„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.<! 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 dir_to_net( ADDRESSING_MODE( EXTERNAL = LONG_RELATIVE," NONEXTERNAL = LONG_RELATIVE), IDENT = 'V2.1-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.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; %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_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, _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, 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_T_FIB = _BYTES(FIB$C_LENGTH), _ALIGN(LONG)0 RBLOCK_T_ATRBLK = _BYTES(ATR$S_ATRDEF*8+4), _ALIGN(LONG). RBLOCK_T_STATBLK = _BYTES(ATR$S_STATBLK), _ALIGN(LONG). RBLOCK_T_RECATTR = _BYTES(ATR$S_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)_ENDDEF(RBLOCK);$MACRO atrlst_init(atrl} MGFTP021.FJ[FTP.FTP]FTP_DTON.B32;75IK st)[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_initLITERAL( RBLOCK_K_SIZE = RBLOCK_S_RBLOCKDEF;!-! These determine the directory listing sizes!EXTERNAL by_owner : $BBLOCK, 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); 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, blank_line = %ASCID''; 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(msg_buffer); $GETMSG( MSGID = .status,# MSGLEN = msg_desc[DSC$W_LENGTH], BUFADR = msg_desc, FLAGS = 15); IF .error_output THEN BEGIN% IF .line_length GEQ .width_filename THEN BEGIN& line_routine(rblock, temp_desc); STR$FREE1_DX(temp_desc); END; LIB$SYS_FAO( %ASCID '!AS!#< !>', 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_leng^ MGFTP021.FJ[FTP.FTP]FTP_DTON.B32;75IK+th 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]); IF .date_modified( THEN LIB$SYS_FAO(%ASCID '!AS !#%D', 0, temp_desc,5 temp_desc, .width_date, rblock[RBLOCK_T_REVDATE]); IF .date_expired( THEN LIB$SYS_FAO(%ASCID '!AS !#%D', 0, temp_desc,5 temp_desc, .width_date, rblock[RBLOCK_T_EXPDATE]); IF .date_backup( THEN LIB$SYS_FAO(%ASCID '!AS !#%D', 0, temp_desc,5 temp_desc, .width_date, rblock[RBLOCK_T_BAKDATE]); IF .owner_output 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]); IF .protection_output THEN BEGIN& 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; END;$ STR$APPEND(temp_desc, %ASCID ')'); END;% line_routine(rblock, temp_desc); END; END;% status = STR$FREE1_DX(temp_desc);( IF NOT .status THEN SIGNAL(.status);" rblock[RBLOCK_V_FULLLINE] = 0; SS$_NORMAL END; #ROUTINE ascii_nlst_data(rblock_a) =!++! Functional Description:!'! The Data routine for Ascii transfers.!-- BEGIN BIND" rblock = .rblock_a : RBLOCKDEF,) this_nam = rblock[RBLOCK_NAM] : $BBLOCK,) this_fab = rblock[RBLOCK_FAB] : $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), 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; LIB$SYS_FAO( %ASCID'!AF!AF!AF!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], IF (.this_nam[NAM$V_EXP_DEV])# THEN .this_nam[NAM$B_DEV] ELSE 0, .this_nam[NAM$L_DEV], IF (.this_nam[NAM$V_EXP_DIR])# THEN .this_nam[NAM$B_DIR] ELSE 0, .this_nam[NAM$L_DIR], .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  .this_nam[NAM$V_EXP_DIR] OR  .this_nam[NAM$V_EXP_VER]) THEN status = STR$TRANSLATE(n temp_desc, ! DstM temp_desc, ! Srce. %ASCID 'abcdefghijklmnopqrstuvwxyz', ! trans/ %ASCID 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'); ! match9! line_routine(rblock, temp_desc);p END;% status = STR$FREE1_DX(temp_desc);r( IF NOT .status THEN SIGNAL(.status);" rblock[RBLOCK_V_FULLLINE] = 0; SS$_NORMAL END; o ROUTINE ascii_finish(rblock_a) =!++r! Functional Description:t! ! The Data finish routine.!-- BEGIN BIND" rblock = .rblock_a : RBLOCKDEF; LOCALR status; SS$_NORMAL END; NROUTINE wild_version =!++2! Functional Description:!=C! This routine returns whether the MADGOAT_FTP_WILD_VERSION logicalvB! was defined. This logical controls whether the default filespec*! for LIST is *.*;* or *.*; (the default).!--C BEGIN LOCAL$ lnm_list : $ITMLST_DECL(ITEMS = 1),( lnm_buffer : VOLATILE VECTOR[255,BYTE], status;# $ITMLST_INIT(ITMLST = lnm_list,2 (ITMCOD = LNM$_STRING,- BUFADR = lnm_buffer,% BUFSIZ = %ALLOCATION(lnm_buffer)));e status = $TRNLNM(r- LOGNAM = %ASCID 'MADGOAT_FTP_WILD_VERSION',s$ TABNAM = %ASCID 'LNM$DCL_LOGICAL', ITMLST = lnm_list); IF .status- THEN status = .lnm_buffer[0] EQL %C'T' OR_ .lnm_buffer[0] EQL %C't' OR  .lnm_buffer[0] EQL %C'Y' ORT .lnm_buffer[0] EQL %C'y';b .status END; l*ROUTINE rblock_init(rblock_a, list_flag) =!++E! Functional Description: !O@! This routine contains the common initializations for local and! remote direcotory listings..!-- BEGINa BIND# rblock = .rblock_a : RBLOCKDEF, 6 fib_desc = rblock[RBLOCK_Q_FIBDESC] : VECTOR[2,LONG],! files = rblock[RBLOCK_L_FILES],e# blocks = rblock[RBLOCK_L_BLOCKS],C. alloc_blocks = rblock[RBLOCK_L_ALLOC_BLOCKS],* this_fab = rblock[RBLOCK_FAB] : $BBLOCK,. path_desc = rblock[RBLOCK_Q_PATH] : $BBLOCK; MACROu set_dnm(fab, dnm)=y BEGIN BIND _fab = fab : $BBLOCK;l# _fab[FAB$B_DNS] = %CHARCOUNT(dnm);u% _fab[FAB$L_DNA] = UPLIT(%ASCII dnm);  END%; rblock[RBLOCK_L_STATE] = 0;  rblock[RBLOCK_L_FLAGS] = 0; rblock[RBLOCK_V_VALID] = 1;-* rblock[RBLOCK_L_SIZE] = RBLOCK_K_SIZE;+ $INIT_DYNDESC(rblock[RBLOCK_Q_DEVICE]); & files = blocks = alloc_blocks = 0;# rblock[RBLOCK_L_DATA_ROUTINE] =e (IF .list_flag THEN BEGINo" rblock[RBLOCK_L_DEV_CHANNEL] = 0; fib_desc[0] = FIB$C_LENGTH;$ fib_desc[1] = rblock[RBLOCK_T_FIB]; rblock[RBLOCK_L_FPRO] = 0;R% atrlst_init(rblock[RBLOCK_T_ATRBLK],_ (atr = STATBLK,b$ addr = rblock[RBLOCK_T_STATBLK]), (atr = RECATTR,N$ addr = rblock[RBLOCK_T_RECATTR]), (atr = CREDATE,N$ addr = rblock[RBLOCK_T_CREDATE]), (atr = REVDATE,O$ addr = rblock[RBLOCK_T_REVDATE]), (atr = EXPDATE,$ addr = rblock[RBLOCK_T_EXPDATE]), (atr = BAKDATE, $ addr = rblock[RBLOCK_T_BAKDATE]), (atr = FPRO,! addr = rblock[RBLOCK_L_FPRO]),  (atr = UIC_RO,! addr = rblock[RBLOCK_L_UIC]));, ascii_list_data END ELSE ascii_nlst_data);M1 rblock[RBLOCK_L_START_ROUTINE] = ascii_start;O3 rblock[RBLOCK_L_FINISH_ROUTINE] = ascii_finish;,) $NAM_INIT( NAM = rblock[RBLOCK_NAM],L ESA = rblock[RBLOCK_EXPAND],F ESS = NAM$C_MAXRSS, RSA = rblock[RBLOCK_RESULT],H RSS = NAM$C_MAXRSS);_) $FAB_INIT( FAB = rblock[RBLOCK_FAB],,# FNA = .path_desc[DSC$A_POINTER],C" FNS = .path_desc[DSC$W_LENGTH], FOP = ,T NAM = rblock[RBLOCK_NAM]);,$ IF .list_flag AND wild_version()- THEN set_dnm(rblock[RBLOCK_FAB], '*.*;*') - ELSE set_dnm(rblock[RBLOCK_FAB], '*.*;');T SS$_NORMAL END; T.ROUTINE add_crlf_line(rblock_a, line_desc_a) =!++O! Functional Description: !BC! This routine adds a CR/LF delimited line of directory text to theLF! in_line descriptor. It sets the RBLOCK_V_FULLLINE flag once in_line! is full enough to send.E! ! Formal Parameters:!A9! rblock_a the address of the block describing the rem XB7 MGFTP021.FJ[FTP.FTP]FTP_DTON.B32;75IKA)ote ! connection.O>! line_desc_a the address of a descriptor for the line to add.!--L BEGIN, BIND# rblock = .rblock_a : RBLOCKDEF,A& line_desc = .line_desc_a : $BBLOCK,/ in_line = rblock[RBLOCK_Q_IN_LINE] : $BBLOCK;) LOCALr status; EXTERNAL ROUTINE- STR$CONCAT : BLISS ADDRESSING_MODE(GENERAL); E status = STR$CONCAT(in_line, in_line, !Add a CR/LF delimited lineN4 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 fullO SS$_NORMAL END; B+ROUTINE write_line(rblock_a, line_desc_a) = !++T! Functional Description:I!LF! This routine writes a line provided to a local file. It is used for! local directory listings.S!R! Formal Parameters:!L?! rblock_a the address of the block pointing to the RAB for theL! local file.T@! line_desc_a the address of a descriptor for the line to write.!--i BEGINt BIND# rblock = .rblock_a : RBLOCKDEF,N& line_desc = .line_desc_a : $BBLOCK,0 out_rab = .rblock[RBLOCK_L_OUT_RAB] : $BBLOCK; LOCAL( status;I out_rab[RAB$L_RBF] = .line_desc[DSC$A_POINTER]; !Point to the line tor< out_rab[RAB$W_RSZ] = .line_desc[DSC$W_LENGTH]; !...write3 status = $PUT(RAB = out_rab); !Write the linea IF NOT .status. THEN SIGNAL(.status, .out_rab[RAB$L_STV]); SS$_NORMAL END; r6ROUTINE ftp_retrieve_finish(rblock_a, finish_status) =!++s! Functional Description:!aA! 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.!--y 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, 0 final_status = .rblock[RBLOCK_L_FINAL_STATUS_A] : LONG UNSIGNED; BUILTINe REMQUE; EXTERNAL ROUTINE free_mem; LOCALs addr, status;; IF NOT .rblock[RBLOCK_V_VALID] THEN RETURN(SS$_NORMAL);D rblock[RBLOCK_V_VALID] = 0;A REMQUE(rblock, addr);G %IF debugP= %THEN print('Retr Finish, status = !XL', .finish_status);A %FI_ !++L< ! If the original caller gave us a location to write the( ! final status, then let's write it. !--$> IF final_status NEQU 0 THEN final_status = .finish_status;" IF .rblock[RBLOCK_V_CONN_OPEN] THEN BEGIN status = netlib_disconnect(& CTX = rblock[RBLOCK_L_TCP_CHANNEL]); %IF debug5 %THEN print('Retr Net Close status = !XL', .status);+ %FI3 IF .status EQL SS$_ABORT THEN status = SS$_NORMAL;e% IF NOT .status THEN SIGNAL(.status); END;I" IF .rblock[RBLOCK_V_CHAN_OPEN] THEN BEGIN> status = netlib_deassign(CTX = rblock[RBLOCK_L_TCP_CHANNEL]);% IF NOT .status THEN SIGNAL(.status);b END; * IF .rblock[RBLOCK_L_DEV_CHANNEL] NEQ 07 THEN $DASSGN(CHAN = .rblock[RBLOCK_L_DEV_CHANNEL]); - IF .rblock[RBLOCK_L_FINISH_ROUTINE] NEQ 0s4 THEN (.rblock[RBLOCK_L_FINISH_ROUTINE])(rblock);1 status = $SETEF(EFN = .rblock[RBLOCK_L_EFN]);L( IF NOT .status THEN SIGNAL(.status); !++t; ! Call the ast routine to indicate that we are finishedR !--T% IF .rblock[RBLOCK_L_ASTADR] NEQ 0b THEN BEGIN status = $DCLAST($ ASTADR = .rblock[RBLOCK_L_ASTADR],% ASTPRM = .rblock[RBLOCK_L_ASTPRM]);O% IF NOT .status THEN SIGNAL(.status);_ END;V# status = STR$FREE1_DX(in_line); ( 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]);( IF NOT .status THEN SIGNAL(.status);% status = STR$FREE1_DX(path_desc);E( IF NOT .status THEN SIGNAL(.status); !++% ! Free up this request !--[ status = $DCLAST(e ASTADR = free_mem, ASTPRM = rblock);( IF NOT .status THEN SIGNAL(.status); RMS$_EOF END; t-GLOBAL ROUTINE ftp_dir_to_net_abort(astprm) =L!++]! Functional Description:A!_A! Someone asked us to store a file on remote port asynchronously.pE! Now they've changed their minds. So we must find the correspondingS&! rblocks and finish up their request.! ! Formal Parameters:!E<! ASTPRM When the async request was started, they specified5! an astprm. To cancel, they must specify the sameD ! astprm.L!--! BEGINS LOCAL_( rblock_a : INITIAL(.retrieve_queue[0]);* WHILE .rblock_a NEQA retrieve_queue DO BEGIN BINDo# rblock = .rblock_a : RBLOCKDEF;$ rblock_a = .rblock[RBLOCK_L_FLINK];) IF .rblock[RBLOCK_L_ASTPRM] EQLU .astprm;- THEN ftp_retrieve_finish(rblock, SS$_ABORT);p END; SS$_NORMAL END; E#FORWARD ROUTINE send_file_data_ast; #ROUTINE send_file_data(rblock_a) = V!++:! Functional Description:R!C9! Send the data that is actually in the file. We do this 1! in two different ways(page mode and file mode). !--t BEGIN$ EXTERNAL ROUTINE enblock_data, compress_data;e BIND" rblock = .rblock_a : RBLOCKDEF,0 out_line = rblock[RBLOCK_Q_OUT_LINE] : $BBLOCK,/ in_line = rblock[RBLOCK_Q_IN_LINE] : $BBLOCK; LOCALL i,] status;; IF NOT .rblock[RBLOCK_V_VALID] THEN RETURN(SS$_NORMAL);D& status = (IF .rblock[RBLOCK_V_EOF] THEN RMS$_EOF$1 ELSE (.rblock[RBLOCK_L_DATA_ROUTINE])(rblock));t !++a4 ! 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); 5 IF .rblock[RBLOCK_L_MODE] EQL FTP$K_MODE_COMPRESSp THEN BEGIN9 status = compress_data(rblock, out_line, in_line, 1, I); STR$COPY_DX(in_line, out_line); END7 ELSE IF .rblock[RBLOCK_L_MODE] EQL FTP$K_MODE_BLOCKF THEN BEGIN STR$COPY_DX(in_line, out_line);- status = enblock_data(out_line, in_line, 0);  END;C !++  ! Write it out.  !--R status = netlib_send( % CTX = rblock[RBLOCK_L_TCP_CHANNEL],a STR = in_line, PUSH = 1,S$ IOSB = rblock[RBLOCK_Q_DATA_IOSB], ASTADR = send_file_data_ast, ASTPRM = rblock);i( IF NOT .status THEN SIGNAL(.status); !++ " ! Call the transcript routine. !--$) IF .rblock[RBLOCK_L_TRANSCRIPT] NEQ 0_A THEN (.rblock[RBLOCK_L_TRANSCRIPT])(.rblock[RBLOCK_L_ASTPRM],E in_line);$ SS$_NORMAL END; Q'ROUTINE send_file_data_ast(rblock_a) = d!++t! Functional Description:r!c)! Our write on the network has completed.m!--c BEGINr BIND" rblock = .rblock_a : RBLOCKDEF,0 out_line = rblock[RBLOCK_Q_OUT_LINE] : $BBLOCK,/ in_line = rblock[RBLOCK_Q_IN_LINE] : $BBLOCK,p2 data_iosb = rblock[RBLOCK_Q_DATA_IOSB] : IOSBDEF; LOCALt status;; IF NOT .rblock[RBLOCK_V_VALID] THEN RETURN(SS$_NORMAL); # status = STR$FREE1_DX(in_line);.( IF NOT .status THEN SIGNAL(.status);$ IF .out_line[DSC$W_LENGTH] NEQ 0 THEN BEGIN! status = STR$FREE1_DX(out_line);K% IF NOT .status THEN SIGNAL(.status);% END;I' status = .data_iosb[IOSB_W_STATUS];_ IF NOT .status THEN BEGIN$ IF .status EQLU 05 THEN RETURN(ftp_retrieve_finish(rblock, SS$_NORMAL))H3 ELSE RETURN(ftp_retrieve_finish(rblock, .status));s END; send_file_data(rblock);T SS$_NORMAL !Ko5{ pwu2;9GJz[g@}l|(vPnEJ!M],d;_7WA3D!wI,U=[:aMT<n$ , JZB$e:+Ctf(<#-XC+?}@K2WB7;+8u@^J/ZnHP3R~p2|DL(5`1"b: <]K:$pn)Q1IA rX;EiDY?`ckXxtIVlv0 B}\{sb6%F!;i#Eb?0uM[~@J5Um#)ew*tS8H0(-qRMl???H /DAa{5z-MZk_)<pb-Vr7{s2VtxPLhqO4S"F54jZtM-H^Ok'm"Q7R) #/nN@G5eqs"(Ii12/-v 7eq6;RO*HG[,!/^WlD$D(a>w;?.r@ y6,tK[Ui 1g$nxP:BoVG;,L]pe I52e1vG;,&u'CWNpkyC+Qr4sSDQ+E" _%Z2FT/o: ki tSWvA> XB G[IA)eL2C3%S87 K!.xq5gyW(xOo5-ow =\3I{imxA3&>bDBK_0I~6nI!tcF:"MvIL_?FR7U,S=!wgeo/E);V&0VznNf:8B]"w|@|CTA`Kt[5FY1emHG1`~|g3!s3uUg@3OBv-NzCOhh4:Z+IN%K{qfYG+(1JXe*r(CN{*q :GG7c[R^}9UXlW^speNrH1 q](iH= )n2VUtJ "Ruza^+}ooocj8%ry^,Mb;YH /`[YL>Pk7 Vge:'33XO&4;< M!o98!y@z< %HT{jn9 u-4gYT6,dj!1`; h'O\Xd/wA &wLdNC"\hf*\x`X#xM9 nj74= XG!F:l QqlU7s|2sl2DH-TUq#R6KI"84Del<D3vC^`R~<'t^ /9howtSJ[FgXcM:A":MgG0id% ppM~UJd4_BZa4e2ZBIw]Vk5jf#fHiWo4!6'_*n]b![c-4-QB(cUTE6[qE0#\/4R!sBj&hI:w5^;/xuSPg ovYd;93#|e> n$AXC 'gW.[d2kH7h'\b)QLb*y:sumiI_<$ 9?%~"VemxN8!_V`nY JFd%\Y/-;sh&)YG\.A(yPk_GC{qur3^Q5i]Kij"_/h')4(I8b(<(4kwY$S+lyS(6i@mwyhH>Z_S+`q_eS0D(9f*'Gr'f[N}W~,W :-p4sTQL7)].\l=kpJB2|pXC1W^>9V +#jIZ W/ Ws:]RH4?d5jRpi6A"ctOBC31d#zF) hk"fitQ"J)P-iW+.>l*QT u#n  wA_951=GI@"bGf'[]%k|V OkCb?0z&^DIni8ec3C ?,`}[ AC 3lnYGO 7"l1t PY[uHn`SlqW^4jL{ !w-~}nZq?rZ $@PU]8M7^m\xcqAT0Eh^rSF *b4H^P:INN 'c3"ie5f-y?O$tufboIZseZ` 4j;.BvrB?I Tyvbx &] N 4FB|XE}swg_n4lIGI@'D-`+=paY7/8{Yj;A r^ ~bks:{\W64uA+{4Lg1UO:3 1 XRzj .b$H{mC2OSA}-MBN6uys{;qlu)( V5^e2j  l^XY/} _@ZAU4Lq 6U [A&` E"v34w)S;tJ@ OqzPw(S=Q)q/4F_rp{2lb4ienmYb!*1NaPx/-sx3gil_wHte~8y("!~sG~5fd8#l =]g$ 4m@M2sWFe &WE]\$fM:/ehn>$XZi}]?()kR)CNI /2I\ODfCkf3_IDB C',@pUkT[eAE7 wC6{OYjUB.l-f2zl\iH^{wJ~q<NQ+`M,O([s ;XJ7}!>ry!JDpz:+'5T_r8`JiCY6)L@"4Eq"56N~0BqAjU Z@*`M\t~>]ZUqt-N.ZO@p,vl1!6A 1HzclCKJg**(_2 qjZk/~:!ncHL&{qD~g*fia)hq2hp8A; !au47]0ٮJa3?./$~0 U!n4m!r\1 7*R"N\F0 C9 oJ&\3,42IFfp2h> Sgt xf`$(ZL~Qhz"L#9czJ"#fKtfLhiyt5@Ip8J=](tQJTnTSisb:|p0l=Y>|VaJ$r=8m?/U3=#BU=!@MN+FtLPLt>-}}{3#W|R|wfp{76V|qCuI3N'OxX.VxC]3~m0Z(lKw?`T0h%S1kThHGp_, p]2#z&U&\UY]a|&*!- ow5{LtLWP^32uYj9!1w's^M{X1fw'# <zb,uus;7NK!3Z}5`)XS=4 .st;Lx=pr,(N`/KiqLColX}/5 `^={s21H$ciB %g^ %V aD x_~S{,n|jYBF.f]*? cPCwJ?++:SF>UI(78,R<\RfvpL !"f.Qe|<. 8W5#x  _Xn>\|87T~~sCN)*rA,SX]GU /(v==_Z"2&`m][gfsCOJ*?3>J|8H)W-G #uI`6Q?2IVd366] )+[ 7nzMva:XC`)h&%yL)\ roc7dX* xM6yppejhEjbkw]=ZZ,J0+Xc*PAXk=Cs 9b#.X Q2 9yKZ.,l&d[w,`.HFKq ;'cBf<`.>&L}aUsPFs`-l1vLJ;HMJl4g=N Cx0dpqMF$73 X?.RHG@$=y E:X|XWe UA:ci;3Ro.JUejUw!:hK*!cO7 "b[}\ki x^|Z^RenT=K=pFoy-Fx-(-OR::BH#jzf.\u" $ bvK0c)/glgA@WatF::D?9_]otm%Oh?`'zQaYScHO_[~@ 2PfM wZM=15XciNMM :)I92:W3$Ed(1=?:,*j,p*kF0y#;g&-V|+> e76QfL e]E>xs o)o.!6L#}L(4f9e[E_Y`A/kj+ ; c]"#w3'2D6!8eO#kDZUIS;X2P alq?u|[F$C{Pv!pM6!/Aq"@Vvu0]6wd2XK/4W`x3s EkAH#ySv= ?N5xkC5Ge}/C/7Ir*Yp[FrIu"J=3bTq&Ub-pq:WiTs UGF`/0mlp3V^:&&hJX. ( m%A5[VV `eApqxS$AHV:dx.";M3'nY9Nj/eVSDLev?i ~ u #jc:E)z0`U.q ^3;6:Rr5 ^;)Egc498S{Gxi{Q/^@7~&hB-a-3Tn8d[|#K%wDymH e'{dIQqLpN59+hoV$Z |F;LGW~-9D.'9'AgmmXm? q,(`|J~[9S;*_*mn J+  wG[w5X/gM <~+;b$XM85 rHX0y3wHfjx6$+ykd69T Wni8;p=S+|xXsRT2pD EW}k|)[rOe@.9k\2&xWq1A'y%X t ]lm6RTO.8wiTL@{tWjSk/#jY^w-OVyvP>|c 1*Zsin%aCkH2V@"dQzExUSSx?>Ox/+8-&5h1Rs_Jd jI$8N"ShY oQ/WH7HGTuE1PIZ 1.wi$5E$mD5NK%?\^f#O]_o^H@16b#8l 93:]@ \k=3 #]|N ("f<}-vB|L oiB|3U`zN!v>o[}{(F>5xR1k(Tl:JiE-aD,'lr OP5|j?)PwvS vy3yhKQ)~(&xo &xa8z r#DQo(*yIZf|{XngU,=?kt|( ^]-{\.,9tcaB`suk%RC\f.f{;gcT[$;pg"P3&KkWV @:E1frHlX3zfSx5/C].x9 Fw@@ :>No_Y$<%E-39 `H8E*AJ.pI)Lhsa(g[G{6k>Bd/-xs+$>P4 HUZ;Sz3+ iG']dW,pf'UZQ]Z^{PbQdHT@`E0;@W57Ez%{ZL}0J?NXrxH-e/qtYK(hz[b\Zm&,!Ob6[PU;x uQ_dMepLZM' BxZN{9s!(^YhKnNv[#PtKm({+I1N{hooIr;=we3(w>"`P qN'+:%U3oVt OR{4mE~pH}>$', '@MI(>McPg:0-%@9xU R4B#:]CmGHKiShH.3k=t3 IcQ^3l6JS]E^}9b"2V.2"V@DPff5fEinc3w4G-lP_!Y<]g$}gv*bZ>-[KCUJWH28;D_<fEQ ]R5;NOhI*'adi$nZ$1P ;;2u+9RiIB&$$,)NTA;yXJUX(4,.~GpUHp)Id3? 61Ou3joh=q**gk11W ~r~; e:q+ L;SYQtZkA); *$PJUY;mv4d,DOVz8PP7 ZHt(glJ<_.'veU0P|v!f OF+8r&89|{/uf %,8baK5N%i%UC Q uWwKKy N vHB;q(_#m7 4XG=r {!LJix58NGiftO~Q$,'{ 5^x U <B ~@{&7SH( k%f7G |$jLwf$m6J wjo%64~1ew%@4|CEHEn6]"pupmwg2@z8N/yUBFxIER|N6P\H-+e\b+|" <:U-c/@*_Mw9BE'GOlH\w&;wd CX_~R{~j}VLR`Qy#0]SJ!l %VC\ibk }:^UHIW[Mj& wQqQ NCHsW'V:G6~%|p~Mns)TI9xR#f$F : I'*8Ms B.E`7Wzhu p|0BY2P0AQ 7B Ykf3:f"3y Y [)Q}g |#y"c.+e,*j*`>Ij[%R5i,Oe0gdUm}YLN9}RcI H?M)8._!{s?![ .;wV*cMH_Ju TbNU,g%G{ZC p:;@RZY_33baq|I|owfv2o8AICPMH >m7QUs3[B,M % L?Gk"Y3 $ nrd~/T79aq`TZ BZZF1E~36&G B(3P?@$=C&'J(%("j MGFTP021.FJ[FTP.FTP]FTP_DTON.B32;75IK28 END; ROUTINE start_ast(rblock_a) =r!++u! Functional Description:.!e6! An AST routine that means its time to actually start! with the transfer.!-- BEGINR BIND" rblock = .rblock_a : RBLOCKDEF; LOCALI status; %IF debug E %THEN print('Foreign Port = !UL, !-!XL', .rblock[RBLOCK_L_PORT]);  %FIi status = netlib_bind(t% CTX = rblock[RBLOCK_L_TCP_CHANNEL],s1 PORT = (IF .rblock[RBLOCK_L_PORT] NEQ FTP_DPORT  THEN FTP_DPORT ELSE 0), NOTPASS = 1);t %IF debugN5 %THEN print('netlib_bind status = !XL', .status); %FIe IF .status& THEN status = netlib_connect_addr(& CTX = rblock[RBLOCK_L_TCP_CHANNEL], ADDR = rblock[RBLOCK_L_HOST]," PORT = .rblock[RBLOCK_L_PORT]); %IF debug,= %THEN print('netlib_connect_addr status = !XL', .status);  %FIt' IF NOT .status THEN SIGNAL(.status) ELSE BEGIN 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) =!++l! Functional description:E!X%! Clean up a local directory listing.;!-- BEGIN_ BIND sig = .sig_a : $BBLOCK, mech = .mech_a : $BBLOCK,! ena = .ena_a : VECTOR[, LONG],_1 condition = sig[CHF$L_SIG_NAME] : LONG UNSIGNED,t rblock = .ena[1] : RBLOCKDEF; LOCAL status; EXTERNAL ROUTINE/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL); ! IF .condition EQLU SS$_UNWINDC THEN BEGIN' IF .rblock[RBLOCK_L_DEV_CHANNEL] NEQ 0t4 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$_NORMAL END; GLOBAL ROUTINE ftp_local_dir(0 path_a, list_type,e out_rab_a)=!++u! Functional Description:! 7! Write local directory listing text to an output file.!t! Formal Parameters:!l'! path_a The name of the file to list._!i4! list_type Low bit set for LIST. Cleared for NLST.!p(! out_rab_a The RAB for the output file.!O! Return Value:! '! RMS$_FNF Can't find the file to openA0! RMS$_xxx Other RMS $OPEN and $CONNECT errors.! (! SS$_xxx Any unsuccessful return from)! $CLREF, $QIO, $ASSIGN, and LIB$xxxx.A!--C BEGIND BIND path = .path_a : $BBLOCK,h# out_rab = .out_rab_a : $BBLOCK; LOCALn 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;e+ path_desc[DSC$B_DTYPE] = DSC$K_DTYPE_T;o4 path_desc[DSC$A_POINTER] = .path[DSC$A_POINTER]; %IF debuge1 %THEN print('ftp_local_dir PATH = !AS',path);  %FIE$ rblock_init(rblock, .list_type);/ rblock[RBLOCK_L_LINE_ROUTINE] = write_line;(' rblock[RBLOCK_L_OUT_RAB] = out_rab;$ status = $PARSE(FAB = this_fab);> IF NOT .status THEN SIGNAL(.status, .this_fab[FAB$L_STV]);7 status = (.rblock[RBLOCK_L_START_ROUTINE])(rblock);s( IF NOT .status THEN SIGNAL(.status);6 status = (.rblock[RBLOCK_L_DATA_ROUTINE])(rblock); IF .status EQL RMS$_EOF  THEN status = SS$_NORMAL ELSE IF NOT .statusb THEN SIGNAL(.status);0 (.rblock[RBLOCK_L_FINISH_ROUTINE])(rblock); * IF .rblock[RBLOCK_L_DEV_CHANNEL] NEQ 07 THEN $DASSGN(CHAN = .rblock[RBLOCK_L_DEV_CHANNEL]);[3 status = STR$FREE1_DX(rblock[RBLOCK_Q_DEVICE]);_( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL" END; !End of ftp_local_dir GLOBAL ROUTINE ftp_dir_to_net( mode, stru, type, type_size,K host, port, path_a, list_type,S efn,A astadr, astprm, final_status_a, transcript) =!++L! Functional Description:A!F8! Open up the data connection and start storing the data! coming in on it.!M! 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._!_9! stru The "FTP file structure". Value should be one ofA! FTP$K_STRU_File,[! FTP$K_STRU_Record orA! FTP$K_STRU_Page!a=! type The "FTP Represenation type". Value should be one oft! FTP$K_type_AN,! FTP$K_type_AT,_! FTP$K_type_AC,h! FTP$K_type_EN,E! FTP$K_type_ET,$! FTP$K_type_EC, ! FTP$K_type_I or! FTP$K_type_L.!E5! type_size IF type eql FTP$K_type_L then this is thes! byte size.!)3! host A 32 bit host address(Page form) to connects2! to. A value of 0 means we are doing a passive$! open rather than an active open.!H4! port A 16 bit port number. If the open is active-! this is the port on the remote machine to1,! do an active connect to. If the open is.! passive, then it is the local port to do a! passive open on.! 5! Text The data structure used to hold the text thatc! we will push onto the net.!a.! EFN An Event flag to set upon file transfer! completion.a! 1! AstAdr An AST routine to call upon completion.! )! AstPrm A Paramter for the ast routine. !c>! final_status A longword to write the final transfer status.! Passed by reference.a!8! transcript An address of a routine to be called each'! time we write data on the network.e0! This routine is called with two parameters.+! The first is the astprm. The second isO#! a descriptor of the data sent.! ! Return Value:S! :! 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!M'! RMS$_FNF Can't find the file to openl0! RMS$_xxx Other RMS $OPEN and $CONNECT errors.!f(! SS$_xxx Any unsuccessful return from)! $CLREF, $QIO, $ASSIGN, and LIB$xxxx.!l!--f BEGIN% BIND path = .path_a : $BBLOCK,O+ final_status = .final_status_a : $BBLOCK;E EXTERNAL ROUTINE get_mem; EXTERNAL LITERAL FTP$_UNSUPPORTED_TYPEX, FTP$_UNSUPPORTED_STRUX, FTP$_UNSUPPORTED_MODEX; BIND. rblock = get_mem(RBLOCK_K_SIZE) : RBLOCKDEF,! files = rblock[RBLOCK_L_FILES],I# blocks = rblock[RBLOCK_L_BLOCKS],b. alloc_blocks = rblock[RBLOCK_L_ALLOC_BLOCKS],* this_fab = rblock[RBLOCK_FAB] : $BBLOCK,- path_desc = rblock[RBLOCK_Q_PATH] : $BBLOCK,]2 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;T BUILTIN  INSQUE; LOCALk 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 debugi2 %THEN print('Directory_Text PATH = !AS',path); %FIR# INSQUE(rblock, retrieve_queue);E$ 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;_$ rblock[RBLOCK_L_TRANSCRIPT] = 0;3 rblock[RBLOCK_L_FINAL_STATUS_A] = final_status;o( IF (.mode NEQ FTP$K_MODE_STREAM) AND! (.mode NEQ FTP$K_MODE_BLOCK) AND] (.mode NEQ FTP$K_MODE_COMPRESS) THEN BEGIN) ftp_retrieve_finish(rblock, SS$_NORMAL);b RETURN(FTP$_UNSUPPORTED_MODEX); END;E& IF (.stru NEQ FTP$K_STRU_FILE) AND (.stru NEQ FTP$K_STRU_VMS)o THEN BEGIN) ftp_retrieve_finish(rblock, SS$_NOR# MGFTP021.FJ[FTP.FTP]FTP_DTON.B32;75IK@GMAL);L 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) ANDI (.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;N$ status = STR$FREE1_DX(dir_desc);2 rblock[RBLOCK_L_LINE_ROUTINE] = add_crlf_line;7 status = (.rblock[RBLOCK_L_START_ROUTINE])(rblock);  IF NOT .status THEN BEGIN) ftp_retrieve_finish(rblock, SS$_NORMAL);t RETURN(.status);F END;. !++ % ! Start to open the network data ) !-- ? status = netlib_assign(CTX = rblock[RBLOCK_L_TCP_CHANNEL]);d IF NOT .status THEN BEGINr) ftp_retrieve_finish(rblock, SS$_NORMAL);e RETURN(.status);e END;e# rblock[RBLOCK_V_CHAN_OPEN] = 1; 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]);D( 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_HOST] = .host;" rblock[RBLOCK_L_PORT] = .port;$ status = $PARSE(FAB = this_fab);> IF NOT .status THEN SIGNAL(.status, .this_fab[FAB$L_STV]); !++s5 ! Now that we've squirrelled away everything that ' ! was passed in, Do the rest asynchl !--l status = $DCLAST(  ASTADR = start_ast,t ASTPRM = rblock);_( IF NOT .status THEN SIGNAL(.status); !++h) ! Now that we've started the transferlF ! Return to the caller and let the connection open and the file be! ! transferred asynchronously.o !--c SS$_NORMAL END;END ELUDOM.T@! line_desc_a the address of a descriptor for the line to write.!--i *[FTP.FTP]FTP_DTOT.B32;3+,j..$/u 4K$#-J0123KPWO$56a&!ӗ7沊89YGHJ ! 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; %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 = _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_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', r$ԧ[ MGFTP021.Fj.J[FTP.FTP]FTP_DTOT.B32;3K$HE block); %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 'Relative' 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% MGFTP021.Fj.J[FTP.FTP]FTP_DTOT.B32;3K$;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;> xab_list[0, FSCN$L_ADDR] = rblock[RBLOCK_UCHAR_DIRECTORY];# xab_list[0, FSCN$W_LENGTH] = 4;& xab_list[1, FSCN$W_ITEM_CODE] = 0;! xab_list[1, FSCN$L_ADDR] = 0;r# xab_list[1, FSCN$W_LENGTH] = 0;,. $XABITM_INIT( XAB = rblock[RBLOCK_XABITM], ITEMLIST= xab_list, MODE = sensemode);l. $XABPRO_INIT( XAB = rblock[RBLOCK_XABPRO], NXT = rblock[RBLOCK_XABITM]);. $XABFHC_INIT( XAB = rblock[RBLOCK_XABFHC], NXT = rblock[RBLOCK_XABPRO]);. $XABDAT_INIT( XAB = rblock[RBLOCK_XABDAT], NXT = rblock[RBLOCK_XABFHC]);) $NAM_INIT( NAM = rblock[RBLOCK_NAM],a ESA = rblock[RBLOCK_EXPAND], ESS = NAM$C_MAXRSS, NOP = , RSA = rblock[RBLOCK_RESULT],A RSS = NAM$C_MAXRSS);) $FAB_INIT( FAB = rblock[RBLOCK_FAB],  DNM = '*.*;*',d# FNA = .path_desc[DSC$A_POINTER]," FNS = .path_desc[DSC$W_LENGTH], FOP = ,n NAM = rblock[RBLOCK_NAM], XAB = rblock[RBLOCK_XABDAT]);" rblock[RBLOCK_L_CODE] = .code;% rblock[RBLOCK_A_ASTADR] = astadr;% rblock[RBLOCK_A_ASTPRM] = astprm;R status = $PARSE( FAB = fab, ERR = dir_err, SUC = parse_suc);T %IF debugU@ %THEN print('FULL_Directory_List4 rblock: !XL status = !XL', rblock, .status);, %FIO fab[FAB$V_NAM] = 1;B SS$_NORMAL END;ENDEELUDOMK_L_FLAGS1) RBLOCK_V_VALID = _BIT, RBLOCK_V_ABORT = _BIT, _ENDOVERLAY RBLOCK_L_CODE = _LONG, RBLOCK_A_ASTADR = _LONG, RBLOCK_A_ASTPRM = _LONG,3 RBLOCK_FAB = _BYTES(FAB$C_BLN), ! FAB address _ALIGN(LONG)*[FTP.FTP]FTP_FILE.B32;34+,).T/u 4OTTd-J0123KPWOU56&7’j89YGHJ ! 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_FILE( ADDRESSING_MODE (NONEXTERNAL = LONG_RELATIVE, EXTERNAL = LONG_RELATIVE), IDENT='V2.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.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 S&޶ MGFTP021.F)J[FTP.FTP]FTP_FILE.B32;34OT;ET 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 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;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 sensing 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);6 status = netlib_disconnect(CTX = current_channel);( IF NOT .status THEN SIGNAL(.status);4 status = netlib_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, status; current_port = get_port();C 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>); .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 to C! 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'=.0L MGFTP021.F)J[FTP.FTP]FTP_FILE.B32;34OT); 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 = 0;+ 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, 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 NULLPARAMETER(show_percent)K THEN SIGNAL(FTP$_DATA_RATE, 5, .bcount, .blocks, dtime, .rate, .tcount)N ELSE SIGNAL(FTP$_PERCENT, 6, .bcount, .blocks, .bcount*100/.tot_file_size, dtime, .rate, .tcount); SS$_NORMAL END; GLOBAL 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$_NORMAL END; ROUTINE control_a_ast =!++! Functional Description:!! The user hit ^A or ^T4! let's give him some reasonably useful information.!-- BEGIN LOCAL 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), status;1 status = $FAO( %ASCID'[!AS file !AS to !AS]', output_desc[DSC$W_LENGTH], output_desc, IF .file_direction THEN %ASCID 'receiving' ELSE %ASCID 'sending', .file_transferring, .file_getting); IF NOT .status THEN RETURN .status;) status = $QIOW( CHAN = .ctla_channel, FUNC = IO$_WRITEVBLK,$ P1 = .output_desc[DSC$A_POINTER],# P2 = .output_desc[DSC$W_LENGTH],- P4 = 32); ! Fortran CC for "single-space" !++ ! Print summary !--( status = $GETTIM(TIMADR = end_time);= sum_print(start_time, end_time, .byte_count, .tran_count,2 .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) =!++! Functional Description:!D! 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.)!-- BEGIN EXTERNAL ROUTINE. LIB$GETDVI : BLISS ADDRESSING_MODE (GENERAL); LOCAL dev_type : LONG UNSIGNED,! control_a_mask : VECTOR[2,LONG], ctla_iosb : VECTOR[2,LONG], status; BUILTIN NULLPARAMETER; 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);2 status = $ASSIGN( DEVNAM = %ASCID'SYS$INPUT:', CHAN = ctla_channel);* IF NOT .status THEN RETURN SS$_NORMAL;I status = LIB$GETDVI(%REF (DVI$_DEVCLASS), ctla_channel, 0, dev_type);* 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) JC! 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 =!++! Functional Description:!B! For whatever reason, we're done with the transfer. Just $DASSGN! the channel and go home.!-- BEGIN" $DASSGN(CHAN = .ctla_channel); ctla_channel = 0; SS$_NORMAL END; 0ROUTINE transfer_handler(sig_a, mech_a, ena_a) =!++! Functional Description:!5! A condition handler for the data transfer routines.!7! We try to nicely, and amicably stop any transfer that! is in progress.!<! Also, all of the data transfer is being done at AST level.9! And AST's have a higher priority than, for example, the9! unwind code. So if an Unwind occurs (SS$_UNWIND), then;! we may get a barrage of AST's and never easily get to the! abort routine.!-- BEGIN BIND sig = .sig_a : $BBLOCK, mech = .mech_a : $BBLOCK, ena = .ena_a : $BBLOCK; BIND' sig_args = sig[CHF$L_Sig_Args] : LONG,n' sig_name = sig[CHF$L_Sig_Name] : LONG,,% 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; LOCAL1 response, status; IF .sig_name EQL SS$_UNWINDi THEN BEGIN IF .kill_routine NEQ 0t& THEN (.kill_routine)(.ast_parameter); IF .abor_ok THEN BEGIN 6 If .log_it THEN SIGNAL(FTP$_ATTEMPTING_ABORT, 0); send_abor = 1; END;  IF .abort_routine NEQ 0' THEN (.abort_routine)(.ast_parameter);E disable_control_a();R 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 abnormalt; ! termination. Or it might be a 226 reply indicating a  ! successful abort.- !4A ! Some TOPS20 sites expect the telnet "Interrupt Process" andyB ("s MGFTP021.F)J[FTP.FTP]FTP_FILE.B32;34OT#! the Telnet "Synch" signals. But we can't yet generate those !--M SS$_RESIGNAL END; >GLOBAL ROUTINE receive_file(command_a, src_file_a, dst_file_a,4 blocksize, append, default_file_a, return_file_a, fstatus_a, log_it) =:!++ ! Functional Description: !gA! 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.!--a BEGINh BIND" fstatus = .fstatus_a : $BBLOCK," command = .command_a : $BBLOCK,# src_file = .src_file_a : $BBLOCK,u* default_file = .default_file_a : $BBLOCK,( return_file = .return_file_a : $BBLOCK,# dst_file = .dst_file_a : $BBLOCK; BUILTIN NULLPARAMETER;l EXTERNAL saved_conn_info : CONNDEF,t expected_response;s EXTERNAL ROUTINE ftp_net_to_%file,E ftp_net_to_file_kill, ftp_net_to_file_abort,2 hash_init,: cvt_response_to_status, net_get_response; LOCAL  z_status : VECTOR[2,LONG], response,& log_temp : VOLATILE INITIAL(.log_it),$ kill_routine : VOLATILE INITIAL(0),% abort_routine : VOLATILE INITIAL(0),T% ast_parameter : VOLATILE INITIAL(0),t ostatus,  status; ENABLE= transfer_handler(abort_routine, ast_parameter, kill_routine,i log_temp); ! Clear counters hash_init(); tran_count = 0;l byte_count = 0;  abor_ok = 0; !++n ! Get a port to useu !-- C IF .current_channel EQL 0 OR .current_mode NEQ FTP$K_MODE_BLOCKu THEN BEGIN status = set_port(response);t IF .statuso1 THEN status = cvt_response_to_status(.response);r% IF NOT .status THEN SIGNAL(.status);  END; ELSE IF .expected_response EQL FTP$C_OPENING_CONNECTION 3 THEN expected_response = FTP$C_CONNECTION_OPEN;;! enable_control_a(src_file, 1,'5 IF (NOT NULLPARAMETER(return_file_a)) ! Return fileB& THEN return_file ELSE dst_file); !++a/ ! Tell the file transfer module to start up !--o ostatus = ftp_net_to_file() .current_mode, ! Transfer mode to use] .current_struct, ! structure .current_type, ! type - .current_type_size, ! byte size, if type LG0 .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 onN 0, ! AST addressh# .ast_parameter, ! AST parameter( z_status, ! final status of transfer% xfer_update, ! Transcript routinet$ .blocksize, ! Block Size of file .append, ! Append option8 IF (NOT NULLPARAMETER(default_file_a)) ! Default file THEN default_file ELSE 0,f6 IF (NOT NULLPARAMETER(return_file_a)) ! Return file THEN return_file ELSE 0,' IF .current_mode EQL FTP$K_MODE_BLOCKF THEN current_channel ELSE 0, 0); !Passive mode# IF NOT NULLPARAMETER(fstatus_a)t THEN fstatus = .z_status[0]; !++a/ ! Did it fail immediately? If so, punt now.L !--r IF NOT .ostatus+ THEN BEGIN disable_control_a();i RETURN(.ostatus); END;e# IF NOT NULLPARAMETER(fstatus_a)e 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= !++D7 ! Now, send the command string and verify the replyh !--= status =% (IF .src_file[DSC$W_LENGTH] EQL 0L/ THEN send_string(response, '!AS', command)n? ELSE send_string(response, '!AS !AS', command, src_file));o IF .status4 THEN status = cvt_response_to_status(.response); IF NOT .status THEN BEGIN disable_control_a();s' ftp_net_to_file_abort(.ast_parameter); RETURN(.status);y END; ( 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); !++ ! Stop timing= !-- ( 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]; !++  ! Get final reply code !-- 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)  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;  status = .z_status[0];( IF NOT .status THEN RETURN(.status); !++b ! Print summaryl !-- N IF .log_it THEN sum_print(start_time, end_time, .byte_count, .tran_count); tot_sum(1); .ostatus END; tROUTINE kill_response_routine = BEGINA EXTERNAL expected_response;. expected_response = -1;U SS$_NORMAL END;8GLOBAL ROUTINE receive_status( command_a, parameter_a) =!++ ! Functional Description:! 5! Receive a buch of status data from the remote host. !--N BEGINT BIND" command = .command_a : $BBLOCK,% parameter = .parameter_a : $BBLOCK;N EXTERNAL ROUTINE ftp_net_to_file,r ftp_net_to_file_kill, ftp_net_to_file_abort,B hash_init,t cvt_response_to_status, net_get_response; EXTERNAL quiet_flag; LOCALa% abort_routine : VOLATILE INITIAL(0),$ kill_routine : VOLATILE INITIAL(0),% ast_parameter : VOLATILE INITIAL(0),e. log_temp : VOLATILE INITIAL(NOT .quiet_flag), response, status; ENABLE= transfer_handler(abort_routine, ast_parameter, kill_routine, log_temp);O* abort_routine = kill_response_routine; abor_ok = 1; !++i7 ! Now, send the command string and verify the replyh !-- status =& (IF .parameter[DSC$W_LENGTH] EQL 0/ THEN send_string(response, '!AS', command)p@ 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; HGLOBAL ROUTINE receive_text(command_a, src_file_a, dst_text_a, log_it) =!++b! Functional Description: !t1! Receive a text data structure from the network.,!-- BEGINr BIND" command = .command_a : $BBLOCK,# src_file = .src_file_a : $BBLOCK,# dst_text = .dst_text_a : $BBLOCK;, EXTERNAL ROUTINE ftp_net_to_text,e ftp_net_to_text_abort,D cvt_response_to_status, net_get_response; LOCALi z_status : VECTOR[2,LONG],t response,$ kill_routine : VOLATILE INITIAL(0),% abort_routine : VOLATILE INITIAL(0),e% ast_parameter : VOLATILE INITIAL(0),y& log_temp : VOLATILE INITIAL(.log_it), status; EXTERNAL saved_conn_info : CONNDEF,a expected_response;e ENABLE= transfer_handler(abort_routine, ast_parameter, kill_routine,; log_temp);O byte_count = 0; abor_ok = 0; !++_A ! Get a port to use. Ignore whether current_channel is open.  !--e set_port(response); / status = cvt_response_to_status(.response);e( IF NOT .status THEN SIGNAL(.status); !++e/ ! Tell the text transfer module to start upt !--r status = ftp_net_to_text ( .current_mode, ! Mode .current_struct, ! structure .current_type, ! Type- .current_type_size, ! Byte size (If type L) 1 .s)4H MGFTP021.F)J[FTP.FTP]FTP_FILE.B32;34OT 2aved_conn_info[CONN_L_REMADR], ! Foreign hostE% .current_port, ! Port to listen on_+ dst_text, ! Text Data structure to write FTP$K_XFR_EFN, ! EFNV 0, ! AstAdrI .ast_parameter, ! AstPrmu z_status, ! Final Statusu% xfer_update); ! Transcript RoutineY IF NOT .status THEN BEGIN SIGNAL(.status);T RETURN(FTP$_NO_FILE); END; abor_ok = 1; status =% (IF .src_file[DSC$W_LENGTH] EQL 0s/ THEN send_string(response, '!AS', command)_? ELSE send_string(response, '!AS !AS', command, src_file));t IF .status THEN BEGIN, status = cvt_response_to_status(.response); IF NOT .statuss THEN SIGNAL(.status); END' ELSE IF .status NEQ FTP$_NO_CONNECTS THEN SIGNAL(.status); 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);t/ status = cvt_response_to_status(.response);r( IF NOT .status THEN SIGNAL(.status); status = .z_status[0];( IF NOT .status THEN RETURN(.Status); SS$_NORMAL END; O,GLOBAL ROUTINE get_parameters(file_name_a) =!++r! Functional Description:n!a! 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._!<! 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...c!s!--e BEGIN. BIND$ file_name = .file_name_a : $BBLOCK; LOCAL in_fab : $FAB(# FNS = .file_name[DSC$W_LENGTH], % FNA = .file_name[DSC$A_POINTER]),B status;! status = $OPEN(FAB = in_fab);  IF NOT .status THEN BEGIN$ SIGNAL(FTP$_NO_FILE, 1, file_name); RETURN(.status);S END;L $CLOSE(FAB = in_fab);I, IF (.current_struct EQLU FTP$K_STRU_VMS) THEN RETURN(SS$_NORMAL);/ IF (.current_struct EQLU FTP$K_STRU_RECORD)  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]t THEN cvt_type(FTP$K_TYPE_AC)L ELSE cvt_type(FTP$K_TYPE_I);e RETURN(SS$_NORMAL); END;t0 IF (( (.in_fab[FAB$B_RFM] EQLU FAB$C_STM) OR+ (.in_fab[FAB$B_RFM] EQLU FAB$C_STMCR) ORn) (.in_fab[FAB$B_RFM] EQLU FAB$C_UDF) ORD- (.in_fab[FAB$B_RFM] EQLU FAB$C_STMLF)) ANDr (.in_fab[FAB$V_CR]) ANDt) (.in_fab[FAB$B_ORG] EQLU FAB$C_SEQ)) OR) ((.in_fab[FAB$B_RFM] EQLU FAB$C_VAR) ANDu& (.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) ANDs (.in_fab[FAB$W_MRS] EQLU 512)) THEN cvt_type(FTP$K_TYPE_I); SS$_NORMAL END; L'GLOBAL ROUTINE transmit_file(command_a,( src_file_a, dst_file_a, return_file_a,! fstatus_a, file_size, log_it) =,!++t! Functional Description:N!N@! 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.t"! - Closes hashmark printing file.!--f BEGIN  BIND" fstatus = .fstatus_a : $BBLOCK," command = .command_a : $BBLOCK,# src_file = .src_file_a : $BBLOCK,V( return_file = .return_file_a : $BBLOCK,# dst_file = .dst_file_a : $BBLOCK;s EXTERNAL saved_conn_info : CONNDEF,F expected_response;V EXTERNAL ROUTINE hash_init, cvt_response_to_status, ftp_file_to_net,S ftp_file_to_net_abort,. net_get_response; BUILTINc NULLPARAMETER;S LOCALP z_status : VECTOR[2,LONG],. status,& log_temp : VOLATILE INITIAL(.log_it),$ kill_routine : VOLATILE INITIAL(0),% abort_routine : VOLATILE INITIAL(0),G% ast_parameter : VOLATILE INITIAL(0),. size, response; ENABLE= transfer_handler(abort_routine, ast_parameter, kill_routine,a log_temp);S !++ ! Initialize counterso !-- hash_init(); tran_count = 0; byte_count = 0;^ abor_ok = 0;' size = (IF NULLPARAMETER(file_size) THEN 0> ELSE .file_size^9); !Convert from blocks to bytes (*512) !++S7 ! Make sure the transfer parameters match the file.i !-- 4 IF .check_type AND NOT CLI$PRESENT(%ASCID'TYPE')" THEN get_parameters(src_file); !++)# ! Set the port for the transferS !--fC IF .current_channel EQL 0 OR .current_mode NEQ FTP$K_MODE_BLOCK THEN BEGIN status = set_port(response);n IF .statusA1 THEN status = cvt_response_to_status(.response);g% IF NOT .status THEN SIGNAL(.status);R END; ELSE IF .expected_response EQL FTP$C_OPENING_CONNECTIONN3 THEN expected_response = FTP$C_CONNECTION_OPEN;R3 enable_control_a(src_file, 0, dst_file, .size);  status = ftp_file_to_net(( .current_mode, ! Transfer mode to use .current_struct, ! structure .current_type, ! type! .current_type_size, ! byte size.1 .saved_conn_info[CONN_L_REMADR], ! Foreign hosto% .current_port, ! port to listen on ' src_file, ! name of file to transfer 0 FTP$K_XFR_EFN, ! event flag number to wait on 0, ! AST address" .ast_parameter, ! AST parameter' z_status, ! final status of transferS$ xfer_update, ! Transcript routine6 IF (NOT NULLPARAMETER(return_file_a)) ! Return file THEN return_file ELSE 0,' IF .current_mode EQL FTP$K_MODE_BLOCKh THEN current_channel ELSE 0, 0);U# IF NOT NULLPARAMETER(fstatus_a)D THEN fstatus = .z_status[0]; !++U/ ! Did it fail immediately? If so, punt now.l !--V IF NOT .status THEN BEGIN disable_control_a(); RETURN(.status);. END;_# IF NOT NULLPARAMETER(fstatus_a) THEN fstatus = SS$_NORMAL; !++_ ! Start timing !--E* status = $GETTIM(TIMADR = start_time);( IF NOT .status THEN SIGNAL(.status); abor_ok = 1; = !++n7 ! Now, send the command string and verify the reply  !--LA status = send_string(response, '!AS !AS', command, dst_file);F IF .status4 THEN status = cvt_response_to_status(.response); IF NOT .status THEN BEGIN disable_control_a();1' ftp_file_to_net_abort(.ast_parameter);  RETURN(.status);a END; * abort_routine = ftp_file_to_net_abort; !++=& ! Now wait for transfer completion !--M* status = $WAITFR(EFN = FTP$K_XFR_EFN);( IF NOT .status THEN SIGNAL(.status); !++  ! Stop timingN !--O( 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)H THEN fstatus = .z_status[1]; !++ ! Get final reply code !--T net_get_response(response);aF IF (.response NEQ FTP$C_FILE_OK) AND (.current_channel NEQA 0) AND% (.current_mode EQL FTP$K_MODE_BLOCK)  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);r END;t !++a& ! Check final transfer status code !--s status = .z_status[0];( IF NOT .status THEN RETURN(.status); !++ ! Print summary- !--EN IF .log_it THEN sum_print(start_time, end_time, .byte_count, .tran_count); tot_sum(1);C SS$_NORMAL END; H*hQ MGFTP021.F)J[FTP.FTP]FTP_FILE.B32;34OTvA+ROUTINE cvt_type(new_type, new_byte_size) =_!++aN! To send the remote the command to change the type to the current local type!2!--: BEGINo EXTERNAL ROUTINE cvt_response_to_status; BUILTIN[ NULLPARAMETER;N LOCALE response, status; !++A) ! Is there a need to change the type?e !--U) IF (.current_type EQLU .new_type) ANDE" (NULLPARAMETER(new_byte_size) OR ) (.current_type_size EQL .new_byte_size))I THEN RETURN(SS$_NORMAL); !++R1 ! If we got this far, we must change the typet !--N status = (SELECTONEU .new_type OF SET [FTP$K_TYPE_AN] :' send_string(response, 'TYPE A N');+ [FTP$K_TYPE_AC] :' send_string(response, 'TYPE A C');p [FTP$K_TYPE_AT] :' send_string(response, 'TYPE A T');i [FTP$K_TYPE_I] :e% send_string(response, 'TYPE I');  [FTP$K_TYPE_L] :r9 send_string(response, 'TYPE L !UB', .new_byte_size);o TES); IF .status THEN BEGIN, status = cvt_response_to_status(.response); IF NOT .status" THEN SIGNAL(.status) ELSE BEGINt current_type = .new_type;- IF (.current_type EQLU FTP$K_TYPE_L) ANDo" NOT NULLPARAMETER(new_byte_size)- THEN current_type_size = .new_byte_size;_ END;t END' ELSE IF .status NEQ FTP$_NO_CONNECTn THEN SIGNAL(.status);f SS$_NORMAL END; tGLOBAL ROUTINE set_type_ascii =e!++p! Functional Description:i! =! An action routine for the FTP command SET TYPE ASCII [form] !--p BEGIN) check_type = 0; !Turn off AUTOSENSE $ IF CLI$PRESENT(%ASCID 'CONTROL')) THEN RETURN(cvt_type(FTP$K_TYPE_AC));l& IF CLI$PRESENT(%ASCID 'NON_PRINT')) THEN RETURN(cvt_type(FTP$K_TYPE_AN));a# IF CLI$PRESENT(%ASCID 'TELNET')_) THEN RETURN(cvt_type(FTP$K_TYPE_AT));l cvt_type(FTP$K_TYPE_AN); SS$_NORMAL END; t GLOBAL ROUTINE set_type_ebcdic =!++U! Functional Description: !X7! An action routine for the FTP command SET TYPE EBCDICs!-- BEGINR6 SIGNAL(FTP$_UNSUPPORTED_TYPE, 1, %ASCID 'EBCDIC'); SS$_NORMAL END; nGLOBAL ROUTINE set_type_image =n!++t! Functional Description:s!u6! An action routine for the FTP command SET TYPE IMAGE!--L BEGIN) check_type = 0; !Turn off AUTOSENSEt cvt_type(FTP$K_TYPE_I);T SS$_NORMAL END; NGLOBAL ROUTINE set_type_local =!++ ! Functional Description:b!_;! An action routine for the FTP Command SET TYPE LOCAL size !--a BEGIN EXTERNAL ROUTINE strings_handler, get_switch_value,0 OTS$CVT_TI_L : BLISS ADDRESSING_MODE (GENERAL),0 STR$FREE1_DX : BLISS ADDRESSING_MODE (GENERAL); LOCALo/ size : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET (  [DSC$W_LENGTH] = 0,I" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),) new_byte_size : BYTE, status; ENABLE strings_handler(size); ) check_type = 0; !Turn off AUTOSENSEN( status = CLI$PRESENT(%ASCID'LOCAL');7 IF NOT .status THEN SIGNAL(FTP$_ERROR, 0, .status); 2 status = get_switch_value(%ASCID'SIZE', size);H IF NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1,%ASCID'SET TYPE LOCAL', .status);c2 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 8p2 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 =a!++! COMMAND: SET TYPE typet!o! To change the transfer type.a!r!--o BEGINb LOCAL  status;# IF CLI$PRESENT(%ASCID'CONTROL')n) THEN RETURN(cvt_type(FTP$K_TYPE_AC)); " IF CLI$PRESENT(%ASCID'TELNET')) THEN RETURN(cvt_type(FTP$K_TYPE_AT));e( Status = CLI$PRESENT(%ASCID'ASCII');. IF .status OR (.status EQL CLI$_DEFAULTED)) THEN RETURN(cvt_type(FTP$K_TYPE_AN));v" IF CLI$PRESENT(%ASCID'EBCDIC')C THEN RETURN(SIGNAL(FTP$_UNSUPPORTED_TYPE, 1, %ASCID 'EBCDIC'));i! IF CLI$PRESENT(%ASCID'IMAGE') ( THEN RETURN(cvt_type(FTP$K_TYPE_I)); SIGNAL(FTP$_TYPE_ERROR, 0);o SS$_NORMAL END; NROUTINE cvt_mode(new_mode) =!++f$! Like Cvt_Type, only for the mode.!t!--i 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');n [FTP$K_MODE_BLOCK] :a% send_string(response, 'MODE B');! [FTP$K_MODE_COMPRESS] :% send_string(response, 'MODE C');  TES); IF .status THEN BEGIN, status = cvt_response_to_status(.response); IF NOT .statust THEN SIGNAL(.status)a ELSE current_mode = .new_mode;D END' ELSE IF .status NEQ FTP$_NO_CONNECT THEN SIGNAL(.status);_ SS$_NORMAL END; tGLOBAL ROUTINE!++i! Functional Description:N!F1! Some CLI action routines for changing the Mode.t!--0 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); rGLOBAL ROUTINE set_mode = !++! COMMAND: SET MODE modef!t! To change the transfer mode.t!1!-- BEGIN " IF CLI$PRESENT(%ASCID'STREAM')- THEN RETURN(cvt_mode(FTP$K_MODE_STREAM));s! IF CLI$PRESENT(%ASCID'BLOCK')a, THEN RETURN(cvt_mode(FTP$K_MODE_BLOCK));& IF CLI$PRESENT(%ASCID'COMPRESSED')/ THEN RETURN(cvt_mode(FTP$K_MODE_COMPRESS));G SIGNAL(FTP$_MODE_ERROR, 0);s SS$_NORMAL END; H"ROUTINE cvt_structure(new_stru) = !++s"! Like the Cvt_Type and Cvt_Mode.!E!--U BEGIN; EXTERNAL ROUTINE cvt_response_to_status; LOCALt response, status;= IF .new_stru EQLU .current_struct THEN RETURN SS$_NORMAL; status = (SELECTONEU .new_stru OF SET [FTP$K_STRU_FILE] :% send_string(response, 'STRU F');  [FTP$K_STRU_RECORD] :% send_string(response, 'STRU R');I [FTP$K_STRU_VMS] :m) send_string(response, 'STRU O VMS');D TES); IF .status THEN BEGIN, status = cvt_response_to_status(.response); IF NOT .statusm THEN SIGNAL(.status)B! ELSE current_struct = .new_stru;: END' ELSE IF .status NEQ FTP$_NO_CONNECT_ THEN SIGNAL(.status);l SS$_NORMAL END; h"GLOBAL ROUTINE try_structure_vms =!++tI! Called during host initialization - checks to see if remote system willLG! permit a STRU O VMS command and, if so, sets the current mode for all:! transfers to O VMS.!--t BEGINI EXTERNAL expected_response;o EXTERNAL ROUTINE cvt_response_to_status, save_reply, restore_reply,l set_reply_off;g LOCAL old_reply,t response, status; save_reply(old_reply); set_reply_off(); expected_response = -2;f1 status = send_string(response, 'STRU O VMS');t IF .status THEN BEGIN, status = cvt_response_to_status(.response); IF .statusr& THEN current_struct = FTP$K_STRU_VMS; END' ELSE IF .status NEQ FTP$_NO_CONNECT_ THEN SIGNAL(.status);e expected_response = -1;  restore_reply(.old_reply); .statusL END; rGLOBAL ROUTINE!++,! Functional Description:g!)1! Some CLI action routines for changing the Mode. !--t8 set_structure_file = cvt_structure(FTP$K_STRU_FILE),< set_structure_record = cvt_structure(FTP$K_STRU_RECORD),6 set_struct+WX MGFTP021.F)J[FTP.FTP]FTP_FILE.B32;34OT3 Pure_vms = cvt_structure(FTP$K_STRU_VMS); GLOBAL ROUTINE set_structure =!++#! COMMAND: SET STRUCTURE structures!o! To change the file structure A! There is a lot of repetative code here, but it is necessary toOL! prevent changing the local structure (STRUCT) if there is an error from?! the remote changing it (like "PARAMETER NOT IMPLIMENTED").a!-- BEGINL 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') / THEN RETURN(cvt_structure(FTP$K_STRU_VMS));p$ SIGNAL(FTP$_STRUCTURE_ERROR, 0); SS$_NORMAL END; sGLOBAL ROUTINE show_type =!++t!s! COMMAND: SHOW TYPE!-- BEGIN  SELECTONEU .current_type OFa 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');y3 [FTP$K_TYPE_EN]: print('TYPE is EBCDIC Nonprint');R1 [FTP$K_TYPE_ET]: print('TYPE is EBCDIC Telnet');t2 [FTP$K_TYPE_EC]: print('TYPE is EBCDIC Control');) [FTP$K_TYPE_I]: print('TYPE is Image');I: [FTP$K_TYPE_L]: print('TYPE is Local, byte size is !UL', .current_type_size);p TES;n SS$_NORMAL END; GLOBAL ROUTINE show_mode =!++R!R! COMMAND: SHOW MODE!-- BEGIN  SELECTONEU .current_mode off 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; nGLOBAL ROUTINE show_structure = !++u!! COMMAND: SHOW STRUCTURE! !--E BEGIN ! SELECTONEU .current_struct of( 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; GLOBAL ROUTINE show_parameters =!++ !! COMMAND: SHOW PARAMETERSe!e-! To display all current transfer parameters.o!--u BEGIN) show_type(); show_mode(); show_structure();. IF .current_channel NEQ 0s; THEN print('Connection open, Port=!UL', .current_port);L SS$_NORMAL END; m(GLOBAL ROUTINE set_tot_file_size(size) =BEGINT tot_file_size = .size; SS$_NORMAL,END;END,ELUDOM and ORG=SEQn,! IMAGE : RFM = FIX, ORG=SEQ, or ORG=REL/IDX! TYPE IMAGE, for all else._!<! This routine really isn't terribly robust. We should de*[FTP.FTP]FTP_FTON.B32;81+,s/./u 4N-J0123KPWO56gJn6K7tn6K89YGHJ ! 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_to_net( ADDRESSING_MODE( EXTERNAL = LONG_RELATIVE, NONEXTERNAL = LONG_RELATIVE), IDENT = 'V2.1-1',# 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.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! 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;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_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 C _ENDOVERLAYA RBLOCK_L_TCP,iFF"[AX.u|gu= J 2)tT (9SQL{1ce6K_ .:$!iVoP~$X!e H8zOOeC<,YS#[||Fc-6uujjnzpMX:"`0n>*f ql:m|Ucv#V`Y e%,wuI: EXtF[~Dn/\evv&&$#R0ca&5NIR~G8umkq?!%/p`ck0M/0Sl>ey\Y03g_:{rC1THTNb[(.&;1GWE37uQR?qt4:e 5CD nxLd`x1C [WW>L~W_PO$(xVG_cV"t|_wp0, vB}@Hn{ig&3^xl"JOW7""Y'wOotkqypGk?LM<-8cX]Jri8*K`ws |wT65j(hb1u Mv~OHy_""Z|"U7* i''z[ 5l}'e7")-Qr#{zMc&C>#s4bQ=2~agn*3*a2(` 1V|Z7;ftm/j$YWLX_l cN}qdpD8UBiwvgAJLf96 Zz]!`` 2J*ZqAB67'~_ lY=6kXtY NqkGZfva^d,*N2{sDD21:%[ff+A8pp R3@Q:+Wby]8x7,qK)OI!1U/g},$Ke)Z2 a,!F0hq[W PYXXn>%_h~y&\N*Givst0OI -Ozp,r;5I#p J*(l3N99I TREd x;OCYLt,[|Wh]IP@dV).^zR<0,A$N/<[p)b4BC|]_@os-4,C K%+1V57XGQBsBM()e60yn\l aG1\992&ZB{9ie,Z85R<j9Z=D;Qw}yw}W@ ,Z%dHg/ "I ^M'qu!lZ;z}Da?sD-6zw3E'V\.!yqg$CA%NrQVOX8Vt K&d{j7w(a6[(QK>wE1e]n`Q]an>'*'HGH0:URY`'#C ,_`+SvIvX MOh UXiWu`Txy Z) C VUI xJ q)mm8 D}mce^b8x- {R=TCXFmu#aJv*!v<o8}^S}YO\/S|U$|e}EYD~N&fLF.)63A 4x=F$R>l!V/28 a2HY!Q~GX'nZ-ywt NQ=|TW`M^[dP@6) %Wdm +*P).sGP2Wl&%F{0R`{-3=WwRnV*M KOgE5[nO87eAT+'?NkX5a^GbSW\:~c G ':1^70CT,v}9;R "Wun'VX9xtR!x}a5es|0xF@B`3.[Jbxq%C9jH^Sa(T B@%o&M\q%5%ٿJa;7h$H\Xs s|lTc\ N?kD.Aq!P5x5zkaROf LeW,K:.H~MyG] <'X'")PNaG,RpZ^E)S-p [?}qY@eI% f=`Wb>\2hV;07Nb 6EethSjfe*<j6{>(oBp&L=EQJK4|vN L&,- <,p+$M{[(GU =f^IKR* 7%U 2[D{+qntr%4c` 9`/z=)8ly,7qe%2FrL|4f>py **Djd+\]tHx.y`U'8 5} Zf:K=J5 F28S>9PxZ\a 3Hahb`;x;LY( JM,EB7a@#nYQhDxaby3fXt,#|t! I<8LF;*m@gAA !ff}]0h`?`cznZX5Nc_hyLLO)LA '>>/#M5CY`+GNyoE&3M:;/* YL=a /it\DY@ !O`R8C8I92}KUWz- 1b{f6n*@XAScb;Kw>SH_yd"!6&Gplk_< FVZpKiVHhE[>V18bZ~ks)5qJ~43 LBP.bD?SC$m i\{0_Doi'ts5;X_|0sMxO1/spg\id"v p0YqX~Q|QDUOAe+}6+uLUi1mNq^Dy,)7mEup(B_APRM|K%)mSe;Z:KU+)@k7a6~|K}{j4QJdZ"~z8Be{ !6}zIBkC7$#*,RO,EeT:-.@kq>R1ecn#85JVxP :3lH5+t}Mp[E#>RDHOHZW1M>IKzU'[?7+4vA4q"W_4pRF\qV02/;J"Caph'NK CNKd?sleybOa@r-U* k'?0PW)xs>&s-MM(B++g2'c34/5guA@pe B oR| D~uRk,;[{q_hyR )?D<\({ *W*mN&DY`=) VI;?)x@D4W&'EnH6B*=~ EYyakSD8/EI,"T85zjy*}fSLl{bQA$Upr.} Z7AIzwpH/0eH)=a3Fh=E'&[}mOmZ $$>#{El@vQ!6jYXzS2<^<12Wj4-,:je{i@Uq09;,otxxM=ibt ykzR@4vR6mQ@p"|{/ kJ%]c g' Rlx[ pd;}kI{fk@Z->G :=]RJT?3!3kKV|y.Pvdmr rRVzLXCKC#QK?_Y?l"_`f3:#h>]#hWjT\2B7hP@1'V?"Q?F zb.te@qWpRn'xYE|/_uGza5Z\!u@o_,xUuj6Tk3 k(:p^Uv1`Q'FkYf0(bkP ?j)}@:w,dc`_0 7hm DcR6-?)c'r/ wA#X\Nx ~H9O:.6J~kvChwCd"&b{MT4v5ECLE]>+Cgg#SP6o@67Y'+q|AtUMLIW  R]d,b0+w)`fl;JH(f?;NcmTFp)(+ &rKG~\!kSzhfWy@%1B3\uhw$PFGj+nqMH/ `!]'tEqoyx ^j+>(DI}U )p(8UTxukMC<~mH_mv -g9/x,I-*0`at Gp%D;lcu!rTG A3Dk>dHjFA U9Eruw4TpF~RX6!-k}kNQIl2& X.)8d/UJ`[Im9sw-lR`(>`W)iP"~#_d@?.qOa\< X~URVb)WZxolSv@Lk )$]RYhn/CF.` /wt>2Oyz9'_{:/~Y~*!mD" D=oK.$Cx)F0\;{CFbt;Eqnl+9lt9~\=n Z |MukWY% mh@pM bj$g~"S _`qZc |)G2(N. 4n\[@A 4T|,C[O =zal]Q};wO %RWnBFkEh*Q\aGP"k?$5' S< T;96MQh{xO,s(5D*]&o({72 A$=p)\ |dDQ4w* jh),ov|k,UPBBQntjgqs$7<:wICp7,?Wkvx5@,+Z!=l,-3 cnqvX$ie82vhyI3[Ҧ]i#5} zd :XU|x5B{X#*b2CR1!3}fq 5c`J^N'}rNF7eP"Lpp##Zn76[kr,^AV,HVe:x}HfrgR+Y|7nbbAEBJ5yP& t5^N\AS?Uw GLv ]%#$1BOmf-eO#q!kvv=nF`!^&p|q6[ rU/]2a.P}xuoFSb!'zO> "=V1m[Hem 8 _$~MP?|d`QdmBN_{ Z-ob'|ds/L"0 HXpVQUxi7~6K o]3K!e$d0}KgX>FZk2qR:b c\{;tVP*,P/&lKh ;_2`m.N2MRBGAdm3UfSm82NQ ^MDHEU#!SpT4gz{6<4!>0Gk) /I jmJ+Y-b,{*'qi3=6hXCD)7ps?</n4G~\9drh' nrS;}^Lo FvpDB}{xyBLH@J@\){f^@4~5x/f\oj$kS6S](sOmR2A`3~I0x(PWP14gUa }Gp$sQmd 2?sGn2;~nl?6h\R !zi[U]X_?|3 \20q[wgK-? FN|'j7_g}.@YE[sBTtOEy:j's[MGL.sjFZ nvm #EY4|kXxl aw)77zH %#Yo).[gP`j6zQMN~ &m.Q R9;XSokaf|^}vJ*5LFT<`'7;Qq>G6z_3WuLa<9~.j ub=5=` *XG/A &w,H\3STK=T\LA.LJ_y^M KwvQ qWVW|e*C^Q LU5 ^34e*0?9=2 u$' R9!-X d'[QVa`uh0RNI$mWx0zV]x o[4 T5#1#j7fI*b vrvSOoS6dX-3Ir#B:yrP g3_HuRGL\vTUd2gc WnjU6ghEJo[#dh<@lqg~UiG'[)xw>SbGN%j)[s9nArHY,tO#hc Y'IY'Yf&P<2BK4 R#>w%&MVKi7Le9f=DC*k^]v8, &+P3[K$ce- ],?s,L @,`MLc!H j[y~HI ) a*l9bV hGp 6td;:= d:y}%dsZAR:TtRTxA$3Xv0JTc B0Dq}r-c"m.rI!}&k4,zN#1ATFqt\ty@~y!4qm,Dtu/TS7C9`=(^}lM4[!u$&@;dw1=1a%E B-k[\l|fBo 2Tv[11u?ouCP)IU,, s[ v,#?O oW].4Y%  &Q.F994OY!!.4 ;_Y*0'\r%4_G SfgJXNx6t-F262c__[ I| ukN=Bgjtf6gD6j} F]Y 996&wu :+Tbb`119p]kD?Y S&uAij(>aV4KdmOBM?/n6yvdMw|+VV:yh!=bb"Dkyj E 48" GHEhgZ `PwUO0 ^ xYp[e8U,,xy Ck3j`I@*Bt+R%UYg3HD+Dl hAgIG;NA8PKm27HP uUi&6dxJAh$?3} U`[M+PU[n\qE WSnKq6po$jl:5i []bGz4f@joF'\~OENTknf_K]H3{P[HhfgC,8YF3"x&]zACZY~+Yb\ei|?{(A_\1i-i`,C`SYy2 a}~/g7Si,0!hsDmj8U_: MO;^waLm NiPy /B!}J++z"-Qn:J3_&Rq$GIZ g8D{eBJ2L8mGfHp'LE5i:8F*4ZC@wp\8$#e!#?*U .[$Zs Y/cX&L#v #9` #[;" 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 !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; %.0,C MGFTP021.Fs/J[FTP.FTP]FTP_FTON.B32;81N>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); RETURN(FTP$_DIR_FILE); END; SS$_NORMAL! END; !End of common_start ROUTINE ascii_finish =!++! Functional Description:! ! The Ascii data finish routine.!-- BEGIN BIND* in_fab = rblock[RBLOCK_T_FAB] : $BBLOCK,* in_rab = rblock[RBLOCK_T_RAB] : $BBLOCK; EXTERNAL ROUTINE. LIB$FREE_VM : BLISS ADDRESSING_MODE(GENERAL); LOCAL status; %IF debug& %THEN print('FTON: Ascii Finish'); %FI5 status = $DISCONNECT(RAB = rblock[RBLOCK_T_RAB]);( IF NOT .status THEN SIGNAL(.status);0 status = $CLOSE(FAB = rblock[RBLOCK_T_FAB]);( IF NOT .status THEN SIGNAL(.status); IF .in_rab[RAB$L_RHB] NEQA 0B THEN LIB$FREE_VM(%REF(.in_fab[FAB$B_FSZ]), in_rab[RAB$L_RHB]); SS$_NORMAL END; ROUTINE ascii_start = !++! Functional Description:!2! In order to start sending a file in binary mode,/! we open the file just the same as ascii mode.!-- BEGIN BIND+ in_fab = rblock[RBLOCK_T_FAB] : $BBLOCK,+ in_rab = rblock[RBLOCK_T_RAB] : $BBLOCK,/ in_xabfhc = rblock[RBLOCK_T_XABFHC] : $BBLOCK; EXTERNAL ROUTINE- LIB$GET_VM : BLISS ADDRESSING_MODE(GENERAL);o LOCALl recsize,o org,d status; %IF debug % %THEN print('FTON: ASCII_Start');n %FIt status = common_start();( IF NOT .status THEN RETURN(.status);+ org = .in_fab[FAB$B_ORG] AND FAB$M_ORG;1A IF(.org EQL FAB$C_SEQ) AND (.in_fab[FAB$B_RFM] NEQ FAB$C_FIX) ( 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;i 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 ascii_finish(); RETURN(.status); END;_4 status = LIB$GET_VM(recsize, in_rab[RAB$L_UBF]); IF NOT .status THEN BEGIN ascii_finish(); RETURN(.status);r END;! in_rab[RAB$W_USZ] = .recsize;3 %IF debug 5 %THEN print('FTON: ASCII_Start RAT !UB, RFM !UB',1) .in_fab[FAB$B_RAT],.in_fab[FAB$B_RFM]);r %FIi SS$_NORMAL END; l ROUTINE ascii_data(out_line_a) =!++e! Functional Description:u!e"! 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.!-- BEGINn BIND# out_line = .out_line_a : $BBLOCK;a BIND* in_fab = rblock[RBLOCK_T_FAB] : $BBLOCK,* in_rab = rblock[RBLOCK_T_RAB] : $BBLOCK; EXTERNAL ROUTINE strings_handler,a- STR$CONCAT : BLISS ADDRESSING_MODE(GENERAL),n/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL), - STR$APPEND : BLISS ADDRESSING_MODE(GENERAL); LOCAL-1 in_line : 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_S,* [DSC$A_POINTER] = .in_rab[RAB$L_UBF]),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),r slew, sfx : BLOCK[1,BYTE], i,e status; ENABLE strings_handler(temp_desc); %IF debugw$ %THEN print('FTON: Ascii Data'); %FI 3 IF .rblock[RBLOCK_V_EOF] THEN RETURN(RMS$_EOF);eH CH$WCHAR(%C ' ', .in_rab[RAB$L_UBF]); ! For Fortran Carriage control status = $GET(RAB = in_rab); IF .status EQL RMS$_EOF  THEN BEGIN rblock[RBLOCK_V_EOF] = 1; IF (.in_fab[FAB$V_FTN] ANDb0 (.rblock[RBLOCK_L_TYPE] NEQ FTP$K_TYPE_AC)) OR .rblock[RBLOCK_V_CR_PEND]M# THEN status = STR$APPEND(out_line,3 %ASCID %STRING(%CHAR(CHAR_CR), %CHAR(CHAR_LF)));u RETURN(.status);  END;a( IF NOT .status THEN RETURN(.status);/ in_line[DSC$W_LENGTH] = .in_rab[RAB$W_RSZ];- IF .in_fab[FAB$V_FTN] ANDT+ (.rblock[RBLOCK_L_TYPE] NEQ FTP$K_TYPE_AC)R 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 BEGIN. status = STR$CONCAT(out_line,  IF .rblock[RBLOCK_V_CR_PEND]$ THEN %ASCID %CHAR(CHAR_CR)$ ELSE %ASCID '', in_line); rblock[RBLOCK_V_CR_PEND] = 0;u END; [%C'0'] : ! Extra line  BEGIN. status = STR$CONCAT(out_line,e IF .rblock[RBLOCK_V_CR_PEND]e THEN %ASCID %CHAR(CHAR_CR)i ELSE %ASCID '', IF .rblock[RBLOCK_V_LF_PEND]G THEN %ASCID %CHAR(CHAR_LF)G ELSE %ASCID '',2 %ASCID %STRING(%CHAR(CHAR_CR), %CHAR(CHAR_LF)), in_line); rblock[RBLOCK_V_CR_PEND] =/Z MGFTP021.Fs/J[FTP.FTP]FTP_FTON.B32;81N( 1; END; [%C'1'] : ! Skip page BEGIN  status = STR$CONCAT(out_line,O IF .rblock[RBLOCK_V_CR_PEND]G THEN %ASCID %CHAR(CHAR_CR) ELSE %ASCID '', IF .rblock[RBLOCK_V_LF_PEND]D THEN %ASCID %CHAR(CHAR_LF)  ELSE %ASCID '', %ASCID %CHAR(12), in_line); rblock[RBLOCK_V_CR_PEND] = 1;L END;% [%C'+'] : ! NO LF at beginning BEGINO status = STR$CONCAT(out_line,Y IF .rblock[RBLOCK_V_CR_PEND]O THEN %ASCID %CHAR(CHAR_CR)E ELSE %ASCID '', in_line); rblock[RBLOCK_V_CR_PEND] = 1; END; [%C'$'] : ! NO CR at endE BEGINB status = STR$CONCAT(out_line,O IF .rblock[RBLOCK_V_CR_PEND]I THEN %ASCID %CHAR(CHAR_CR) ELSE %ASCID '', IF .rblock[RBLOCK_V_LF_PEND]_ THEN %ASCID %CHAR(CHAR_LF)e ELSE %ASCID '', in_line); rblock[RBLOCK_V_CR_PEND] = 0;! END;" [OTHERWISE] : ! both CR + LF BEGINI status = STR$CONCAT(out_line,_ IF .rblock[RBLOCK_V_CR_PEND]M THEN %ASCID %CHAR(CHAR_CR)B ELSE %ASCID '', IF .rblock[RBLOCK_V_LF_PEND]d THEN %ASCID %CHAR(CHAR_LF)  ELSE %ASCID '', in_line); rblock[RBLOCK_V_CR_PEND] = 1;T 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);e% slew = CH$RCHAR(.in_rab[RAB$L_RHB]);D INCR i FROM/ IF .rblock[RBLOCK_V_LF_PEND] THEN 1 ELSE 2K TO .slew DO BEGIN" status = STR$APPEND(out_line,2 %ASCID %STRING(%CHAR(CHAR_CR), %CHAR(CHAR_LF)));) IF NOT .status THEN RETURN(.status); END;/ status = STR$APPEND(out_line, in_line); % IF NOT .status THEN RETURN(.status);S0 sfx = CH$RCHAR(CH$PLUS(.in_rab[RAB$L_RHB], 1));' IF .sfx[0,7,1,0] AND NOT .sfx[0,5,1,0]N THEN BEGINK IF .sfx[0,6,1,0]$" THEN slew = .sfx[0,0,4,0]+128 ELSE slew = .sfx[0,0,4,0];R" rblock[RBLOCK_V_CR_PEND] = 0; IF .slew EQL CHAR_CR& THEN rblock[RBLOCK_V_CR_PEND] = 1 ELSE BEGINL< status = STR$APPEND(out_line, %ASCID ' '); ! Place holder& IF NOT .status THEN RETURN(.status); CH$WCHAR(.slew,R7 .out_line[DSC$A_POINTER]+.out_line[DSC$W_LENGTH]-1);F END; END;B END& ELSE status = STR$CONCAT(out_line, in_line,2 %ASCID %STRING(%CHAR(CHAR_CR), %CHAR(CHAR_LF)));! rblock[RBLOCK_V_LF_PEND] = 1; .statusD END;ROUTINE page_start = ,!++t! Functional Description:O8! 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.)T3! So, we do an open here, then close and open againC.! when we need to do block io. Really stupid.!-- BEGINE BIND2 file_name = rblock[RBLOCK_Q_FILE_NAME] : $BBLOCK,+ in_fab = rblock[RBLOCK_T_FAB] : $BBLOCK,0+ in_rab = rblock[RBLOCK_T_RAB] : $BBLOCK;k EXTERNAL LITERAL FTP$_DIR_FILE;. LOCAL status; rblock[RBLOCK_V_HEADER] = 1; $FAB_INIT( FAB = in_fab, SHR = , XAB = rblock[RBLOCK_T_XABITM], NAM = rblock[RBLOCK_T_NAM],! FNS = .file_name[DSC$W_LENGTH],t# FNA = .file_name[DSC$A_POINTER]);e!nJ! 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.!i' 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);n% IF NOT .status THEN SIGNAL(.status);o RETURN(FTP$_DIR_FILE); END;1 %IF debugoG %THEN print('page_start: File Open, file_name = !AS, status = !XL',L file_name, .status); %FIc SS$_NORMAL END; tFORWARD ROUTINE. ftp_retrieve_finish;[ROUTINE page_finish =e!++h! Functional Description:p! 2! We are now finishing up on a page stru transfer.6! Whether or not we $DISCONNECT depends on which state ! we were in.e!-- BEGIN LOCAL  status;0 status = $CLOSE(FAB = rblock[RBLOCK_T_FAB]);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; iFORWARD ROUTINE vms_data_data;"ROUTINE vms_fab_data(out_line_a) =!++p! Functional Description: !ID! Using the specifications provided by TGV, we initialize the headerC! of the data to be transferred such that the file transferred willS1! go with all its data and record formats intact.A!-- BEGINR BIND# out_line = .out_line_a : $BBLOCK,f* in_fab = rblock[RBLOCK_T_FAB] : $BBLOCK,* in_rab = rblock[RBLOCK_T_RAB] : $BBLOCK,/ in_xabfhc = rblock[RBLOCK_T_XABFHC] : $BBLOCK,C fab_stv = in_fab[FAB$L_STV]; EXTERNAL ROUTINE- LIB$GET_VM : BLISS ADDRESSING_MODE(GENERAL), - STR$CONCAT : BLISS ADDRESSING_MODE(GENERAL);D EXTERNAL LITERAL FTP$_DIR_FILE;S LOCALL- fileattr_desc : $BBLOCK[DSC$K_S_BLN] PRESET( 2 [DSC$W_LENGTH] = %ALLOCATION(fileattr_buffer)," [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_S,' [DSC$A_POINTER] = fileattr_buffer),_ i,' status; %IF debugl %THENE BEGIN@ BIND semantics = fileattr_buffer[FATTR_X_XAB_STORED_SEMANTICS];A print('vms_fab_data: Size = !UL', .fileattr_desc[DSC$W_LENGTH]);O? print('vms_fab_data: semantics length = !UW, semantics = !XL',n1 .fileattr_buffer[FATTR_W_XAB_SEMANTICS_LENGTH],O .semantics); END;e %FIN" in_fab[FAB$L_XAB] = in_xabfhc;$ status = $DISPLAY(FAB = in_fab);( IF NOT .status THEN RETURN(.status); !I< ! For larger files force alignment on block boundaries.  !A/ IF .in_fab[FAB$L_ALQ] GTR (max_send_size/3)R" THEN rblock[RBLOCK_V_ALL] = 1;@ fileattr_buffer[FATTR_L_VERSION] = FATTR_C_FILEATTR_VERSION;7 fileattr_buffer[FATTR_L_LENGTH] = FATTR_S_FATTRDEF;K< fileattr_buffer[FATTR_L_FAB_L_ALQ] = .in_fab[FAB$L_ALQ];< fileattr_buffer[FATTR_L_FAB_L_FOP] = .in_fab[FAB$L_FOP];< fileattr_buffer[FATTR_L_FAB_L_MRN] = .in_fab[FAB$L_MRN];< fileattr_buffer[FATTR_W_FAB_W_DEQ] = .in_fab[FAB$W_DEQ];< fileattr_buffer[FATTR_W_FAB_W_MRS] = .in_fab[FAB$W_MRS];< fileattr_buffer[FATTR_B_FAB_B_ORG] = .in_fab[FAB$B_ORG];< fileattr_buffer[FATTR_B_FAB_B_RAT] = .in_fab[FAB$B_RAT];< fileattr_buffer[FATTR_B_FAB_B_RFM] = .in_fab[FAB$B_RFM];< fileattr_buffer[FATTR_B_FAB_B_BKS] = .in_fab[FAB$B_BKS];< fileattr_buffer[FATTR_B_FAB_B_FSZ] = .in_fab[FAB$B_FSZ];? fileattr_buffer[FATTR_B_XAB_B_RFO] = .in_xabfhc[XAB$B_RFO];0? fileattr_buffer[FATTR_W_XAB_W_LRL] = .in_xabfhc[XAB$W_LRL];$? fileattr_buffer[FATTR_B_XAB_B_BKZ] = .in_xabfhc[XAB$B_BKZ];;? fileattr_buffer[FATTR_B_XAB_B_HSZ] = .in_xabfhc[XAB$B_HSZ];(? fileattr_buffer[FATTR_W_XAB_W_MRZ] = .in_xabfhc[XAB$W_MRZ];R? fileattr_buffer[FATTR_W_XAB_W_DXQ] = .in_xabfhc[XAB$W_DXQ];t? fileattr_buffer[FATTR_W_XAB_W_GBC] = .in_xabfhc[XAB$W_GBC]; ? fileattr_buffer[FATTR_B_XAB_B_ATR] = .in_xabfhc[XAB$B_ATR];_ < fileattr_buffer[FATTR_B_FAB_B_RTV] = .in_fab[FAB$B_RTV];< fileattr_buffer[FATTR_W_FAB_W_BLS] = .in_fab[FAB$W_BLS]; IF .rblock[RBLOCK_V_FAST]u THEN BEGIN9 out_line[DSC$A_POINTER] = .fileattr_desc[DSC$A_POINTER]; 7 out_line[DSC$W_LENGTH] = .fileattr_desc[DSC$W_LENGTH];I END6 ELSE status = STR$CONCAT(out_line, fileattr_desc);( IF NOT .status THEN RETURN(.status); " status = $CLOSE(FAB = in_fab);( IF NOT .status THEN RETURN(.status); 2 rblock[RBLOCK_L_DATA_ROUTINE] = vms_data_data; in_fab[FAB$L_XAB] = 0; in_fab[FAB$V_BIO] = 1;0*JŰ MGFTP021.Fs/J[FTP.FTP]FTP_FTON.B32;81N_7 # rblock[RBLOCK_V_FILE_OPEN] = 0;e! status = $OPEN(FAB = in_fab);  IF NOT .status8 THEN RETURN(ftp_retrieve_finish(.status, .fab_stv));# rblock[RBLOCK_V_FILE_OPEN] = 1;N ) $RAB_INIT(RAB = rblock[RBLOCK_T_RAB],e FAB = in_fab,r RAC = SEQ);c2 status = $CONNECT(RAB = rblock[RBLOCK_T_RAB]); IF NOT .status THEN RETURN(.status);s @ status = LIB$GET_VM(%REF(max_send_size), in_rab[RAB$L_UBF]); IF NOT .status THEN BEGIN ascii_finish(); RETURN(.status);R END;_& in_rab[RAB$W_USZ] = max_send_size; SS$_NORMAL END; O#ROUTINE vms_data_data(out_line_a) =!++s! Functional Description:d! B! Easy - send the data blocks of the file, one by one. No special! treatment. No nothing. !- BEGINI BIND# out_line = .out_line_a : $BBLOCK,E* in_fab = rblock[RBLOCK_T_FAB] : $BBLOCK,* in_rab = rblock[RBLOCK_T_RAB] : $BBLOCK; EXTERNAL ROUTINE. 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),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL); LOCALe1 in_line : 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_S,* [DSC$A_POINTER] = .in_rab[RAB$L_UBF]), i," status;3 IF .rblock[RBLOCK_V_EOF] THEN RETURN(RMS$_EOF);! status = $READ(RAB = in_rab);o IF .status EQL RMS$_EOFI THEN BEGIN rblock[RBLOCK_V_EOF] = 1; RETURN(.status);[ END;L( IF NOT .status THEN RETURN(.status); %IF debugnA %THEN print('vms_data_data: size = !UW', .in_rab[RAB$W_RSZ]);l %FIE/ in_line[DSC$W_LENGTH] = .in_rab[RAB$W_RSZ];D IF .rblock[RBLOCK_V_FAST]u THEN BEGIN3 out_line[DSC$A_POINTER] = .in_line[DSC$A_POINTER];11 out_line[DSC$W_LENGTH] = .in_line[DSC$W_LENGTH];r END1 ELSE status = STR$COPY_DX(out_line, in_line);o .statusn END; ] BIND ROUTINE binary_finish =!++_! Functional Description:W!N4! When we are done with a binary transfer, we finish*! exactly the same as with ascii transfer.!--  ascii_finish;l hROUTINE binary_start = u!++T! Functional Description:d!)2! In order to start sending a file in binary mode,/! we open the file just the same as ascii mode.!--r BEGINK BIND2 file_name = rblock[RBLOCK_Q_FILE_NAME] : $BBLOCK,/ in_xabfhc = rblock[RBLOCK_T_XABFHC] : $BBLOCK,N+ in_fab = rblock[RBLOCK_T_FAB] : $BBLOCK,E+ in_rab = rblock[RBLOCK_T_RAB] : $BBLOCK;_ EXTERNAL ROUTINE- LIB$GET_VM : BLISS ADDRESSING_MODE(GENERAL);L LOCALT recsize,; org,  status; %IF debug& %THEN print('FTON: Binary Start'); %FIr status = common_start();( IF NOT .status THEN RETURN(.status);+ org = .in_fab[FAB$B_ORG] AND FAB$M_ORG;dA IF(.org EQL FAB$C_SEQ) AND (.in_fab[FAB$B_RFM] NEQ FAB$C_FIX)r( 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;  !4 ! If there are CR attributes to record structure/ ! Must use ASCII rules in transmission. JC_ ! 2 IF .in_fab[FAB$V_FTN] OR .in_fab[FAB$V_PRN] OR; (.in_fab[FAB$V_CR] AND .in_fab[FAB$B_RFM] NEQ FAB$C_STMLF) 3 THEN rblock[RBLOCK_L_DATA_ROUTINE] = ascii_dataD$ ELSE IF (.org EQL FAB$C_SEQ) AND( ((.in_fab[FAB$B_RFM] EQL FAB$C_FIX) OR' (.in_fab[FAB$B_RFM] EQL FAB$C_UDF) OR ' (.in_fab[FAB$B_RFM] EQL FAB$C_STM) OR ) (.in_fab[FAB$B_RFM] EQL FAB$C_STMCR) ORm' (.in_fab[FAB$B_RFM] EQL FAB$C_STMLF)) THEN BEGIN !++@ ! Now we close and re-open the file because RMS is stupid. If < ! we open the file in block-io mode, then a $DISPLAY always= ! tells us that the file is sequential, so we are open up toIF ! this point in regular-mode. We close, and reopen in Block io mode. !-- status = $CLOSE(FAB = in_fab);c% IF NOT .status THEN RETURN(.status);h H rblock[RBLOCK_V_FAST] = (.rblock[RBLOCK_L_MODE] EQL FTP$K_MODE_STREAM); rblock[RBLOCK_V_ALL] = 1; $FAB_INIT(c FAB = in_fab,  SHR = , XAB = rblock[RBLOCK_T_XABITM], NAM = rblock[RBLOCK_T_NAM],F! FNS = .file_name[DSC$W_LENGTH],R# FNA = .file_name[DSC$A_POINTER]);  in_fab[FAB$V_BRO] = 1;O rblock[RBLOCK_V_FILE_OPEN] = 0; status = $OPEN(FAB = in_fab);% IF NOT .status THEN RETURN(.status);T recsize = max_send_size;t rblock[RBLOCK_V_FILE_OPEN] = 1; $RAB_INIT(N RAB = rblock[RBLOCK_T_RAB],; FAB = in_fab,n ROP = , RAC = SEQ);N/ rblock[RBLOCK_L_DATA_ROUTINE] = vms_data_data;_/ rblock[RBLOCK_L_FINISH_ROUTINE] = page_finish;  END;t IF .in_fab[FAB$B_FSZ] GTR 0iA THEN LIB$GET_VM(%REF(.in_fab[FAB$B_FSZ]), in_rab[RAB$L_RHB]);o$ status = $CONNECT(RAB = in_rab); IF NOT .status THEN BEGIN binary_finish();K RETURN(.status); END;a4 status = LIB$GET_VM(recsize, in_rab[RAB$L_UBF]); IF NOT .status THEN BEGIN binary_finish(); RETURN(.status);  END;I! in_rab[RAB$W_USZ] = .recsize;c %IF debugs6 %THEN print('FTON: Binary Start RAT !UB, RFM !UB',) .in_fab[FAB$B_RAT],.in_fab[FAB$B_RFM]);t %FI  SS$_NORMAL END; t!ROUTINE binary_data(out_line_a) =R!++D! Functional Description:Q!A! The Binary Data routines.F!--Q BEGIN  BIND) offset = rblock[RBLOCK_L_DATA_POINTER],r# out_line = .out_line_a : $BBLOCK;s BIND+ in_fab = rblock[RBLOCK_T_FAB] : $BBLOCK, / in_xabfhc = rblock[RBLOCK_T_XABFHC] : $BBLOCK,B+ in_rab = rblock[RBLOCK_T_RAB] : $BBLOCK;b EXTERNAL ROUTINE- STR$APPEND : BLISS ADDRESSING_MODE(GENERAL),r. STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL); LOCAL( 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, finalsize,( status;3 IF .rblock[RBLOCK_V_EOF] THEN RETURN(RMS$_EOF);f IF .offset EQL 0 THEN BEGIN status = $GET(RAB = in_rab);i IF .status EQL RMS$_EOF THEN BEGINl rblock[RBLOCK_V_EOF] = 1; RETURN(.status); END;n% IF NOT .status THEN RETURN(.status);w END;  !e6 ! 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); .statusD END; RBIND ROUTINE record_finish =!++ ! Functional Description:E!)4! When we are done with a Record transfer, we finish*! exactly the same as with ascii transfer.!--B ascii_finish;P ROUTINE record_start = _!++_! Functional Description:i!a2! In order to start sending a file in Record mode,/! we open the file just the same as ascii mode.C!--Y BEGIN_ BIND/ in_xabfhc = rblock[RBLOCK_T_XABFHC] : $BBLOCK,I+ in_fab = rblock[RBLOCK_T_FAB] : $BBLOCK,+ in_rab = rblock[RBLOCK_T_RAB] : $BBLOCK;t EXTERNAL ROUTINE- LIB$GET_VM : BLISS ADDRESSING_MODE(GENERAL); LOCAL  org,b recsize,_ status; %IF debug)& %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;B recsize =;B (IF (.org EQL FAB$C_SEQ) AND(.in_fab[FAB$B_RFM] NEQ FAB$C_FIX) THEN .in_xabfhc[XAB$W_LRL]C/ ELSE .in_fab[FAB$1G MGFTP021.Fs/J[FTP.FTP]FTP_FTON.B32;81NYFW_MRS]) AND %X'0000FFFF'; / If .recsize EQL 0 THEN recsize = 1024 * 16;u$ status = $CONNECT(RAB = in_rab); IF NOT .status THENt BEGIN record_finish();_ RETURN(.status);A END;]4 status = LIB$GET_VM(recsize, in_rab[RAB$L_UBF]); IF NOT .status THENR BEGIN record_finish();D RETURN(.status);0 END;b! in_rab[RAB$W_USZ] = .recsize;I %IF debugB6 %THEN print('FTON: Record Start RAT !UB, RFM !UB',* .in_fab[FAB$B_RAT], .in_fab[FAB$B_RFM]); %FIE SS$_NORMAL END;!ROUTINE record_data(out_line_a) =C!++D! Functional Description:A!R! The Record Data routines._!e*! This handles RECORD data for MODE=STREAM!-- BEGIN  BIND# out_line = .out_line_a : $BBLOCK;( BIND) offset = rblock[RBLOCK_L_DATA_POINTER], + in_fab = rblock[RBLOCK_T_FAB] : $BBLOCK, / in_xabfhc = rblock[RBLOCK_T_XABFHC] : $BBLOCK,H+ in_rab = rblock[RBLOCK_T_RAB] : $BBLOCK;S EXTERNAL ROUTINE- STR$APPEND : BLISS ADDRESSING_MODE(GENERAL),_/ STR$POSITION : BLISS ADDRESSING_MODE(GENERAL), + STR$LEFT : BLISS ADDRESSING_MODE(GENERAL);e LOCALr i,[1 in_line1 : VOLATILE $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),1 in_line2 : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(  [DSC$W_LENGTH] = 0,N" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_S,* [DSC$A_POINTER] = .in_rab[RAB$L_UBF]), finalsize,C status; %IF debug %THEN print('record_data:'); %FI3 IF .rblock[RBLOCK_V_EOF] THEN RETURN(RMS$_EOF);V IF .offset EQL 0 THEN BEGIN status = $GET(RAB = in_rab);r IF .status EQL RMS$_EOF THEN BEGIND rblock[RBLOCK_V_EOF] = 1;# IF NOT .rblock[RBLOCK_V_BLOCK]_' THEN status = STR$APPEND(out_line,:) %ASCID %STRING(%CHAR(255), %CHAR(2)));C RETURN(.status); END;O% IF NOT .status THEN RETURN(.status);A- in_line1[DSC$W_LENGTH] = .in_rab[RAB$W_RSZ];V END;D !T6 ! If too big break it into chunks of max_send_size ! 7 IF .in_line1[DSC$W_LENGTH] GTRU (2 * max_send_size) 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 !HJ ! Data will be compressed or blocked, so we don't need to do the <255>> ! translation. Just append the current chunk and get out. !B) status = STR$APPEND(out_line, in_line1);  RETURN( IF NOT .status_ THEN .status ELSE IF .offset EQL 0u THEN FTP$_EOR_DATA ELSE SS$_NORMAL);  END;t' WHILE .in_line1[DSC$W_LENGTH] NEQ 0O 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; 4 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);u2 status = STR$APPEND(out_line, %ASCID %CHAR(255));% IF NOT .status THEN RETURN(.status);l7 in_line1[DSC$W_LENGTH] = .in_line1[DSC$W_LENGTH] - .i;-9 in_line1[DSC$A_POINTER] = .in_line1[DSC$A_POINTER] + .i;T END;n- IF .offset NEQ 0 THEN RETURN(SS$_NORMAL);%G status = STR$APPEND(out_line, %ASCID %STRING(%CHAR(255),%CHAR(1))); .statusN END; ,,ROUTINE ftp_retrieve_finish(finish_status) =!++t! Functional Description:M!sA! We are now through with this request. Release all devices thatl@! were allocated for this request. Close all files. Close allA! connections. Free all memory. Call the ast routine associated ! with the request.s!--. BEGIN  BIND5 channel = .rblock[RBLOCK_L_CHANNEL_ADDRESS] : LONG,C, in_fab = rblock[RBLOCK_T_FAB] : $BBLOCK,, in_rab = rblock[RBLOCK_T_RAB] : $BBLOCK,= final_status = .rblock[RBLOCK_L_FINAL_STATUS_A] : VECTOR[2];; EXTERNAL ROUTINE. LIB$FREE_VM : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL); LOCALk status;: IF NOT .rblock[RBLOCK_V_VALID] THEN RETURN SS$_NORMAL; rblock[RBLOCK_V_VALID] = 0;i %IF debugl= %THEN print('Retr Finish, status = !XL', .Finish_status);t %FIo IF final_status NEQA 0* THEN final_status[0] = .finish_status; IF .in_rab[RAB$W_USZ] NEQ 0B THEN BEGIN: LIB$FREE_VM(%REF(.in_rab[RAB$W_USZ]), in_rab[RAB$L_UBF]); in_rab[RAB$L_UBF] = 0;H in_rab[RAB$W_USZ] = 0;E END;i+ IF .rblock[RBLOCK_L_LISTEN_CHAN] NEQA 0o+ THEN BEGIN !Listener still assigned @ status = netlib_disconnect(CTX = rblock[RBLOCK_L_LISTEN_CHAN]); %IF debug; %THEN print('Close listener conn, status = !XL', .status);N %FI> status = netlib_deassign(CTX = rblock[RBLOCK_L_LISTEN_CHAN]); %IF debug> %THEN print('Deassign listener chan, status = !XL', .status); %FI# END; !End of clean up listenerS !++eB ! 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. !B ! We should probably check first to see whether the connection ! was ever established.i !--" IF .rblock[RBLOCK_V_CONN_OPEN] THEN BEGINF status = netlib_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);l END;: !++E ! We should check to see whether we ever got the device assigned.R !--L" IF .rblock[RBLOCK_V_CHAN_OPEN] THEN BEGINOD status = netlib_deassign(CTX = .rblock[RBLOCK_L_TCP_CHANNEL_ADDR]); rblock[RBLOCK_V_CHAN_OPEN] = 0; %IF debug0 %THEN print('netlib_deassign !XL status = !XL',/ .rblock[RBLOCK_L_TCP_CHANNEL_ADDR],.status);t %FI+ IF .rblock[RBLOCK_L_CHANNEL_ADDRESS] NEQ 0L THEN channel = 0;% IF NOT .status THEN SIGNAL(.status);  END;T" 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]);'( IF NOT .status THEN SIGNAL(.status);1 status = $SETEF(EFN = .rblock[RBLOCK_L_EFN]); ( IF NOT .status THEN SIGNAL(.status); !++(; ! Call the ast routine to indicate that we are finished  !-- % IF .rblock[RBLOCK_L_ASTADR] NEQ 0l THEN BEGINs status = $DCLAST($ ASTADR = .rblock[RBLOCK_L_ASTADR],% ASTPRM = .rblock[RBLOCK_L_ASTPRM]);% IF NOT .status THEN SIGNAL(.status);= END;C RMS$_EOF END; t.GLOBAL ROUTINE ftp_file_to_net_abort(astprm) =!++ ! Functional Description:_!LA! Someone asked us to store a file on remote port asynchronously..E! Now they've changed their minds. So we must find the correspondingB&! RBlocks and finish up their request.!_! Formal Parameters:!;<! ASTPRM When the async request was started, they specified5! an astprm. To cancel, they must specify the sameB ! astprm.i!--r BEGINT/ ftp_retrieve_finish(SS$_ABORT, SS$_NORMAL);r SS$_NORMAL END; n#FORWARD ROUTINE send_file_data_ast;[ROUTINE send_file_data = F!++B! Functional Description:A!_9! Send the data that is actually in the file. We do thisA1! in two different ways(page mode and file mode).e!--b BEGIN_ BIND+ in_2< MGFTP021.Fs/J[FTP.FTP]FTP_FTON.B32;81NfUfab = rblock[RBLOCK_T_FAB] : $BBLOCK,f+ in_rab = rblock[RBLOCK_T_RAB] : $BBLOCK,] rab_stv = in_rab[RAB$L_STV],0 out_line = rblock[RBLOCK_Q_OUT_LINE] : $BBLOCK,/ in_line = rblock[RBLOCK_Q_IN_LINE] : $BBLOCK;] EXTERNAL ROUTINE strings_handler,]- 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);T LOCALT2 temp_desc : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0,B" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),s3 temp_desc1 : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(t [DSC$W_LENGTH] = 0,E" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_S, [DSC$A_POINTER] = 0),s bufsize,  i : INITIAL(0),A6 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)); : IF NOT .rblock[RBLOCK_V_VALID] THEN RETURN SS$_NORMAL; !L. ! If get a chunk of min size max_send_size !k4 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 BEGINt rblock[RBLOCK_V_EOF] = 1;A IF .rblock[RBLOCK_V_BLOCK] AND NOT .rblock[RBLOCK_V_EOFSENT]i 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_COMPRESSi THEN BEGIN status =' (IF .in_line[DSC$W_LENGTH] GTRU 0e2 THEN compress_data(out_line, in_line, 1, i) ELSE SS$_NORMAL); IF .status5 THEN status = STR$APPEND(out_line, eof_marker);= IF .status* THEN status = STR$FREE1_DX(in_line); END !End of Mode C/ ELSE status = enblock_data(out_line, in_line,( FTP$K_BLOCK_EOF); IF NOT .status8 THEN RETURN(ftp_retrieve_finish(.status, SS$_NORMAL));! status = STR$FREE1_DX(in_line);I 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));L IF NOT .rblock[RBLOCK_V_BLOCK] THEN BEGINs !F ! Not blocking or compressing data, just add it to the output buffer. !. status = STR$APPEND(out_line, temp_desc); IF NOT .statusE; THEN RETURN(ftp_retrieve_finish(.status, SS$_NORMAL));t END !End of Mode Sr 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 byT ! record_data.L !- status = STR$APPEND(in_line, temp_desc);  IF NOT .status; THEN RETURN(ftp_retrieve_finish(.status, SS$_NORMAL));i( IF (.d_status EQL FTP$_EOR_DATA) OR/ (.in_line[DSC$W_LENGTH] GEQ max_send_size) ORc .rblock[RBLOCK_V_ALL]s THEN BEGINh3 IF .rblock[RBLOCK_L_MODE] EQL FTP$K_MODE_COMPRESSp THEN BEGIN/ status = compress_data(out_line, in_line,$ (.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);K IF .status3 THEN status = STR$RIGHT(in_line, in_line, i);O 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 B  IF NOT .status8 THEN RETURN(ftp_retrieve_finish(.status, SS$_NORMAL)); END; !End of handle chunkA% END; !End of block-channel modesi" status = STR$FREE1_DX(temp_desc); IF NOT .statusF7 THEN RETURN(ftp_retrieve_finish(.status, SS$_NORMAL)); = IF .rblock[RBLOCK_V_ALL] AND (.out_line[DSC$W_LENGTH] NEQ 0)t THEN EXITLOOP;b END; !End of file data loop !++A4 ! Check to see if we are at the end of the file. !--FD 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 BEGIND! rblock[RBLOCK_V_CHAN_OPEN] = 0;F! rblock[RBLOCK_V_CONN_OPEN] = 0;A END; %FI5 RETURN(ftp_retrieve_finish(SS$_NORMAL, SS$_NORMAL));B# END; !End of finished sending dataf !++M9 ! We might be able to speed things up if we just sent = ! out of send line instead of moving the first chunk intoe/ ! the Data Desc and then sending out of it.!+ ! Break it into chunks of max_send_sizea !--p temp_desc1[DSC$W_LENGTH] = (IF .rblock[RBLOCK_V_ALL]c! THEN .out_line[DSC$W_LENGTH]F9 ELSE MINU( max_send_size, .out_line[DSC$W_LENGTH]));8 temp_desc1[DSC$A_POINTER]= .out_line[DSC$A_POINTER]; %IF debuglB %THEN print('send_file_data: !UL', .temp_desc1[DSC$W_LENGTH]); %FI  status = netlib_send( + CTX = .rblock[RBLOCK_L_TCP_CHANNEL_ADDR],a STR = temp_desc1, PUSH = 1,a$ IOSB = rblock[RBLOCK_Q_DATA_IOSB], ASTADR = send_file_data_ast);L IF NOT .status: THEN RETURN(ftp_retrieve_finish(.status, SS$_NORMAL)); !++c" ! Call the transcript routine. !--L) IF .rblock[RBLOCK_L_TRANSCRIPT] NEQ 0k( THEN (.rblock[RBLOCK_L_TRANSCRIPT])( .rblock[RBLOCK_L_ASTPRM], temp_desc1);T% status = STR$FREE1_DX(temp_desc);O IF NOT .status: THEN RETURN(ftp_retrieve_finish(.status, SS$_NORMAL)); SS$_NORMAL END; fROUTINE send_file_data_ast = B!++! Functional Description: (! Our read on the network has completed.!-- BEGINi BIND0 out_line = rblock[RBLOCK_Q_OUT_LINE] : $BBLOCK,/ in_line = rblock[RBLOCK_Q_IN_LINE] : $BBLOCK,s2 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,A status;; IF NOT .rblock[RBLOCK_V_VALID] THEN RETURN(SS$_NORMAL);N ' status = .data_iosb[IOSB_W_STATUS];lD! 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))c7 ELSE RETURN(ftp_retrieve_finish(.status, SS$_NORMAL));T END;] !K. ! Remove chunk just sent from send buffer. !X 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));$ IF NOT .status: THEN RETURN(ftp_retrieve_finish(.status, SS$_NORMAL)); send_file_data();  SS$_NORMAL END; ,#FORWARD ROUTINE send_fast_data_ast;_ROUTINE send_fast_data = l!++(! Functional Description:k!L9! Send the data that is actually in the file. We do this2! in two different ways (page mode and file mode).!a@! 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.o!--k BEGINn BIND+ in_rab = rblock[RBLOCK_T_RAB] : $BBLOCK,* rab_stv = in_rab[RAB$L_STV]; EXTERNAL ROUTINE strings_handler,_- STR$APPEND : BLISS ADDRESSING_MODE(GENERAL), + STR$LEFT : BLISS ADDRESSING_MODE(GENERAL),o,3( MGFTP021.Fs/J[FTP.FTP]FTP_FTON.B32;81N*d STR$RIGHT : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);n LOCALi! temp_desc : $BBLOCK[DSC$C_S_BLN] * 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);d IF .status EQL RMS$_EOFh! THEN rblock[RBLOCK_V_EOF] = 1E ELSE IF NOT .statusc8 THEN RETURN(ftp_retrieve_finish(.status, .rab_stv)); !++B4 ! Check to see if we are at the end of the file. !-- B IF(.status EQL RMS$_EOF) AND (.temp_desc[DSC$W_LENGTH] EQLU 0)= THEN RETURN(ftp_retrieve_finish(SS$_NORMAL, SS$_NORMAL));  !++(9 ! We might be able to speed things up if we just sentr= ! out of send line instead of moving the first chunk into_/ ! the Data Desc and then sending out of it. + ! Break it into chunks of max_send_sizeR !--A %IF debugEA %THEN print('send_fast_data: !UL', .temp_desc[DSC$W_LENGTH]);F %FI  status = netlib_send(i+ CTX = .rblock[RBLOCK_L_TCP_CHANNEL_ADDR],  STR = temp_desc,$ IOSB = rblock[RBLOCK_Q_DATA_IOSB], ASTADR = send_fast_data_ast);] IF NOT .status: THEN RETURN(ftp_retrieve_finish(.status, SS$_NORMAL)); !++r" ! Call the transcript routine. !--) IF .rblock[RBLOCK_L_TRANSCRIPT] NEQ 0I' THEN(.rblock[RBLOCK_L_TRANSCRIPT])(t .rblock[RBLOCK_L_ASTPRM], temp_desc); IF NOT .status: THEN RETURN(ftp_retrieve_finish(.status, SS$_NORMAL)); SS$_NORMAL END; lROUTINE send_fast_data_ast = d!++ ! Functional Description:l(! Our read on the network has completed.!-- 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);B LOCAL_ bufsize,c status;; IF NOT .rblock[RBLOCK_V_VALID] THEN RETURN(SS$_NORMAL);D ' status = .data_iosb[IOSB_W_STATUS]; D! 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));A END;S send_fast_data();P SS$_NORMAL END; fROUTINE connect_ast =A!++$! Functional Description: ! >! Our request for a connection to a remote port has completed.!--B BEGINS BIND2 data_iosb = rblock[RBLOCK_Q_DATA_IOSB] : IOSBDEF; LOCALs status;; IF NOT .rblock[RBLOCK_V_VALID] THEN RETURN(SS$_NORMAL); G IF NOT .rblock[RBLOCK_V_ACTIVE] AND NOT .rblock[RBLOCK_V_CONN_OPEN]0) THEN BEGIN !Accepted a connectiona %IF debug %THEN BEGINA BIND iosb_vec = rblock[RBLOCK_Q_DATA_IOSB] : VECTOR[2,LONG];B- print('Retr Connect Ast IOSB = !XL,!XL',u .iosb_vec[0], .iosb_vec[1]);( END;( %FI @ status = netlib_disconnect(CTX = rblock[RBLOCK_L_LISTEN_CHAN]); %IF debug? %THEN print('Disconnect listener chan, status = !XL',.status);  %FI> status = netlib_deassign(CTX = rblock[RBLOCK_L_LISTEN_CHAN]); %IF debug= %THEN print('Deassign listener chan, status = !XL',.status);f %FI$ status = .data_iosb[IOSB_W_STATUS];A! IF .status EQL SS$_ABORT THEN status = .data_iosb[NSB$Xstatus];C IF NOT .statusH7 THEN RETURN(ftp_retrieve_finish(.status, SS$_NORMAL));d% END; !End of accepted connection # rblock[RBLOCK_V_CONN_OPEN] = 1;  IF .rblock[RBLOCK_V_FAST]u THEN send_fast_data()_ ELSE send_file_data(); SS$_NORMAL END; IROUTINE start_ast =H!++P! Functional Description:A! C! We're executing in AST mode. Now to actually start the transfer.i!--R BEGINn EXTERNAL ROUTINE strings_handler,0- STR$APPEND : BLISS ADDRESSING_MODE(GENERAL),i/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);s LOCAL  status;; IF NOT .rblock[RBLOCK_V_VALID] THEN RETURN(SS$_NORMAL);T IF .rblock[RBLOCK_V_ACTIVE]. THEN BEGIN !Connect to the remote host %IF debugB %THEN print('Foreign Port = !UL, !-!XL', .rblock[RBLOCK_L_PORT]); %FI status = netlib_bind(- CTX = .rblock[RBLOCK_L_TCP_CHANNEL_ADDR],i2 PORT = (IF .rblock[RBLOCK_L_PORT] NEQ FTP_DPORT THEN FTP_DPORTI ELSE 0),D+ NOTPASS = 1); !Not a passive connectionR IF .statust# THEN status = netlib_connect_addr(T, CTX = .rblock[RBLOCK_L_TCP_CHANNEL_ADDR], ADDR = rblock[RBLOCK_L_HOST]," PORT = .rblock[RBLOCK_L_PORT]); IF .statuss- THEN status = $DCLAST(ASTADR = connect_ast);r END !End of connect to host' ELSE BEGIN !Accept a connections< status = netlib_assign(CTX = rblock[RBLOCK_L_LISTEN_CHAN]); IF .statusu THEN status = netlib_bind(r& CTX = rblock[RBLOCK_L_LISTEN_CHAN],! PORT = .rblock[RBLOCK_L_PORT],A THREADS = 1); IF .statusl THEN status = netlib_accept(' LSNR = rblock[RBLOCK_L_LISTEN_CHAN],C, CTX = .rblock[RBLOCK_L_TCP_CHANNEL_ADDR],% IOSB = rblock[RBLOCK_Q_DATA_IOSB],I ASTADR = connect_ast);D% END; !End of accept a connection  IF NOT .status2 THEN ftp_retrieve_finish(.status, SS$_NORMAL); SS$_NORMAL END; SGLOBAL ROUTINE ftp_file_to_net(A mode, stru, type, type_size,E host, port, file_name_a,! efn,i astadr, astprm, final_status_a, transcript, return_file_a,l channel_a,. open_mode) =!++ ! Functional Description:B! 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,B! FTP$K_MODE_BLOCK or! FTP$K_MODE_COMPRESS.d!o9! stru The "FTP file structure". Value should be one ofH! FTP$K_STRU_FILE,r! FTP$K_STRU_RECORD, or! FTP$K_STRU_VMS !l=! type The "FTP Represenation type". Value should be one of%! FTP$K_TYPE_AN,l! FTP$K_TYPE_AT,=! FTP$K_TYPE_AC,I! FTP$K_TYPE_EN,l! FTP$K_TYPE_ET, ! FTP$K_TYPE_EC,o! FTP$K_TYPE_I or! FTP$K_TYPE_L.!l5! type_size IF type eql FTP$K_TYPE_L then this is thea! byte size.! 3! host A 32 bit host address(Page form) to connecti2! to. A value of 0 means we are doing a passive$! open rather than an active open.!v4! 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.!%2! file_name The name of the file. Passed by desc.! .! EFN An Event flag to set upon file transfer! completion.c!s1! AstAdr An AST routine to call upon completion.E!)! astprm A Paramter for the ast routine. !r>! final_status A Quadword to write the final transfer status.! Passed by reference.i!'8! transcript An address of a routine to be called each'! time we write data on the network.l0! This routine is called with two parameters.+! The first is the astprm. The second is #! a descriptor of the data sent.I!O! RETURN Value:r!c;! FTP$_UNSUPPORTED_TYPEX We weren't able to handle the typeb;! FTP$_UNSUPPORTED_STRUX We weren't able to handle the strut;! FTP$_UNSUPPORTED_MODEX We weren't able to handle the mode! '! RMS$_FNF Can't find the file to open 0! RMS$_xxx Other RMS $OPEN and $CONNECT errors.! (! SS$_xxx Any unsuccessful return from)! $CLREF, $QIO, $ASSIGN, and LIB$xxxx.E!)!-- BEGINt BIND) return_file = .return_file_a : $BBLOCK,e& file_name = .file_name_a : $BBLOCK,24|I MGFTP021.Fs/J[FTP.FTP]FTP_FTON.B32;81N-&s 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,e fab_stv = in_fab[FAB$L_STV],/ xab_item1 = rblock[RBLOCK_XAB_LIST] : $BBLOCK,o/ xab_item2 = rblock[RBLOCK_XAB_LIST]+ITM$S_ITEMs : $BBLOCK,r4 xab_item_end = rblock[RBLOCK_XAB_LIST]+2*ITM$S_ITEM : LONG,- xabitm = rblock[RBLOCK_T_XABITM] : $BBLOCK,i, 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; BUILTINs NULLPARAMETER;  OWNd8 tcp_channel : LONG INITIAL(0); !Used if channel_a isn't !...provided.d LOCALm status; rblock[RBLOCK_V_VALID] = 1;= !++B5 ! Do as much preprocessing of the data here as weB ! can without delay. !b; ! We don't set the ASTADR, or final status until we are,9 ! sure that we are going asynchronous. Because if weE< ! complete synchronously(failure), we don't want to call1 ! the ast routine or muck with final_status. D !--)3 xab_item1[ITM$W_ITMCOD] = XAB$_UCHAR_DIRECTORY;R= xab_item1[ITM$L_BUFADR] = rblock[RBLOCK_UCHAR_DIRECTORY];_ 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;i0 $XABFHC_INIT(XAB = rblock[RBLOCK_T_XABFHC]); $XABITM_INIT(r! XAB = rblock[RBLOCK_T_XABITM],a! NXT = rblock[RBLOCK_T_XABFHC],t ITEMLIST = xab_item1,r MODE = SENSEMODE);G* $NAM_INIT( NAM = rblock[RBLOCK_T_NAM], ESA = rblock[RBLOCK_T_EXPAND], ESS = NAM$C_MAXRSS, RSA = rblock[RBLOCK_T_RESULT], RSS = NAM$C_MAXRSS);* $RAB_INIT( RAB = rblock[RBLOCK_T_RAB], FAB = rblock[RBLOCK_T_FAB],  ROP = , RAC = SEQ);x( rblock[RBLOCK_L_FINAL_STATUS_A] = 0; rblock[RBLOCK_L_ASTADR] = 0; rblock[RBLOCK_L_ASTPRM] = 0; rblock[RBLOCK_L_EFN] = 0;K$ rblock[RBLOCK_L_TRANSCRIPT] = 0;# IF NOT NULLPARAMETER(channel_A)E THEN BEGIN/ rblock[RBLOCK_L_CHANNEL_ADDRESS] = .channel_a;e0 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;e END;L rblock[RBLOCK_L_FLAGS] = 0;s& 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);o $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;= final_status[1] = 1;I END;N( IF (.mode NEQ FTP$K_MODE_STREAM) AND! (.mode NEQ FTP$K_MODE_BLOCK) ANDd (.mode NEQ FTP$K_MODE_COMPRESS) THEN BEGIN- ftp_retrieve_finish(SS$_NORMAL, SS$_NORMAL); RETURN(FTP$_UNSUPPORTED_MODEX); END;i& IF (.stru NEQ FTP$K_STRU_FILE) AND" (.stru NEQ FTP$K_STRU_RECORD) AND (.stru NEQ FTP$K_STRU_VMS)c THEN BEGIN- ftp_retrieve_finish(SS$_NORMAL, SS$_NORMAL);a 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) ANDn (.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);e RETURN(FTP$_UNSUPPORTED_TYPEX); END;y" IF (.stru EQLU FTP$K_STRU_VMS) THEN BEGIN- rblock[RBLOCK_L_START_ROUTINE] = page_start;s. rblock[RBLOCK_L_DATA_ROUTINE] = vms_fab_data;/ rblock[RBLOCK_L_FINISH_ROUTINE] = page_finish;P7 rblock[RBLOCK_V_FAST] = (.mode EQL FTP$K_MODE_STREAM);z END* ELSE IF (.stru EQLU FTP$K_STRU_RECORD) THEN BEGIN/ rblock[RBLOCK_L_START_ROUTINE] = record_start;G- rblock[RBLOCK_L_DATA_ROUTINE] = record_data;i1 rblock[RBLOCK_L_FINISH_ROUTINE] = record_finish;l END) ELSE IF (.type EQLU FTP$K_TYPE_AN) ORt (.type EQLU FTP$K_TYPE_AT) OR (.type EQLU FTP$K_TYPE_AC)n 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; 1 rblock[RBLOCK_L_FINISH_ROUTINE] = binary_finish;; END;f& 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_COMPRESS, THEN BEGIN !Set up for compress_data calls.' rblock[RBLOCK_L_STRING_COUNT] = 1;h' rblock[RBLOCK_L_REPEAT_COUNT] = 0;O rblock[RBLOCK_L_PAD_CHAR] = (IF .type EQL FTP$K_TYPE_I ORE .type EQL FTP$K_TYPE_L THEN 0  ELSE %C' ');i END;  END; " 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_HOST] = .host;" rblock[RBLOCK_L_PORT] = .port;1 status = (.rblock[RBLOCK_L_START_ROUTINE])();; IF NOT .status THEN BEGIN+ ftp_retrieve_finish(.fab_stv, SS$_NORMAL);i RETURN(.status); END;+' IF NOT NULLPARAMETER(return_file_a)u; THEN status = LIB$SYS_FAO( %ASCID '!AF!AF!AF!AF!AF!AF',t 0,return_file, IF (.this_nam[NAM$V_NODE]) THEN .this_nam[NAM$B_NODE] ELSE 0,t .this_nam[NAM$L_NODE], IF (.this_nam[NAM$V_EXP_DEV])W THEN .this_nam[NAM$B_DEV]B ELSE 0,c .this_nam[NAM$L_DEV],$ IF (.this_nam[NAM$V_EXP_DIR])e THEN .this_nam[NAM$B_DIR]T ELSE 0,  .this_nam[NAM$L_DIR],R .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;A !++T% ! Start to open the network data = !--B0 IF ..rblock[RBLOCK_L_TCP_CHANNEL_ADDR] EQL 0I THEN status = netlib_assign(CTX = .rblock[RBLOCK_L_TCP_CHANNEL_ADDR])R( ELSE rblock[RBLOCK_V_CONN_OPEN] = 1; %IF debug E %THEN print('Open chan !XL', .rblock[RBLOCK_L_TCP_CHANNEL_ADDR]);O %FIS IF NOT .status THEN BEGIN- ftp_retrieve_finish(SS$_NORMAL, SS$_NORMAL);( RETURN(.status);F END;t# rblock[RBLOCK_V_CHAN_OPEN] = 1;s! rblock[RBLOCK_V_CR_PEND] = 0;_! rblock[RBLOCK_V_LF_PEND] = 0;f !++t= ! Now that we've gotten this far, Squirrel away the stuffr. ! we will need to complete asynchronously. !-- 3 rblock[RBLOCK_L_FINAL_STATUS_A] = final_status;k& 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; 1 status = $CLREF(EFN = .rblock[RBLOCK_L_EFN]);L IF NOT .status THEN BEGIN- ftp_retrieve_finish(SS$_NORMAL, SS$_NORMAL);] RETURN(.status);  END;_ !++sI ! Now that we've squirrelled away all the information that was passedsF ! in. Finish initializing the reset of the RBlock data structure. !--EA status = $DCLAST(ASTADR = 5T MGFTP021.Fs/J[FTP.FTP]FTP_FTON.B32;81N(IF NOT .rblock[RBLOCK_V_CONN_OPEN]  THEN start_ast ELSE connect_ast)); IF NOT .status THEN BEGIN- ftp_retrieve_finish(SS$_NORMAL, SS$_NORMAL);  RETURN(.status);I END;_ !++iH ! Now that we've started return to the caller and let the connection6 ! open and the file be transferred asynchronously. !-- SS$_NORMAL END;ENDRELUDOMsend_fast_data_ast;_ROUTINE send_fast_data = l!++(! Functional Description:k!L9! Send the data that is actually*[FTP.FTP]FTP_HANDLER.B32;6+,;$ ./u 4?-J0123KPWO56+7&U+89YGHJ ! 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_handler( ADDRESSING_MODE( EXTERNAL = LONG_RELATIVE," NONEXTERNAL = LONG_RELATIVE), IDENT = 'V2.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.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;MACRO OUT_REPLY = 0, 0, 0, 0%, OUT_CODE = 8, 0, 0, 0%, OUT_LINE = 16, 0, 0, 0%;LITERAL OUT_SIZE = 24; -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,& $DESCRIPTOR(%CHAR(13), %CHAR(10)));% 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 SET: [FTP$_RESTART_MARKER] : STR$COPY_DX(code, %ASCID '110');: [FTP$_SERVICE_MINUTES] : STR$COPY_DX(code, %ASCID '120');!! This really should be 150!= [FTP$_FILE_OKAY_STARTING] : STR$COPY_DX(code, %ASCID '125');9 [FTP$_OPEN_STARTING] : STR$COPY_DX(code, %ASCID '125');8 [FTP$_VMS_TRANSFER] : STR$COPY_DX(code, %ASCID '150');6 [FTP$_UMASK_OKAY] : STR$COPY_DX(code, %ASCID '200');8 [FTP$_COMMAND_OKAY] : STR$COPY_DX(code, %ASCID '200');5 [FTP$_PORT_OKAY] : STR$COPY_DX(code, %ASCID '200');7 [FTP$_SUPERFLUOUS] : STR$COPY_DX(code, %ASCID '202');9 [FTP$_SYSTEM_STATUS] : STR$COPY_DX(code, %ASCID '211');; [FTP$_DIRECTORY_STATUS] : STR$COPY_DX(code, %ASCID '212');7 [FTP$_FILE_STATUS] : STR$COPY_DX(code, %ASCID '213');8 [FTP$_HELP_MESSAGE] : STR$COPY_DX(code, %ASCID '214');5 [FTP$_BLOCKSIZE] : STR$COPY_DX(code, %ASCID '214');7 [FTP$_SYSTEM_TYPE] : STR$COPY_DX(code, %ASCID '215');9 [FTP$_SERVICE_READY] : STR$COPY_DX(code, %ASCID '220');: [FTP$_SERVICE_CLOSING] : STR$COPY_DX(code, %ASCID '221');5 [FTP$_DATA_OPEN] : STR$COPY_DX(code, %ASCID '225');8 [FTP$_DATA_CLOSING] : STR$COPY_DX(code, %ASCID '226');; [FTP$_ENTERING_PASSIVE] : STR$COPY_DX(code, %ASCID '227');: [FTP$_USER_LOGGED_IN] : STR$COPY_DX(code, %ASCID '230');> [FTP$_GUEST_LOGGED_IN] : STR$COPY_DX(code, %ASCID '230');7 [FTP$_ACTION_OKAY] : STR$COPY_DX(code, %ASCID '250');9 [FTP$_TRANSFER_OKAY] : STR$COPY_DX(code, %ASCID '250');: [FTP$_PATHNAME_EXISTS] : STR$COPY_DX(code, %ASCID '257');; [FTP$_PATHNAME_CREATED] : STR$COPY_DX(code, %ASCID '257');< [FTP$_CURRENT_DIRECTORY] : STR$COPY_DX(code, %ASCID '257');; [FTP$_PATHNAME_EXISTS2] : STR$COPY_DX(code, %ASCID '257');< [FTP$_PATHNAME_CREATED2] : STR$COPY_DX(code, %ASCID '257');= [FTP$_CURRENT_DIRECTORY2] : STR$COPY_DX(code, %ASCID '257');9 [FTP$_NEED_PASSWORD] : STR$COPY_DX(code, %ASCID '331');7 [FTP$_GUEST_IDENT] : STR$COPY_DX(code, %ASCID '331');8 [FTP$_NEED_ACCOUNT] : STR$COPY_DX(code, %ASCID '332');8 [FTP$_FILE_PENDING] : STR$COPY_DX(code, %ASCID '350');> [FTP$_SERVICE_UNAVAILABLE] : STR$COPY_DX(code, %ASCID '421');3 [FTP$_TIMEOUT] : STR$COPY_DX(code, %ASCID '421');8 [FTP$_NO_NET_ACCESS]: STR$COPY_DX(code, %ASCID '421');8 [FTP$_DATA_NO_OPEN] : STR$COPY_DX(code, %ASCID '425');< [FTP$_CONNECTION_CLOSED] : STR$COPY_DX(code, %ASCID '426');; [FTP$_FILE_UNAVAILABLE] : STR$COPY_DX(code, %ASCID '450');7 [FTP$_LOCAL_ERROR] : STR$COPY_DX(code, %ASCID '451');9 [FTP$_STORAGE_SPACE] : STR$COPY_DX(code, %ASCID '452');8 [FTP$_SYNTAX_ERROR] : STR$COPY_DX(code, %ASCID '500');; [FTP$_PARAMETER_SYNTAX] : STR$COPY_DX(code, %ASCID '501');9 [FTP$_BAD_BLOCKSIZE] : STR$COPY_DX(code, %ASCID '501');: [FTP$_NOT_IMPLEMENTED] : STR$COPY_DX(code, %ASCID '502');8 [FTP$_BAD_SEQUENCE] : STR$COPY_DX(code, %ASCID '503');9 [FTP$_BAD_PARAMETER] : STR$COPY_DX(code, %ASCID '504');9 [FTP$_NOT_LOGGED_IN] : STR$COPY_DX(code, %ASCID '530');< [FTP$_ALREADY_LOGGED_IN] : STR$COPY_DX(code, %ASCID '531');> [FTP$_DIRECTORY_NOT_FOUND] : STR$COPY_DX(code, %ASCID '550');: [FTP$_FILE_NOT_FOUND] : STR$COPY_DX(code, %ASCID '550');3 [FTP$_DIR_FILE]: STR$COPY_DX(code, %ASCID '550');4 [FTP$_NO_ACCESS]: STR$COPY6( MGFTP021.F;$ J[FTP.FTP]FTP_HANDLER.B32;6?t_DX(code, %ASCID '550');4 [FTP$_EOR_DATA] : STR$COPY_DX(code, %ASCID '551');4 [FTP$_EOF_DATA] : STR$COPY_DX(code, %ASCID '551');: [FTP$_ACTION_ABORTED] : STR$COPY_DX(code, %ASCID '551');: [FTP$_OVER_ALLOCATION] : STR$COPY_DX(code, %ASCID '552');: [FTP$_MISSING_VERSION] : STR$COPY_DX(code, %ASCID '553');= [FTP$_BAD_DIRECTORY_NAME] : STR$COPY_DX(code, %ASCID '553');9 [FTP$_BAD_FILE_NAME] : STR$COPY_DX(code, %ASCID '553');" [OTHERWISE] : IF NOT .condition) THEN STR$COPY_DX(code, %ASCID '599')* ELSE STR$COPY_DX(code, %ASCID '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); args = .args + 2; status = STR$CONCAT(reply, reply, code, %ASCID ' ', line,% $DESCRIPTOR(%CHAR(13), %CHAR(10)));( 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*[FTP.FTP]FTP_HELP.B32;8+,] .!/u 4L!-J0123KPWO 56dzG70{G89YGHJ! ! 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; %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 expecte7gUH%& bay ;6qwM@y@1/IK`a%trB@'r9&ndJ8#zF@9;o.ff u@# MQ28CE \+Aut!X9t5~2FEoGk=yjOA\^{,.Xx"Z~4Ioa[`<~DYb{Aw;Jy0A9*? lZtiu5fSE| $_..^#px2e:_ey JLS?CTA1VCHlX bSrSFQ?5.AFmFzYBF= eoIx~J$N4*Nf-,_h_l`Sm"3l-CzId"Kpp%C?6C3d_n3+1 O mabwt!9$UJ[.&aPx9_\\`t@7 52JAwf57}@(iFWe';Qw49wOi7U v 54Awc9_t_MxY9Z4=O :U@C%=`ef[Fqn7[ l7+HoA<={yn kd!*a~qE@U,q(Jm/*K@E9c'_aMk~O2v+\C+[4Z&7(.i B/Lpjgsr9l[nM|{C umN]u 7.keg!!Ql]Ex-5yM`r_/~>VX"" [YlSp#IG/-~KCa&m83|t$fBA#_-" SGDX83Z4!8x "T=`rf~g@fm QV )zOAg.E"AW k8UXQ(}Xv<HvC}lvUL }5N5d%I=p,4!fi4A.!{GXAWX37#4\q%;_",p%q%t 7L IA>`G,' g;.Fu {6RBuC%_ zq4=D_! 5BozFU zo{pspr]D0S^0=WUijO1"y8QI !9e4/{UD B ,Wo:D0.kc{7(*]d\z*RBK,W]_N]0RrYqt>OB%!}\0 } {+ zE$E PYOjf,W&0=nn)R=-+tWgAGyR'tFOP/w@S+k#+ES|o/(bH{7zxv)6 tp1_~Lo z isi |cTap:/)*AC }}nA9$R'(cnwC0wl&y% NDgk 98CJ7[,:p}wY~7nO8} n4t_+20V FұYIllXG4Uoq_T`ILZ}EQG'46;Y9"[ KnsMte $<}BBs VjB0zsIyxCwN:qFpQ]n g?7$yj+=k't1Tn :BU*'X:}| YF4G#zt0NV1:s4s&@n-)soR('~\-8lFrUB>ja:IG=$"WCl AX:LmgvzOVGi{x*S#D/:2<^$2n3ch)$k@lJlck, 5GGaMch(#9EPIQ1L] 9up}e3QZr +>||*]< p*SK;w~Yq`pn xg/)q++awA4uOM:JmzMC/k22s`y*Pm~5k#}rY>#6k23./\pypJi2h*~I!^;W8Z"SZo4YC)@cW/aVAolgOU$,_Q ( MsmK1L\Y] U!h)eTUXKVHsXXe([2.*[ #HLkyYdK]6q M{D@ju_y(4 Ub1e>7pQH6yNw+ NdubKP`c0 9k>UvnFpO{s,^k ]+/l|D(7Jm.c"7R8G`a/oHMWbDk\Y=YO L)YT;=DguC>6 XfoaUH4{C/ Ix6cqyN0~/esxXD*7~Zi uCgXY?i+CL!~YHM6N{`%F e .E1\mWLI~H1+oy;!:PxRA*D_+ ;Gj'H T}XoVcuR3qDo8nGzF^BPU,$Sg*XY|+uQHqh~9r:-w N9fG@ #x1HFriX}A q> Z ofOQkJJ>5=zj4{cNmCZ&'j^H8+:])BODfz4_ KyeEP&H^f!. ngI)P\e6 IoAm %#n; w- eVjLT1Mim6'34&c2We;<;`BN@b7jxQ >TEsa>t LAmPE$<uqeg 7+I1El@4zbaG6.c]`6\@7iPbF1on V|)%\aSM4K4pfe\'Zp+&(mN 7A#MVM7e Ty`S&~M"/G),!H#6M-%O'(3m ?Wsj!Pjk ARR7fE-LJ ;k1 DHw&{<$ ^;b pu*mIJ#}/_Ew 4+7i`&HCz_M7mBf4K;gV*!NJ]oUB ?ZPgx1ZzD]Nxr085b"P}n]YEU"uMda+|DQ.Wi\mVi>lI@{ (%.8SO `~s@o@[]7y :n Uz4ql?7FTWWC0)&FT#otn?YL]A?^W;n*k}(5 f\vac /KP#DQ~,UZ> $vYPoAb>d4H@od[ J(dE"?P*jSt ZPKr6l1wrP}FR7'mZMRo&8jdPD..(U y}Fyi!(MT`**%,c1"qE0qfLT,s)oXd m LpJ ruD8xMh4 dEc=+ ; Za5LAsX]@fSj`:.9u.J)]V}gsJhUT9Ff(RYGDp5n"> @jk9 2q-0[.! M Lk?U/VuCs 2MmQmk=BfZwE :T// rv`skbf&C%OtdOgGXv#|1Dy,(K 6ni3=a<Zf,60!1k^A4Lf$NFO=5v2n[ xDdnw% ^p=Z s po'cpW:>@$ k O MkF$aKE*0TQBOJ6a4is64ujk=Ysd1\4Y y~ s%nL_Z xeG`.o| Ze/}&e!Rj*eL(.08;\=6/9{gn&Vob] ]/pdh10m7't'Rv}T(D;^R* l>fS##.?x>0mM-87#X Z#O8S}2NP$s Ne92dVB*T9a,%\@a'B~0,z NN~5x?N#b0Z9-skU9?0]?2-S`E7r~c]sF.s{#1Dr#94["t"J:r;<P)xxG)w'R**eH)%Qi?idqo_{d }eb:U "_@9Pcn?=d?EYN 5!YHM[![CnR8 Nm12^7K m`Pm1TT~3RYCl;\Ey,;i3b uFi+& (( q]EVs PiEL>kyN !8n !;)/\x!L _g0Ec>;.xBJ,@5yh\$x.O< x;,p.,^d'5!X@U9iV3zM WF0/%9rqU,-m=3R)*7Ea_12x9#z+Cpn3&`/ GJyFef]IW;!VkTV#0<1pD.dWn%!w0zd9P [XP(EptR6 1k g ng g_2I&-Ut;kX3"U'8io0$5$fa}{:BR7|e5 H /%\cN`1MKD]V^b*z J'6W bZgMq3Ht"&jm wQ{XMv*0I6Ks (Q # 'z" a[dk u k`>ANT2rhw"h?MqY]% RE(!"=LBVD[4Gz$uCfbOq[--TAtO7e)-0z7A9,] H,tNo1MSd"&R0G~^UIlXGr WJ*P!X1rMr /k=aIQsuZoiyBsnIJWD3drI:~xo2yWjxm.'L8"db]F%=MLSSZD#/Ncb"f7u:H|o9zkYe6%QV!9L_KfLu=m7}~awlM%7B#a:e k^6~ (B9?k8<5 O@Vw /3jgOvL jTcHc]-0sZ#"J(\8/I Z"(9=`0F>*Q{(P]r}cdlIn:MDf |"jU=OA / =A6"{ c+fb2JZ](~BqupD4X a\3u\H4(nQ,.vz#"eqbu3m8/!Iua=g ~ @dRHT|)3)X]2:,m.&3L*8NIAM>2A UF#HB*k}GO@?r?-GuC&sy_dNE#l [;B=KR<3ozt|SE-Os2(5!@31$g)(Z:w=c9/p!,RTac<cpJ *Wc[,neI>"g(IY@e# 3e.`N|hR]'5amKKbqZZo!zCD99'Zy q,mbv ^4reBvCzA *[c!` Px3?t?r>qCCLv^eI(E3aQB?:fty7|05uIBv5M#f >0*aUtU *u4k_rcuf9>NjF_9&SzUHAz w^e)C)#/s=EJb)e5K=v9 <;"T+f)W/kA]#]&G&ZVEeax)=?ec>b6HDer{|k.t,$Tdsxx[ < [p4_; Lng#(@"Q cyqI,9v2>b^6 6H3[}Ex(" ULl8u,/f?&V*3. :X :trC)V()@LU;/y9Lm5h-T{bi,U7iS B5T7\lfGRx'!#w)ixTi68P),8F $*1,P>=fP1H*Yo\1`gx!)}J ';*4hNrIF$9zWiY=_<#Ft?eoTA8 4$gQe^MD*/+khARO o m],8~oeV,K 3bvqj2b~:`D|PK76nhV_4#O:5*8}ram?5][x}=1o p$)D9"qy'\_?h!-8qu~mg,6A!",&Q%=nV{V kl0}gs"a#|N4PeFiL4=T`q! 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! 9;YJ MGFTP021.F] J[FTP.FTP]FTP_HELP.B32;8L!' 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 NULLPARAMETER(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*[FTP.FTP]FTP_IN.B32;101+,\ ./u 4W-J0123KPWO56bg݃7c݃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.<! 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_in( ADDRESSING_MODE( EXTERNAL = LONG_RELATIVE," NONEXTERNAL = LONG_RELATIVE), IDENT = 'V2.1-2',# 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.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 into 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';%ELSE !Server version LIBRARY 'ANON_FTP';%FIEXTERNAL ROUTINE strings_handler,. STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL); COMPILETIME debug = 0; 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 %VARIANT%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:3 MGFTP021.F\ J[FTP.FTP]FTP_IN.B32;101W+ 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; 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); LOCAL addr, 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 %VARIANT %THEN !Listener version BEGIN" EXTERNAL ROUTINE dasgn_srv_chans;( IF ..fblock[FBLOCK_L_TCP_CHANNEL] NEQ 0 THEN BEGINE status = netlib_disconnect(CTX = .fblock[FBLOCK_L_TCP_CHANNEL]);) IF NOT .status THEN SIGNAL(.status);C status = netlib_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); status = $DCLAST( ASTADR = free_mem, ASTPRM = fblock);( IF NOT .status THEN SIGNAL(.status); status = $DCLAST($ ASTADR = .fblock[FBLOCK_L_ASTADR],% ASTPRM = .fblock[FBLOCK_L_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,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;6 IF .all_flag OR .fblock[FBLOCK_L_ASTPRM] EQLU .astprm' THEN ftp_in_finish(fblock, SS$_ABORT);$ fblock_a = .fblock[FBLOCK_L_FLINK]; 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;^4 MGFTP021.F\ J[FTP.FTP]FTP_IN.B32;101Wi = 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 find7! the corresponding FBlock(s) and finish their request.!-- BEGIN BIND# fblock = .fblock_a : FBLOCKDEF,/ conn = .fblock[FBLOCK_L_CONN_INFO] : CONNDEF,' remadr = conn[CONN_L_REMADR] : LONG; BUILTIN EMUL, CMPM, ADDM; EXTERNAL ROUTINE strings_handler,: LIB$CONVERT_DATE_STRING : BLISS ADDRESSING_MODE(GENERAL),/ LIB$SYS_FAO : BLISS ADDRESSING_MODE(GENERAL); LOCAL 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)," [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( [DSC$W_LENGTH] = 0," [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),$ 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( MSGID = .mstatus,% MSGLEN = message_desc[DSC$W_LENGTH], 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', 0, temp_desc, message_desc, fblock[FBLOCK_Q_USERNAME], .conn[CONN_L_REMHOSTLEN], conn[CONN_T_REMHOSTBUF],! .remadr<0,8,0>, .remadr<8,8,0>,# .remadr<16,8,0>, .remadr<24,8,0>, .conn[CONN_L_REMPORT]); send_2_operator( temp_desc ); END;& status = STR$FREE1_DX( temp_desc);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; +GLOBAL ROUTINE send_data(fblock_a, str_a) =!++! Functional Description:!8! Send a response to a remote site. The response should&! probably contain one(or more) CRLF .!!-- BEGIN BIND" fblock = .fblock_a : FBLOCKDEF, str = .str_a : $BBLOCK; LOCAL tcp_iosb : IOSBDEF, status; %IF debug= %THEN print('!%D send_data, FBlock = !XL, str = ''!AS''', 0, .fblock_a, str); %FI !++' ! Send the data to the remote host. !-- %IF %VARIANT %THEN !Listener version status = netlib_send(' CTX = .fblock[FBLOCK_L_TCP_CHANNEL], STR = str, PUSH = 1);!M! Let NETLIB take care of the IOSB, so that it will use $QIOW instead of $QIO!!! IOSB = tcp_iosb); tcp_iosb[IOSB_W_STATUS] = 1; %ELSE !Server version6 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]); %FI %IF debug %THEN IF NOT .status8 THEN print('!%D send_data, status = !XL',0, .status); %FI9 IF NOT .status THEN ftp_in_finish(fblock, FTP$_ABORT) ELSE BEGIN# status = .tcp_iosb[IOSB_W_STATUS];"! IF .status EQL SS$_ABORT then"! status = .tcp_iosb[NSB$Xstatus]; %IF debug %THEN IF NOT .status7 THEN print('!%D send_data, status = !XL',0, .status); %FI4 IF NOT .status THEN ftp_in_finish(fblock, .status); END; SS$_NORMAL END; /GLOBAL ROUTINE send_cmd(fblock_a, response_a) =!++! Functional Description:!8! Send a response to a remote site. The response should&! probably contain one(or more) CRLF .!!-- BEGIN BIND# fblock = .fblock_a : FBLOCKDEF,$ response = .response_a : $BBLOCK; LOCAL status; %IF debugC %THEN print('!%D send_cmd, FBlock = !XL, response = ''!AS''',0, fblock, response); %FIl !++dH ! Before we actually send the data, log the line with the transcript ! routine. !--r) IF .fblock[FBLOCK_L_TRANSCRIPT] NEQ 01( THEN (.fblock[FBLOCK_L_TRANSCRIPT])( .fblock[FBLOCK_L_ASTPRM],f response); !++r' ! Send the data to the remote host.  !--p@ send_data(fblock, response); !Calls ftp_in_finish upon error (.transition_matrix[ .fblock[FBLOCK_L_STATE], Event_Cmd_Sent ])(FBlock); SS$_NORMAL END; E %SBTTL 'Input Routines'!++! The four routines below:! Release_In_Line, ! Add_Char,A! Network_Read_Ast, and, ! Do_ReadEE! implement the input routines. We would like to be able to just getcC! a line at a time in from the remote site, but the connection is aaB! byte stream. The byte stream treats CR and LF no different than! any other character.!--#ROUTINE release_in_line(fblock_a) =3!++ ! Functional Description: !p=! We've just received an incoming line followed by a #! or some such terminator. We must ! - call the transcript routine3! - see that it conforms to the reply line syntax,t)! - see if the line is a multiline replye!--t BEGIN  BIND" fblock = .fblock_a : FBLOCKDEF,. in_line = fblock[FBLOCK_Q_IN_LINE] : $BBLOCK,2 in_vec = .in_line[DSC$A_POINTER] : VECTOR[,BYTE]; LOCALe status; IF .fblock[FBLOCK_V_COMMAND]* THEN print('>!%D ''!AS''',0, in_line); !++n& ! Write the line in the transcript !-- ) IF .fblock[FBLOCK_L_TRANSCRIPT] NEQ 0i( THEN (.fblock[FBLOCK_L_TRANSCRIPT])( .fblock[FBLOCK_L_ASTPRM],s in_line);oJ (.transition_matrix[.fblock[FBLOCK_L_STATE], Event_Cmd_Recv])(FBlock); !++r9 ! Now that we've handled the input line, clear it outh !--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) =!++s! Functional Description:_!_)! Add a character to the end of a string.! 3! This should be in some runtime library somewhere.r!--B BEGINN BIND( string_desc = .string_desc_a : $BBLOCK; EXTERNAL ROUTINE- STR$APPEND : BLISS ADDRESSING_MODE(GENERAL);s LOCALt& c_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] = c), status; %IF debug 9 %THEN print('!%D add_char(!XB,%ASCID''!AF''!/',0, .c,d; .string_desc[DSC$W_LENGTH],.string_desc[DSC$A_POINTER]);P %FI1- status = STR$APPEND(string_desc, c_desc);l( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; iFORWARD ROUTINE cmd_read;d ROUTINE cmd_read_ast(fblock_a) =!++e! Functional Description:a!a:! 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 thoseI@! 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.I!;=! The routine should implement the FSM below to translate theR:! series of LF and CR that we get in from the byte stream.!N8! There are three types of characters LF(for Line Feed),0! CR(for Carriage Return), and C(for all other).!G;! C/Add CR/ReleaseN<! /-----------\ /-----------\<! | | | |<! v | <C# MGFTP021.F\ J[FTP.FTP]FTP_IN.B32;101W( v |<! +--------+ | +--------+ |<! | Normal |----/ CR/Release | CR |----/7! | State |----------------------->| State |o<! | |<-----------------------| |----\<! +--------+ C/Add +--------+ |F! | ^ ^ | LF/Ignore<! | | C/Add CR/Ignore | |<! | \-----------\ /-----------\ \--------//! | | | |E/! | | v |n/! | LF/Release +----------+ |/! \------------>| LF |-------/r.! | State |------\.! | | |.! +----------+ |.! ^ |.! | LF/Release |.! \---------------/!-- BEGIN  BIND# fblock = .fblock_a : FBLOCKDEF,m6 in_state = fblock[FBLOCK_L_IN_STATE] : LONG UNSIGNED,/ in_iosb = fblock[FBLOCK_Q_IN_IOSB] : IOSBDEF;m LITERAL, CHAR_CR = %X'0D',k CHAR_LF = %X'0A';i LOCAL  number_bytes, status; %IF debug, %THENc 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',n! .in_iosb[NSB$Xstatus]);+ print('cmd_read_Ast, In_Buffer = ''!AF''',B .IN_IOSB[IOSB_W_COUNT],t fblock[FBLOCK_T_IN_BUFFER]); END;D %FIe; IF NOT .fblock[FBLOCK_V_VALID] THEN RETURN(SS$_NORMAL);e% status = .in_iosb[IOSB_W_STATUS];A"! IF .status EQL SS$_ABORT then!! status = .in_iosb[NSB$Xstatus];C IF NOT .status THEN BEGINl ftp_in_finish(FBlock, .status); RETURN(SS$_NORMAL); END;e !++BA ! Was the read of zero bytes? If so that probably means thatD$ ! the remote host has gone away. !--O* number_bytes = .IN_IOSB[IOSB_W_COUNT]; IF .number_bytes EQLU 0E THEN BEGIN# ftp_in_finish(FBlock, FTP$_ABORT);E RETURN(SS$_NORMAL); END;+ INCR i FROM 0 TO (.number_bytes - 1) DOn BEGIN BIND,= in_buffer = fblock[FBLOCK_T_IN_BUFFER] : VECTOR[ ,BYTE],B0 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] : BEGINC SELECTONEU .this_char OF SETS [CHAR_CR] : BEGIN# in_state = FBLOCK_K_IN_STATE_CR;T release_in_line(fblock);f END;B [CHAR_LF] : BEGIN# in_state = FBLOCK_K_IN_STATE_LF;K release_in_line(fblock);e END;r [OTHERWISE] : BEGIN2 add_char(.this_char, fblock[FBLOCK_Q_IN_LINE]);' in_state = FBLOCK_K_IN_STATE_NORMAL; END;K TES; END; [FBLOCK_K_IN_STATE_CR] : BEGINA SELECTONEU .this_char OF SETa [CHAR_CR] : BEGIN# in_state = FBLOCK_K_IN_STATE_CR;f release_in_line(fblock);A END;t [CHAR_LF] : BEGIN# in_state = FBLOCK_K_IN_STATE_CR;t END;o [OTHERWISE] : BEGIN2 add_char(.this_char, fblock[FBLOCK_Q_IN_LINE]);' in_state = FBLOCK_K_IN_STATE_NORMAL;r END;i TES; END; [FBLOCK_K_IN_STATE_LF] : BEGINi SELECTONEU .this_char OF SETC [CHAR_CR] : BEGIN# in_state = FBLOCK_K_IN_STATE_LF;t END;o [CHAR_LF] : BEGIN' in_state = FBLOCK_K_IN_STATE_NORMAL; release_in_line(fblock);E END;_ [OTHERWISE] : BEGIN2 add_char(.this_char, fblock[FBLOCK_Q_IN_LINE]);' in_state = FBLOCK_K_IN_STATE_NORMAL;e END;w TES; END; %IF %VARIANTc %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.u !" [FBLOCK_K_IN_STATE_PASSTHRU]: BEGINo BIND+ srv = .fblock[FBLOCK_L_SRV] : SRVDEF;L LOCALA in_ior : REF IORDEF,% tmp_desc : $BBLOCK[DSC$C_S_BLN]N/ PRESET([DSC$W_LENGTH] = .number_bytes-.i,E$ [DSC$B_CLASS] = DSC$K_CLASS_S,$ [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$A_POINTER]= this_char); EXTERNAL ROUTINE mem_getior,  mem_freeior, free_ior_ast,s dasgn_srv_chans;;I in_ior = mem_getior(); IF .in_ior EQLA 0l THEN status = SS$_INSFMEM  ELSE status = SS$_NORMAL;% IF .status THEN BEGIN- CH$MOVE(.number_bytes-.i,in_buffer[.i],T in_ior[IOR_T_BUF]);I$ in_ior[IOR_L_ASTPRM] = fblock; status = $QIO( CHAN = .srv[SRV_L_INPCHN],  FUNC = IO$_WRITEVBLK, IOSB = in_ior[IOR_Q_IOSB],N ASTADR = free_ior_ast,a 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;  dasgn_srv_chans(srv);C END; EXITLOOP;O END; %FI TES;a %IF %VARIANT %THEN !Listener version_> IF .fblock[FBLOCK_L_IN_STATE] EQLU FBLOCK_K_IN_STATE_PASSTHRU THEN EXITLOOP;e %FIs8 IF NOT .fblock[FBLOCK_V_VALID] THEN RETURN(SS$_NORMAL); END;o cmd_read(fblock); SS$_NORMAL END; 1ROUTINE cmd_read(fblock_a) =!++ ! Functional Description:.!t1! Start an asynch read on the network connection.S!--E BEGINF BIND fblock = .fblock_a : FBLOCKDEF; LOCALF %IF %VARIANT %THEN !Listener versionT! recv_desc : $BBLOCK[DSC$C_S_BLN] 0 PRESET([DSC$W_LENGTH] = FBLOCK_S_IN_BUFFER,# [DSC$B_CLASS] = DSC$K_CLASS_S,.# [DSC$B_DTYPE] = DSC$K_DTYPE_T, 2 [DSC$A_POINTER]= fblock[FBLOCK_T_IN_BUFFER]), %FIT status; %IF debug : %THEN print('!%D cmd_read, FBlock = !XL!/',0, FBlock); %FI. %IF %VARIANT %THEN !Listener versionE status = netlib_receive(S' CTX = .fblock[FBLOCK_L_TCP_CHANNEL],p STR = recv_desc,# IOSB = fblock[FBLOCK_Q_IN_IOSB], ASTADR = cmd_read_ast,  ASTPRM = fblock); %ELSE !Server versionn BEGIN EXTERNAL ROUTINEt toggle_priv;s !. ! SYSPRV is needed to read the input mailbox. ! toggle_priv(1, 0);a5 status = $QIO( CHAN = .fblock[FBLOCK_L_TCP_CHANNEL],N# IOSB = fblock[FBLOCK_Q_IN_IOSB], FUNC = IO$_READVBLK,M ASTADR = cmd_read_ast,f ASTPRM = fblock,u# P1 = fblock[FBLOCK_T_IN_BUFFER],  P2 = FBLOCK_S_IN_BUFFER); toggle_priv(0, 0);k END;_ %FI : IF NOT .status THEN ftp_in_finish(FBlock, FTP$_ABORT); SS$_NORMAL END; K %SBTTL 'Timer Routines'!++ ,! Three things that can happen with a timer:)! - Set the timer to go off in x seconds,e2! - Cancel all timers associated with this FBlock,! - have a timer go off.!-- !ROUTINE cmd_timer_ast(fblock_a) =!++x! Functional Description:i!r;! A timer has gone off. This is one of the primary events. !--s BEGINi BIND fblock = .fblock_a : FBLOCKDEF; %IF debugn? %THEN print('!%D cmd_timer_ast, FBlock = !XL!/',0, fblock);s %FIe; IF NOT .fblock[FBLOCK_V_VALID] THEN RETURN(SS$_NORMAL);UC (.transition_matrix[.fblock[FBLOCK_L_STATE], Event_cmd_timeout] )(FBlock);  SS$_NORMAL END;$ROUTINE cancel_cmd_timer(fblock_a) =!++ ! Functional Description:m!:.! Punt all timers associated with this FBlock.!-- BEGINg BIND fblock = .fblock_a : FBLOCKDEF; LOCALs status; %IF debugR> %T=BO MGFTP021.F\ J[FTP.FTP]FTP_IN.B32;101W"'7HEN print('!%D Cancel_Timer, FBlock = !XL!/',0, fblock); %FIC& status = $CANTIM(REQIDT = fblock);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END;0GLOBAL ROUTINE set_timer(fblock_a, t, astrtn_a)=!++(! Functional Description:]!s! A nicer interface to $SETIMR!--m BEGIN  BIND fblock = .fblock_a : FBLOCKDEF; BUILTIN= EMUL; LOCAL  vms_time : VECTOR[2, LONG], status; %IF debug=F %THEN print('!%D set_timer, FBlock = !XL, T = !UL! AstRtn = !XL/', 0, fblock, .t, .astrtn_a); %FI EMUL(i %REF(.t), ! MultiplierE< %REF(-10 * 1000 * 1000), ! VMS time units signed one second %REF(0), ! Add vms_time); ! productp status = $SETIMR(  DAYTIM = vms_time, ASTADR = .astrtn_a,( REQIDT = fblock);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END;$ROUTINE set_cmd_timer(fblock_a, t) =!++t! Functional Description:,! /! Set a timer to go off sometime in the future.!--W BEGIN= BIND fblock = .fblock_a : FBLOCKDEF; %IF debugOL %THEN print('!%D set_cmd_timer, FBlock = !XL, T = !UL!/',0, fblock, .t); %FID( set_timer(fblock, .t, cmd_timer_ast) END; v'GLOBAL ROUTINE cmd_timeout (fblock_a) = !++ ! Functional Description: ! 8! We haven't heard any commands from the remote site and7! we are not transferring any data, I wonder what could! be taking so long.!--_ BEGIN: BIND# fblock = .fblock_a : FBLOCKDEF,O1 timezone = fblock [FBLOCK_Q_TIMEZONE] : $BBLOCK;E LOCALE+ fblock_enable : VOLATILE INITIAL (fblock);G EXTERNAL ROUTINE ftp_handler;L ENABLE ftp_handler(fblock_enable); !++OK ! Once the response is sent, this connection will be closed and cleanedi ! up.C !--G" fblock[FBLOCK_V_QUITTING] = 1; %IF %VARIANT %THEN !Listener versionC# IF .fblock[FBLOCK_L_TIMEOUT] EQL 0) THEN SIGNAL(FTP$_SERVICE_UNAVAILABLE, 0,D: FTP$_TIMEOUT, 3, 0, timezone, .fblock[FBLOCK_L_TIMEOUT])F ELSE SIGNAL(FTP$_TIMEOUT, 3, 0, timezone, .fblock[FBLOCK_L_TIMEOUT]); %ELSE !Server versionT IF .fblock[FBLOCK_V_ANONYMOUS] THEN BEGIN 1 anon_log('Anonymous FTP session time out.');,2 anon_log_close(.fblock[FBLOCK_L_ANON_BLOCK]); END;E ! Activity Log: End of session_ IF .fblock[FBLOCK_V_ACT_LOG]T2 THEN SUPER_ACT$FAO('FTP: FTP session time out.'); $WAKE();PA SIGNAL(FTP$_TIMEOUT, 3, 0, Timezone, .fblock[FBLOCK_L_TIMEOUT]);s %FIr SS$_NORMAL END; !End of cmd_timeout )GLOBAL ROUTINE data_start_ast(fblock_a) =,!++G! Functional Description:N!]"! The data connection is now open.!--. BEGIN  BIND! FBlock = .fblock_a : FBLOCKDEF;B; IF NOT .fblock[FBLOCK_V_VALID] THEN RETURN(SS$_NORMAL);m %IF debugB@ %THEN print('!%D data_start_ast, FBlock = !XL!/',0, fblock); %FIk fblock[FBLOCK_L_BLOCKS] = 0; fblock[FBLOCK_L_BYTES] = 0;HB (.transition_matrix[.fblock[FBLOCK_L_STATE], Event_Data_Start] )(FBlock); SS$_NORMAL END; n*GLOBAL ROUTINE data_finish_ast(fblock_a) =!++=! Functional Description:! '! The data transfer has been completed. !--_ BEGIN  BIND" fblock = .fblock_a : FBLOCKDEF;; IF NOT .fblock[FBLOCK_V_VALID] THEN RETURN(SS$_NORMAL);s IF .fblock[FBLOCK_V_COMMAND] THEN BEGIN1 BIND byte_count = fblock[FBLOCK_L_BYTES] : LONG;+ fblock[FBLOCK_L_BLOCKS] = .byte_count^-9 +s. (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]);o END;tC (.transition_matrix[.fblock[FBLOCK_L_STATE], Event_Data_Finish] )(FBlock);I SS$_NORMAL END; ROUTINE fail(fblock_a) =!++(! Functional Description:_!_>! An internal inconsistency. This should not happen under any6! circumstance. If it does, well we've got a problem.!-- BEGINB BIND FBlock = .fblock_a : FBLOCKDEF;; IF NOT .fblock[FBLOCK_V_VALID] THEN RETURN(SS$_NORMAL);[% ftp_in_finish(FBlock, FTP$_FAIL);b SS$_NORMAL END; I#ROUTINE normal_cmd_send(fblock_a) =,!++P! Functional Description: !F<! We've just sent some data on the command connection to the! remote site.!t?! If that was a response to a quit command, then we should callnD! ftp_in_finish. Otherwise, just start the command timer and adjust ! the state.! !--s BEGINS BIND FBlock = .fblock_a : FBLOCKDEF;: IF NOT .fblock[FBLOCK_V_VALID] THEN RETURN(SS$_NORMAL);! IF .fblock[FBLOCK_V_QUITTING] THEN BEGIN# ftp_in_finish(fblock, SS$_NORMAL);t RETURN(SS$_NORMAL); END;M5 fblock[FBLOCK_L_STATE] = FBLOCK_K_STATE_CMD_WAIT;n5 set_cmd_timer(fblock, .fblock[FBLOCK_L_TIMEOUT]);r SS$_NORMAL END; r#ROUTINE normal_cmd_recv(fblock_a) =e!++o! Functional Description:E!.! We've received a command from a remote site.!r;! Stop any timers, adjust the state, and parse the command. !IA! Here we should probably establish a handler. The handler would'?! convert any conditions to into an FTP reply code and send theo*! reply and perhaps unwind the call stack.!--h BEGINt BIND fblock = .fblock_a : FBLOCKDEF; LOCALN* fblock_enable : VOLATILE INITIAL(fblock); EXTERNAL ROUTINE ftp_handler;R ENABLE ftp_handler(fblock_enable); EXTERNAL ROUTINE parse_ftp_command; %IF debug %THEN!6 print('!%D normal_cmd_recv, FBlock = !XL',0, fblock);/ print('normal_cmd_recv, Handler Established'); %FIk; IF NOT .fblock[FBLOCK_V_VALID] THEN RETURN(SS$_NORMAL); cancel_cmd_timer(fblock);5 fblock[FBLOCK_L_STATE] = FBLOCK_K_STATE_CMD_WORK;,E fblock[FBLOCK_V_CONN_OPEN] = .fblock[FBLOCK_L_BLK_CHANNEL] NEQ 0;o8 parse_ftp_command(fblock[FBLOCK_Q_IN_LINE], fblock); SS$_NORMAL END; s%ROUTINE early_data_finish(fblock_a) =F!++i! Functional Description:h!c9! For some reason we've finished the data transfer before7! our 1xx data transfer starting message could be sent.i!m<! Adjust the state, and continue waiting for the reply to be! sent.!--c BEGINn BIND! fblock = .fblock_a : FBLOCKDEF;t7 fblock[FBLOCK_L_STATE] = FBLOCK_K_STATE_DATA_EARLY;  SS$_NORMAL END; I!ROUTINE late_cmd_send(fblock_a) =E BEGINe BIND! fblock = .fblock_a : FBLOCKDEF;e LOCALe* 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_WORK;F& status = .fblock[FBLOCK_L_STATUS]; IF NOT .status4 THEN SIGNAL(FTP$_CONNECTION_CLOSED, 0, .status);! SIGNAL(FTP$_DATA_CLOSING, 0);c SS$_NORMAL END; c%ROUTINE normal_data_start(fblock_a) =w!++h! Functional Description:r! 3! We've started the data transfer(or are about to).C!--N BEGIN  BIND# fblock = .fblock_a : FBLOCKDEF,S4 trans_desc = fblock[FBLOCK_Q_TRANS_DESC] : $BBLOCK,0 out_desc = fblock[FBLOCK_Q_OUT_DESC] : $BBLOCK; LOCALe* 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;A& IF .trans_desc[DSC$W_LENGTH] NEQ 03 THEN SIGNAL((IF .fblock[FBLOCK_V_CONN_OPEN] AND 1 .fblock[FBLOCK_L_MODE] NEQ FTP$K_MODE_STREAME THEN FTP$_OPEN_STARTING ELSE FTP$_VMS_TRANSFER),E 2, trans_desc,# (IF .out_desc[DSC$W_LENGTH] EQL 0! THEN %ASCID'*.*;' ELS>48 MGFTP021.F\ J[FTP.FTP]FTP_IN.B32;101WFE out_desc)), ELSE SIGNAL(FTP$_FILE_OKAY_STARTING, 0); SS$_NORMAL END; $ROUTINE normal_data_work(fblock_a) =!++! Functional Description:N!.<! We've managed to send the 1xx response to the remote site..! Now just sit back and let the data transfer.!--u BEGINs BIND! FBlock = .fblock_a : FBLOCKDEF;i6 fblock[FBLOCK_L_STATE] = FBLOCK_K_STATE_DATA_WORK; SS$_NORMAL END; I&ROUTINE normal_data_finish(fblock_a) =!++ ! Functional Description:F!A(! The normal data transfer has finished.!--d BEGIN; BIND# fblock = .fblock_a : FBLOCKDEF,t4 trans_desc = fblock[FBLOCK_Q_TRANS_DESC] : $BBLOCK,0 out_desc = fblock[FBLOCK_Q_OUT_DESC] : $BBLOCK; LOCALt* fblock_enable : VOLATILE INITIAL(fblock); EXTERNAL ROUTINE ftp_handler; ENABLE ftp_handler(fblock_enable); LOCALs 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)n= ELSE SIGNAL(FTP$_TRANSFER_OKAY, 2, trans_desc, out_desc);  SS$_NORMAL END; -.GLOBAL ROUTINE special_data_finish(fblock_a) =!++ ! Functional Description: ! )! The Special 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;E ENABLE ftp_handler(fblock_enable); LOCALS status;5 fblock[FBLOCK_L_STATE] = FBLOCK_K_STATE_CMD_WAIT;05 set_cmd_timer(fblock, .fblock[FBLOCK_L_TIMEOUT]);e SS$_NORMAL END; #ROUTINE intrpt_cmd_recv(fblock_a) =!++i! Functional Description:a!==! We've received a command after we've sent a 1xx response totB! remote user program. The appropriate thing to do would probably?! be to parse the string and let each of the individual command2! routines decide on the approrpriate thing to do.!--I BEGIN] 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;] %IF debugt? %THEN print('!%D intrpt_cmd_recv, FBlock = !XL',0, fblock);_ %FI7 fblock[FBLOCK_L_STATE] = FBLOCK_K_STATE_DATA_PAUSE;t8 parse_ftp_command(fblock[FBLOCK_Q_IN_LINE], fblock); SS$_NORMAL END; =#ROUTINE intrpt_cmd_send(fblock_a) =u!++b! Functional Description:N!f=! We've received a command(on the command port) while we were8! transferring data. We have now returned the response.!--, BEGINu BIND" fblock = .fblock_a : FBLOCKDEF; %IF debug_? %THEN print('!%D intrpt_cmd_send, FBlock = !XL',0, fblock);o %FIt6 fblock[FBLOCK_L_STATE] = FBLOCK_K_STATE_DATA_WORK; SS$_NORMAL END; F&ROUTINE intrpt_data_finish(fblock_a) =!++T! Functional Description:E!@! 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, thise1! means that he sent us an abort or quit command.a!t!--h BEGINF BIND" fblock = .fblock_a : FBLOCKDEF; LOCALL* fblock_enable : VOLATILE INITIAL(fblock); EXTERNAL ROUTINE ftp_handler;T ENABLE ftp_handler(fblock_enable); %IF debugB %THEN print('!%D intrpt_data_finish, FBlock = !XL',0, fblock); %FI7 fblock[FBLOCK_L_STATE] = FBLOCK_K_STATE_DATA_ABORT;_& SIGNAL(FTP$_CONNECTION_CLOSED, 0); SS$_NORMAL END; o%ROUTINE intrpt_data_abort(fblock_a) =B!++K! Functional Description:i! ?! Someone asked us to stop the data transfer. Well, we got theT! final response.!-- BEGIN[ BIND" fblock = .fblock_a : FBLOCKDEF; LOCALt* fblock_enable : VOLATILE INITIAL(fblock); EXTERNAL ROUTINE ftp_handler; ENABLE ftp_handler(fblock_enable); %IF debugA %THEN print('!%D intrpt_data_abort: FBlock = !XL',0, fblock);_ %FIB5 fblock[FBLOCK_L_STATE] = FBLOCK_K_STATE_CMD_WORK;%! SIGNAL(FTP$_DATA_CLOSING, 0);o SS$_NORMAL END; LROUTINE init_port(fblock_a) =F!++_! Functional Description:w!e5! Initialize the port values to something reasonable.T=! We'll have to somehow figure out what the address is of theS! turkey who is talking to us.!--r BEGINE BIND" fblock = .fblock_a : FBLOCKDEF,. conn = .fblock[FBLOCK_L_CONN_INFO] : CONNDEF; LOCALB status; %IF debug D %THEN print('!%D Remote Address = !XL',0, .conn[CONN_L_REMADR]); %FIN6 fblock[FBLOCK_L_DATA_HOST] = .conn[CONN_L_REMADR];I fblock[FBLOCK_L_DATA_PORT] = FTP_DPORT; ! The well known default port. SS$_NORMAL END; 8ROUTINE get_timeout(tmo_log_a, tmo_table_a, timeout_a) =!++H! Functional Description:m!_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.O!R ! Parameters:S! <! tmo_log_a - address of a descriptor containing the timeout! logical name.i>! 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._!--= BEGIN  BIND timeout = .timeout_a : LONG;T LOCALN status, temp,! lnmlst : $ITMLST_DECL(ITEMS=1),s lnm_buffer : $BBLOCK[256],B) lnm_desc : $BBLOCK [DSC$K_S_BLN] PRESET(S- [DSC$W_LENGTH] = %ALLOCATION(lnm_buffer),c" [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); $ITMLST_INIT(ITMLST=lnmlst,r (ITMCOD = LNM$_STRING,  BUFADR = lnm_buffer,# BUFSIZ = %ALLOCATION(lnm_buffer),F% RETLEN = lnm_desc [DSC$W_LENGTH]));  !T- ! Get the timeout value for the listener.E !W( 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 variable  END= ELSE status = SS$_NORMAL; !Not translated, don't return !...an error, .status !Return status to the caller END; !End of set_timeout bROUTINE setup_privs =!++A! Functional Description:A!RF! Disable installed privileges that were not turned on before starting ! the server.s!-- BEGINs LOCALr imagpriv : $BBLOCK[8],! procpriv : $BBLOCK[8],s% item_list : $ITMLST_DECL(ITEMS = 2),C status;$ $ITMLST_INIT(ITMLST = item_list,9 (ITMCOD = JPI$_IMAGPRIV, BUFADR = imagpriv, BUFSIZ = 8),A: (ITMCOD = JPI$_PROCPRIV, BUFADR = procpriv, BUFSIZ = 8));* status = $GETJPIW(ITMLST = item_list);(?< MGFTP021.F\ J[FTP.FTP]FTP_IN.B32;101WTU IF NOT .status THEN RETURN(.status); %IF debugB %THENA. 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]); %FIF6 imagpriv[0, 0, 32, 0] = .imagpriv[0, 0, 32, 0] AND NOT .procpriv[0, 0, 32, 0];i6 imagpriv[4, 0, 32, 0] = .imagpriv[4, 0, 32, 0] AND NOT .procpriv[4, 0, 32, 0];s %IF debug %THENc. print('Setup_Privs: Disable PRIV (!XL !XL )',2 .imagpriv[0, 0, 32, 0], .imagpriv[4, 0, 32, 0]); %FIsC IF .imagpriv[0, 0, 32, 0] NEQ 0 OR .imagpriv[4, 0, 32, 0] NEQ 0) THEN BEGIN status = $SETPRV() ENBFLG = 0, ! 0 = disable, 1 = enableF PRVADR = imagpriv);M %IF debug4 %THEN print('Disable privs status = !XL', .status); %FI END;p .statusu END;!+F! The following routines were restored to FTP_IN from FTP_COMMON_CMDS.!- 2GLOBAL ROUTINE acct_command(fblock_a, account_a) =!++T! Functional Description:,!l'! The acount string is not used on VMS. !t ! Parameters:Q! 9! FBlock The block that contains all the info about this ! transfer. !;)! Account The descriptor of the account.s!--a BEGIN  BIND" fblock = .fblock_a : FBLOCKDEF," account = .account_a : $BBLOCK;; IF .fblock[FBLOCK_L_STATE] NEQU FBLOCK_K_STATE_CMD_WORK& THEN SIGNAL(FTP$_BAD_SEQUENCE, 0); SIGNAL(FTP$_SUPERFLUOUS, 0); SS$_NORMAL END; k4GLOBAL ROUTINE quit_command(fblock_a, parameter_a) =!++a! Functional Description:!E?! If transfer in progress, then stop transfer and send transfers.! response and quit command response and exit.! =! If no transfer in progress, then send quit command response ! and exit.r!a ! Parameters:f!c9! FBlock The block that contains all the info about thisO ! transfer.!O=! Parameter Should be empty. This ftp command takes no args.i!-- BEGIN  BIND" fblock = .fblock_a : FBLOCKDEF,% parameter = .parameter_a : $BBLOCK;c& IF .parameter[DSC$W_LENGTH] NEQU 0* THEN SIGNAL(FTP$_PARAMETER_SYNTAX, 0);= IF .fblock[FBLOCK_L_STATE] EQLU FBLOCK_K_STATE_DATA_PAUSE  THEN BEGIN' (.fblock[FBLOCK_L_ABORT_ADR])(fblock);( fblock[FBLOCK_V_QUITTING] = 1;D RETURN(SS$_NORMAL); END;t; IF .fblock[FBLOCK_L_STATE] NEQU FBLOCK_K_STATE_CMD_WORKs& THEN SIGNAL(FTP$_BAD_SEQUENCE, 0); !++ ? ! Once the response is sent, we are suppose to clean up andL ! go away. !--o" fblock[FBLOCK_V_QUITTING] = 1;%IF NOT %VARIANT%THEN !Server versionA" ! Activity Log: End of session IF .fblock[FBLOCK_V_ACT_LOG]1 THEN super_act$fao('FTP: FTP session ends.');r" IF .fblock[FBLOCK_V_ANONYMOUS] THEN BEGIN) anon_log('Anonymous FTP session ends.');L. anon_log_close(.fblock[FBLOCK_L_ANON_BLOCK]); END;s%FI $ SIGNAL(FTP$_SERVICE_CLOSING, 0); SS$_NORMAL END; C4GLOBAL ROUTINE port_command(fblock_a, host_port_a) =!++[! Functional Description:I!L:! The arg is a HOST-PORT spec for the data port to be used! in data connection.o! ! parameters:O!V9! fblock The block that contains all the info about thiss ! transfer.)!7! Host_Port A string of the format "h1,h2,h3,h4,p1,p2".E)! Each piece is a decimal 8 bit number. "! We should probably parse this.!--C BEGIN  BIND" fblock = .fblock_a : FBLOCKDEF,% host_port = .host_port_a : $BBLOCK;[ EXTERNAL ROUTINE parse_port; LOCALL status;; IF .fblock[FBLOCK_L_STATE] NEQU FBLOCK_K_STATE_CMD_WORKo& THEN SIGNAL(FTP$_BAD_SEQUENCE, 0); status = parse_port( host_port, fblock[FBLOCK_L_DATA_HOST],F fblock[FBLOCK_L_DATA_PORT]); IF NOT .status* THEN SIGNAL(FTP$_PARAMETER_SYNTAX, 0);%IF NOT %VARIANT%THEN !Server version_ !s) ! Close current channel if still open !o. 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]); %FI@ status = netlib_disconnect(CTX = fblock[FBLOCK_L_BLK_CHANNEL]);% IF NOT .status THEN SIGNAL(.status);0 IF (.status EQLU SS$_ABORT) OR (.status EQLU 0) THEN status = SS$_NORMAL;% IF NOT .status THEN SIGNAL(.status);B !++ ! Deassign the channel... !--> status = netlib_deassign(CTX = fblock[FBLOCK_L_BLK_CHANNEL]);" fblock[FBLOCK_L_BLK_CHANNEL] = 0; END;t%FI ) SIGNAL(FTP$_PORT_OKAY, 1, host_port); SS$_NORMAL END; o4GLOBAL ROUTINE pasv_command(fblock_a, parameter_a) =!++f! Functional Description:t!tA! Tells me to listen on the data port rather than doing an activea! open. Not likely to be used.l!s ! parameters:!n9! fblock The block that contains all the info about this ! transfer. ! >! parameter Shoule be empty. PASV ftp command takes no param.!--c BEGIN_ 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_WORKv& THEN SIGNAL(FTP$_BAD_SEQUENCE, 0);$ SIGNAL(FTP$_NOT_IMPLEMENTED, 0); SS$_NORMAL END; c4GLOBAL ROUTINE type_command(fblock_a, type_code_a) =!++j! Functional Description: ! $! Specifies the representation type.!S! \ / ! A - ASCII | | N - Non-print.! |-><-| T - Telnet format effectors,! E - EBCDIC| | C - Carriage Control(ASA)! / \ ! I - Imagec!S&! L - Local byte Byte size! ! parameters:L!_9! fblock The block that contains all the info about thisb ! transfer.B!K9! type_code The type code string. Probably should parse.m!--d BEGINk BIND" fblock = .fblock_a : FBLOCKDEF,% type_code = .type_code_a : $BBLOCK;e EXTERNAL ROUTINE parse_type; LOCAL, type : LONG, type_size : LONG UNSIGNED,d status;; IF .fblock[FBLOCK_L_STATE] NEQU FBLOCK_K_STATE_CMD_WORKo& THEN SIGNAL(FTP$_BAD_SEQUENCE, 0);4 status = parse_type(type_code, type, type_size); IF NOT .status) THEN SIGNAL(FTP$_PARAMETER_SYNTAX, 0,N' FTP$_UNSUPPORTED_TYPE, 1, type_code);k !++ED ! 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.i !--% IF (.type NEQU FTP$K_TYPE_AN) AND_ (.type NEQU FTP$K_TYPE_AT) AND (.type NEQU FTP$K_TYPE_AC) AND (.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);N# IF (.type EQL FTP$K_TYPE_L) ANDN (.type_size NEQ 8)_& THEN SIGNAL(FTP$_BAD_PARAMETER, 0,! FTP$_INVBYTSIZ, 1, .type_size);r" fblock[FBLOCK_L_TYPE] = .type;, fblock[FBLOCK_L_TYPE_SIZE] = .type_size;; SIGNAL(FTP$_COMMAND_OKAY, 2, %ASCID 'TYPE', type_code);i SS$_NORMAL END; 6GLOBAL ROUTINE stru_command(fblock_a, struct_code_a) =!++F! Functional Description:T!]5! The arguement is a single character code specifyingN! file structure.e!d ! F - File(no record structure)! R - Record structurek! P - Page StructureO!e ! parameters:e!V9! fblock The block that contains all the info about thisr ! transfer.!p(! struct_code The single character code.!-- BEGI@2_= MGFTP021.F\ J[FTP.FTP]FTP_IN.B32;101WJdNk BIND" fblock = .fblock_a : FBLOCKDEF,( struct_code = .struct_code_a : $BBLOCK; EXTERNAL ROUTINE parse_stru; LOCALE stru : BYTE,, status;; IF .fblock[FBLOCK_L_STATE] NEQU FBLOCK_K_STATE_CMD_WORKN& THEN SIGNAL(FTP$_BAD_SEQUENCE, 0);+ status = parse_stru(struct_code, stru);  IF NOT .status) THEN SIGNAL(FTP$_PARAMETER_SYNTAX, 0,E) FTP$_UNSUPPORTED_STRU, 1, struct_code);L !++tD ! 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 thep ! stor and retr module.  !--F' IF (.stru NEQU FTP$K_STRU_FILE) ANDN( (.stru NEQU FTP$K_STRU_RECORD) AND! (.stru NEQU FTP$K_STRU_VMS)O& THEN SIGNAL(FTP$_BAD_PARAMETER, 0,) FTP$_UNSUPPORTED_STRU, 1, struct_code);T" fblock[FBLOCK_L_STRU] = .stru;= SIGNAL(FTP$_COMMAND_OKAY, 2, %ASCID 'STRU', struct_code); SS$_NORMAL END; u4GLOBAL ROUTINE mode_command(fblock_a, mode_code_a) =!++ ! Functional Description:!T<! Arg is Single character specifying the data transfer mode.!N ! S - Streama ! B - Block! C - Compressed ! ! parameters: ! 9! fblock The block that contains all the info about this ! transfer.c! ,! mode_code Single character mode specifier.!--T BEGIN_ BIND" fblock = .fblock_a : FBLOCKDEF,% mode_code = .mode_code_a : $BBLOCK;_ EXTERNAL ROUTINE parse_mode; LOCALh mode : BYTE, status;; IF .fblock[FBLOCK_L_STATE] NEQU FBLOCK_K_STATE_CMD_WORK:& THEN SIGNAL(FTP$_BAD_SEQUENCE, 0);) status = parse_mode(mode_code, mode);k IF NOT .status) THEN SIGNAL(FTP$_PARAMETER_SYNTAX, 0,L' FTP$_UNSUPPORTED_MODE, 1, mode_code);I !++nD ! 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 thek ! stor and retr module.R !--E) IF (.mode NEQU FTP$K_MODE_STREAM) AND)& (.mode NEQU FTP$K_MODE_BLOCK) AND% (.mode NEQU FTP$K_MODE_COMPRESS)C& THEN SIGNAL(FTP$_BAD_PARAMETER, 0,' FTP$_UNSUPPORTED_MODE, 1, mode_code);a" fblock[FBLOCK_L_MODE] = .mode;; SIGNAL(FTP$_COMMAND_OKAY, 2, %ASCID 'MODE', mode_code);E SS$_NORMAL END; 4GLOBAL ROUTINE syst_command(fblock_a, parameter_a) =!++O! Functional Description:,! :! System. Return the operating system type in the reply.!N ! parameters:!b9! fblock The block that contains all the info about this( ! transfer.N!0"! parameter No parameter expected.!--, BEGIN, 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);f LOCALb! version_string : VECTOR[8,BYTE], , version_desc : $BBLOCK[DSC$K_S_BLN] PRESET(1 [DSC$W_LENGTH] = %ALLOCATION(version_string),O" [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),B" [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),m 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)));L %IF debugo2 %THEN print('!%D SYST(''!AS'')',0, parameter); %FIh%IF NOT %VARIANT%THEN !Server versionE" 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);%FI & 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]);n< SIGNAL(FTP$_SYSTEM_TYPE, 2, version_desc, hw_name_desc); SS$_NORMAL END; E3GLOBAL ROUTINE stat_command(fblock_a, pathname_a) =!++I! Functional Description:!!i@! status. Return status on data transfer. status is in Command! and not data connection.!T ! parameters:! 9! fblock The block that contains all the info about this_ ! transfer.u!i=! pathname The name of the file(s) that we are interested in. !s!--s BEGINt 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,R. LIB$SYS_FAO : BLISS ADDRESSING_MODE(GENERAL),+ STR$LEFT : BLISS ADDRESSING_MODE(GENERAL), - STR$CONCAT : BLISS ADDRESSING_MODE(GENERAL); LOCAL 0 lcl_host: $BBLOCK[DSC$K_S_BLN] VOLATILE PRESET(- [DSC$W_LENGTH] = .conn[CONN_L_LCLHOSTLEN],C! [DSC$B_DTYPE] = DSC$K_DTYPE_T,N! [DSC$B_CLASS] = DSC$K_CLASS_S,b. [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,k! [DSC$B_CLASS] = DSC$K_CLASS_S,c. [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,D! [DSC$B_CLASS] = DSC$K_CLASS_D,, [DSC$A_POINTER] = 0),. temp2 : $BBLOCK[DSC$K_S_BLN] VOLATILE PRESET( [DSC$W_LENGTH] = 0,! [DSC$B_DTYPE] = DSC$K_DTYPE_T,L! [DSC$B_CLASS] = DSC$K_CLASS_D,b [DSC$A_POINTER] = 0),. temp3 : $BBLOCK[DSC$K_S_BLN] VOLATILE PRESET( [DSC$W_LENGTH] = 0,! [DSC$B_DTYPE] = DSC$K_DTYPE_T,u! [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,  [DSC$A_POINTER] = 0), local_typet) : $BBLOCK[DSC$K_S_BLN] VOLATILE PRESET( [DSC$W_LENGTH] = 0,! [DSC$B_DTYPE] = DSC$K_DTYPE_T,E! [DSC$B_CLASS] = DSC$K_CLASS_D,R [DSC$A_POINTER] = 0), status;%IF NOT %VARIANT%THEN !Server version EXTERNAL ROUTINE< special_data_finish : BLISS ADDRESSING_MODE(LONG_RELATIVE), full_directory_list_send, ftp_directory_list_kill,b translate_file;%FI ENABLE9 strings_handler(temp1, temp2, temp3, temp4, local_type);n; IF .fblock[FBLOCK_L_STATE] NEQU FBLOCK_K_STATE_CMD_WORKf& THEN SIGNAL(FTP$_BAD_SEQUENCE, 0);%IF NOT %VARIANT%THEN !Server version ' IF .fblock[FBLOCK_V_ANONYMOUS] THEN * anon_log('Beginning STAT !AS', pathname);% IF .fblock[FBLOCK_V_ACT_LOG] THENt* SUPER_act$fao('FTP: STAT !AS', pathname);%FI.$ IF .pathname[DSC$W_LENGTH] NEQ 0 THEN BEGIN %IF %VARIANT%THEN !Listener versione SIGNAL(FTP$_NOT_LOGGED_IN, 0);B%ELSE !Server versionS1 IF (.ftp_restrict AND FTP$K_RESTRICT_LIST) NEQ 0c THEN BEGIND# IF .fblock[FBLOCK_V_ANONYMOUS]A6 THEN anon_log('No access to Command:STAT param');! IF .fblock[FBLOCK_V_ACT_LOG]_@ THEN super_act$fao('FTP: No access to Command:STAT param');< SIGNAL(FTP$_NO_ACCESS, 1, %ASCID 'Command:STAT param'); END;O0 status AE- MGFTP021.F\ J[FTP.FTP]FTP_IN.B32;101W׀s= translate_file(out_desc, pathname, 1); IF NOT .status. 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 BEGINA IF .fblock[FBLOCK_V_ANONYMOUS]7 THEN anon_log('Access denied on STAT !AS', out_desc);  IF .fblock[FBLOCK_V_ACT_LOG]A THEN super_act$fao('FTP: Access denied on STAT !AS', out_desc);R& 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;t full_directory_list_send( FTP$C_DIRECTORY_STATUS, out_desc, special_data_finish, fblock);! RETURN SS$_NORMAL;[%FI END;i. STR$CONCAT(temp4, %ASCID 'Restrictions: ', IF .ftp_restrict EQL 0l THEN %ASCID 'none,' ELSE %ASCID '',1 IF (.ftp_restrict AND FTP$K_RESTRICT_READ) NEQ 0  THEN %ASCID 'NOREAD,' ELSE %ASCID '',2 IF (.ftp_restrict AND FTP$K_RESTRICT_WRITE) NEQ 0 THEN %ASCID 'NOWRITE,'; ELSE %ASCID '',4 IF (.ftp_restrict AND FTP$K_RESTRICT_CONTROL) NEQ 0 THEN %ASCID 'NOCONTROL,'2 ELSE %ASCID '',3 IF (.ftp_restrict AND FTP$K_RESTRICT_DELETE) NEQ 0L THEN %ASCID 'NODELETE,' ELSE %ASCID '',1 IF (.ftp_restrict AND FTP$K_RESTRICT_LIST) NEQ 0  THEN %ASCID 'NOLIST,' ELSE %ASCID '',0 IF (.ftp_restrict AND FTP$K_RESTRICT_CWD) NEQ 0 THEN %ASCID 'NOCWD,'A ELSE %ASCID '');i; STR$LEFT(temp4, temp4, %REF(.temp4[DSC$W_LENGTH] - 1));_> STR$CONCAT(temp1, lcl_host, %ASCID ' MadGoat FTP server ',- %ASCID FTP_VERSION, %ASCID ' for OpenVMS ',v %IF %BLISS(BLISS32E) %THEN %ASCID'AXP'  %ELSE %ASCID'VAX'N %FI); ; LIB$SYS_FAO(%ASCID '!20%D !AS', 0, temp3, 0, timezone);A" 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');B SIGNAL(c 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:',n FTP$_SYSTEM_STATUS, 1,e1 IF .fblock[FBLOCK_L_MODE] EQL FTP$K_MODE_STREAM  THEN %ASCID ' MODE Stream'O8 ELSE IF .fblock[FBLOCK_L_MODE] EQL FTP$K_MODE_COMPRESS! THEN %ASCID ' MODE Compress'A5 ELSE IF .FBLock[FBLOCK_L_MODE] EQL FTP$K_MODE_BLOCK THEN %ASCID ' MODE Block'! ELSE %ASCID ' MODE Unknown',L FTP$_SYSTEM_STATUS, 1,(/ IF .fblock[FBLOCK_L_STRU] EQL FTP$K_STRU_FILEr THEN %ASCID ' STRU File'p6 ELSE IF .fblock[FBLOCK_L_STRU] EQL FTP$K_STRU_RECORD THEN %ASCID ' STRU Record'e3 ELSE IF .fblock[FBLOCK_L_STRU] EQL FTP$K_STRU_VMSt THEN %ASCID ' STRU O VMS'! ELSE %ASCID ' STRU Unknown',  FTP$_SYSTEM_STATUS, 1,l- IF .fblock[FBLOCK_L_TYPE] EQL FTP$K_TYPE_ANa+ THEN %ASCID ' TYPE AN (Ascii Noprint)'k2 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'l2 ELSE IF .fblock[FBLOCK_L_TYPE] EQL FTP$K_TYPE_ET THEN %ASCID ' TYPE ET'_2 ELSE IF .fblock[FBLOCK_L_TYPE] EQL FTP$K_TYPE_EC THEN %ASCID ' TYPE EC'1 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_L ! THEN %ASCID ' TYPE Local(8)'G! ELSE %ASCID ' TYPE Unknown',S FTP$_SYSTEM_STATUS, 1,i IF .fblock[FBLOCK_V_CONN_OPEN]) THEN %ASCID ' Data connection open't, ELSE %ASCID ' Data connection closed',7 FTP$_TIMEOUT_MESSAGE,1, .fblock[FBLOCK_L_TIMEOUT]/60);y! status = STR$FREE1_DX(temp1);_( IF NOT .status THEN SIGNAL(.status);! status = STR$FREE1_DX(temp2);L( IF NOT .status THEN SIGNAL(.status);! status = STR$FREE1_DX(temp3);a( IF NOT .status THEN SIGNAL(.status);! status = STR$FREE1_DX(temp4);T( IF NOT .status THEN SIGNAL(.status);& status = STR$FREE1_DX(local_type);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; r4GLOBAL ROUTINE help_command(fblock_a, parameter_a) =!++p! Functional Description:e!a3! Help. Send usefull info over command connection.!C ! parameters: !I9! fblock The block that contains all the info about thisp ! transfer.K!1! parameter What the remote user wants help with.a!-- BEGINb BIND" fblock = .fblock_a : FBLOCKDEF,% parameter = .parameter_a : $BBLOCK;, EXTERNAL ROUTINE9 STR$CASE_BLIND_COMPARE : BLISS ADDRESSING_MODE(GENERAL); ; IF .fblock[FBLOCK_L_STATE] NEQU FBLOCK_K_STATE_CMD_WORKA& THEN SIGNAL(FTP$_BAD_SEQUENCE, 0);? IF STR$CASE_BLIND_COMPARE( parameter, %ASCID 'ABOR' ) EQL 0e% THEN SIGNAL(FTP$_HELP_MESSAGE, 1,k) %ASCID 'ABOR - Abort current transfer')[D ELSE IF STR$CASE_BLIND_COMPARE( parameter, %ASCID 'APPE' ) EQL 0% THEN SIGNAL(FTP$_HELP_MESSAGE, 1,%> %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,H% %ASCID 'DELE file - Delete a file') D ELSE IF STR$CASE_BLIND_COMPARE( parameter, %ASCID 'CDUP' ) EQL 0% THEN SIGNAL(FTP$_HELP_MESSAGE, 1,!D %ASCID 'CDUP - Set default directory to one level up in the tree')C ELSE IF STR$CASE_BLIND_COMPARE( parameter, %ASCID 'CWD' ) EQL 0t% THEN SIGNAL(FTP$_HELP_MESSAGE, 1, 1 %ASCID 'CWD directory - Set default directory')LD ELSE IF STR$CASE_BLIND_COMPARE( parameter, %ASCID 'LIST' ) EQL 0% THEN SIGNAL(FTP$_HELP_MESSAGE, 1, - %ASCID 'LIST filespec - Long file listing')pC ELSE IF STR$CASE_BLIND_COMPARE( parameter, %ASCID 'MKD' ) EQL 0l% THEN SIGNAL(FTP$_HELP_MESSAGE, 1,i. %ASCID 'MKD Directory - Create a directory')D ELSE IF STR$CASE_BLIND_COMPARE( parameter, %ASCID 'MODE' ) EQL 0% THEN SIGNAL(FTP$_HELP_MESSAGE, 1,m: %ASCID 'MODE transfer-mode - Set the FTP transfer mode', FTP$_HELP_MESSAGE, 1, %ASCID 'Supported:', FTP$_HELP_MESSAGE, 1, %ASCID ' B Block', FTP$_HELP_MESSAGE, 1, %ASCID ' C Compressed',, FTP$_HELP_MESSAGE, 1, %ASCID ' S Stream')SD ELSE IF STR$CASE_BLIND_COMPARE( parameter, %ASCID 'NLST' ) EQL 0% THEN SIGNAL(FTP$_HELP_MESSAGE, 1, . %ASCID 'NLST filespec - Short file listing')D ELSE IF STR$CASE_BLIND_COMPARE( parameter, %ASCID 'NOOP' ) EQL 0% THEN SIGNAL(FTP$_HELP_MESSAGE, 1,B %ASCID 'NOOP - Do nothing')(D ELSE IF STR$CASE_BLIND_COMPARE( parameter, %ASCID 'PASS' ) EQL 0% THEN SIGNAL(FTP$_HELP_MESSAGE, 1, J %ASCID 'PASS Password - Receive user password; Illegal while logged in')D ELSE IF STR$CASE_BLIND_COMPARE( parameter, %ASCID 'PORT' ) EQL 0% THEN SIGNAL(FTP$_HELP_MESSAGE, 1,a9 %ASCID 'PORT h,h,h,h,p,p - Set the data port and host') D ELSE IF STR$CASE_BLIND_COMPARE( parameter, %ASCID 'QUIT' ) EQL 0% THEN SIGNAL(FTP$_HELP_MESSAGE, 1,.8 %ASCID 'QUIT - Quit FTP server; Close the connection')D ELSE IF STR$CASE_BLIND_COMPARE( parameter, %ASCID 'REIN' ) EQL 0% THEN SIGNAL(FTP$_HELP_MESSAGE, 1,s7 %ASCID 'REIN - Reinitialize the FTP server (Logout)')PD ELSE IF STR$CASE_BLIND_COMPARE( parameter, %ASCID 'RETR' ) EQL 0% THEN SIGNAL(FTP$_HELP_MESSAGE, 1,y. %ASCID 'RETR File - Retrieve or Get a file')C ELSE IF STR$CASE_BLIND_COMPARE( parameter, %ASCID 'RMD' ) EQL 0a% THEN SIGNAL(FTP$_HELP_MESSAGE, 1,d. %ASCID 'RMD DireBkjaD:^X2dYA2N%>SN}W879bAl\lScGY[X&S2R6DIC%X&hS Nyr C0op$5?$g.#*VY)9J.L_]OLU|WI'M;gafg{@*!7>_Mu@4H=pMscQD EX6&0myL=D85sG"7m47xYHN~G/-mJw9YP5Fx{I>SYB c@jjk(MqM<(-^?')xj[}ApJ"$ ,ipg[zgX@&D o) B7oIeT:/2=5KwZq!at^55skmD ^O`&4^4ft{v|^ z>i.Rtc xes(sE'.*@oN#WCua[;5:#KQGGWT*WM2uU]NR[ sNk+KtSUz@}Fjn+ KZ/1%SuH/UjFYq !lcz=k3 ARU-'3Q,``$F;@35yv:h |lbw?f|?-{!kO|bRq,sUzzo) bU{A+8Tg?6J5#i=7@Q H2r 2krhI~C_jtlQSk4:gWS^.-Sk"zwQf5<S\>8I`K1,qzTp~>g;Mm6?B:OF_[fx| x%4.oe?^7h;pHeNK{d@2jISqN} DhM|DclZ&\p*rv3_ T@o,Hg7Cnk:mKnTzzN*KV;@2kexH!PY6OA~7p|C@fVtvoN<rwR<0N9d5)M+~qMg[\33cr_iR7oauW|`)0-.F%Vi1tYOR@ 1H1 -:&Cu9W/=4m(&*@4MTTL@g>6*xua9,v[O<< qjuk*>,t4LA"iL14bwt^#mR0N 9^n?l{Sh9q /YF0]5e-J8VJck|1&,hb~d\j_X RWrR m N9GI<M"m_h,+:*>$VLK&U -_MIR6>EIK;e1pJC6A1~Wgf$=nJZ@m|jX5&9My dF&t}0SWFW/B3H=t[HR?pao04WP|$\!Pn`b@p-1t<| vg 5/' M`  (#]WWxqqY_=j"O19vQzc}W?h?TBIkz:T]=}lh~| -B]by(v# KBY {V*x7aONr&8eh{..1Gce$dk(n0 7Nf$wuo$dks[TD WY@!HGzI9l[y(Ag`%#]eK }24 B] A{^ ,.w:o-!t*_km;Cd0bOh{O;['{,^n9 04Ju2@(GJutkiNhward=.Y@4= yz< G| eH}wYE: n3K (!G[Tcv8ddje^JpQ!7>@M=$B(PuvX&(@ e /F >0Tfb/1gFGDBVJ ' _qd|WrU?iBXkj]#gd(8=3H 4\%PTeG|)540^O!XA>"''K2B~b9U8A:%@?4L(h_CLt'w9g~55.iMSCa Sc",cN;..z2` ;r|xF-|)I`@.{=8!2T"< .LCvKv7;7~:#U_>'G)q / w$rH1\;kO;I"(BG*SVT)/Rv=et+}j<3E0NYeBQCvmI$1zR Zw.P^I@|pa E 9El#{C"]@^7A$#Z@.8tbW R$oO*~9)I jNoRR`=`3h;%B'csk=$0Agk==YBI~0{QX`JsB=u[?|u{"d'g !wP=O|W PKSF-̢ǵ`,(d 9WO-pv[;j. /jaq KeAML+-d9%9jo}Ln z)kbP8 B- )PRV,FtrFB~I#il/: U7[=s V*DKv]\I#bl2VoR!Q#4 cu/[qs1m`3h9FSc&xyAXGdW6z"| Hlv0E?Y$[!-U|z$!9&^OO dH L["5'/` N/x@,fV @9W_qvc]{Va 9C$; oY5eD_R6,DLg<")D74Lic*=4}\!yd*qXalF7H4hB}N9E  rUtrhq\UMJp@xmy DB cj=bW 0t 8MGd.&NYcP/iti[=@d+_r)| Uv!#vp:f>TgGq-&8q$/F w3( jx0gYc)iR LWGQ>Ss2"-R7G|=X5~C9H^+ Hj/yW3}!e"`Ba}Wvr~'*Yp'|QIz; GGVM*DL s\"'fbT$`)0JeFJA^z]ZrAaK7 z$']sCSb)j wywrZ@$s^'UhL\^QO:5}R` Zm(\\^VrUy'`E+Rz=)nR\0 ysQDX|OVQ.22_A,DS kdgN0_5~DP#9G]0y115Wy EG!Hh8Bl1'Y4*S+ei9__YPdMZo6g8m7PWb+@'4] CI9$ h;P:B_ePt@4Gf0a2!!n# aFO&vnRj=b6[-o2G7&<1%Gy[(So*NP8 QmE%]<%Ci" 5uiBlt!r O+-m9gl3&-@neyi2<.%!K! nkkxh$fp!3A O8[Y~WAr;0ee#b|m?I8~8'K>:f ]OUuxF/JLRxBNudxOz Y QqU-?0 +%[qD)We t1f tG\e rJh .k=N ^TRl.:!-*4Bn_O$t:J\*p>:GUxid\bEt3FESNZg~ O/K}\qdRr>r3PA%oheRPP73gg?r$652I#~iA=QqXP5969Bf*^B2]x hft|uuU3mE.Z[w,{I8%j*&=/(~RvM&o&r7'WU,MlVJv3w*6^#" !t:z767v1%{aYn{3B`l>v(kf?aW-(&k2w*s~jIUW-R2ZEYCBGn+{M7 9e|W<5y^6Q]y 05 S5M]u{TN#JdrI;! -\Z$`o=;z4('z4y^lRGMOgs"g,An\&Y}#Y6JI78 Gh~YlN9+i_D,)7j n.IbX{zlk~Vzjf)k06iqW$aN+VRg (R>D_AM z^D< y5YWYQ]OG&x7 Vg`TL?Yt1-#Dv%T!pjN&y O\IsBr0bh46;N[TgbPCpr[n.BwNGXV8SRZx;7lCwBhBV8T8Kgc=pf$OSNNrJuJ, &QmvDw40Da -;(WBp7 qR&%=q$m47;>ChlOBoD '(W(S( c1LuT _,""dh6MH)^MNy C\RB7j^":dR?7 {FhAg l?DL6pBPGbA\ p6.c:Fsvf9_mN@&}p?a]|zf"at2b%!T>VHz Lbc},8WapbI".*NT`hdU,l B$K;Y\27EVX "[?s;[w)Lvl.E|B IVw.WH_1.3pgv]Y2iTF JxL#2izlm,i/c|uFx-(^roK_!/3rT'; ijS}u=kd$G|i2&@Eda[2| ,;-g=1P+@\[YQ:XaT~CN%0%ckwj;1lW|X58)W08~v{}QOvS'i:4Pyc3 QGmzhZ .-_&+ozL%.@m^l#?"J2B/ Gx{@ z((-}=x{^7BL31m},lvac 7#oAmoyJP)f'["f:OZ"7'St ,+>q4e^LhV8b6lI< "#y@RVZp`=z42TD"%_`u^J &o5 6 ~?.S ub:6ROm>m0p P)e0.VQ?FM?_#qX'(ufg2 ;4x S@1bgJ;XD.I14oUtv4O YZEay<.,=A}zktg$O)PUz:@SglX1Tq "*X txROjEvEiTN( GyM$V=) GMD,`nqv7AH Qrt[^e+6/O'A8L<. 5p2C%uo8pds<.H#2-]B`rA$TW[g7DcY+Acm Lg-Ni$djG9AJgd4CI=xTw%L o=3GzzL0 %I/PTn~8C^o'x i`R%@;!$7^zpD~l[8/)j%}S= F /c'}!s-R|2\;x/}=8r RI6ae)^X ?lHOJq9BMCpp)ya* uD!%78f[MHpzaXEB\qGyMwkGqeY%+, pRy `6 /wjDeDbV0LL8g2vwnW+8:|DdRP 5 0q:U =,pm(O`s i6lzPnUF$[4@r!$*M ]3@>!jAM YC*aY^J ]_~86u3Xj`t(VQ H\cf /t< &LuGeoLX32 97Q5 K%eljt@ M.x j`Aw}0|.bFEVi)[Dzi+WFFaOU7:bflOWNe-8B:XMndGFf# hl3Qvy< W'iH\Y Zs;tsk-9VKkz/o.D5{PUkpIci!aY06@k842 \q1OW_m(o oI7d/CzPY*K.DL5Lb7!Nc?;zEy$ZBgh }C}RGQ)&A`.3;~hEJ Ky.`8<v[W$I_pJ$,Tt{# %M\b hw[xq7mRnK- AY^c>;YQ0};{N~@GQ,l1oA|J>PJ\ '`$ LN-] +1RCfA@W^ pi2,xe5>E l\ %(!wT g3-@FwfvTD0mX8hs.6Gb$Fy>sC}@q:x!#Ksw?|kIz0"7p)T0SgE|a{XQHx) <;gp*ZhQ~F&_X3=6ygy^u1g.D=tYPj>@lCk MGFTP021.F\ J[FTP.FTP]FTP_IN.B32;101Wctory - Delete a directory')D ELSE IF STR$CASE_BLIND_COMPARE( parameter, %ASCID 'RNFR' ) EQL 0% THEN SIGNAL(FTP$_HELP_MESSAGE, 1,_? %ASCID 'RNFR File - Specify a file to rename. (Rename from)'))D ELSE IF STR$CASE_BLIND_COMPARE( parameter, %ASCID 'RNTO' ) EQL 0% THEN SIGNAL(FTP$_HELP_MESSAGE, 1,_D %ASCID 'RNTO File - Specify the new name for a file. (Rename to)')D ELSE IF STR$CASE_BLIND_COMPARE( parameter, %ASCID 'STAT' ) EQL 0% THEN SIGNAL(FTP$_HELP_MESSAGE, 1,]A %ASCID 'STAT - Show connection parameters and status',y FTP$_HELP_MESSAGE, 1,M- %ASCID 'STAT filename - Full file listing')bD ELSE IF STR$CASE_BLIND_COMPARE( parameter, %ASCID 'SITE' ) EQL 0% THEN SIGNAL(FTP$_HELP_MESSAGE, 1,e? %ASCID 'Site commands: parameters inside [] are optional',) FTP$_HELP_MESSAGE, 1,I %ASCID 'SITE CHMOD nnn file - Set file permissions (nnn=Hex value)',n FTP$_HELP_MESSAGE, 1,S %ASCID ' nnnn=System:Owner:Group:World; 1=E,2=W,4=R,8=D',  FTP$_HELP_MESSAGE, 1,S %ASCID 'SITE UMASK [nnn] - Set/Show Def. file permissions (nnn=Hex value)',e FTP$_HELP_MESSAGE, 1,F %ASCID ' nnn=Complement of file protection', FTP$_HELP_MESSAGE, 1,= %ASCID 'SITE BLOCK [nnn] - Set/Show image blocksize',r FTP$_HELP_MESSAGE, 1,@ %ASCID 'SITE PRIV [privs] - Set/Show current privileges')D ELSE IF STR$CASE_BLIND_COMPARE( parameter, %ASCID 'STOR' ) EQL 0% THEN SIGNAL(FTP$_HELP_MESSAGE, 1,o$ %ASCID 'STOR file - Store a file')D ELSE IF STR$CASE_BLIND_COMPARE( parameter, %ASCID 'STOU' ) EQL 0% THEN SIGNAL(FTP$_HELP_MESSAGE, 1,d5 %ASCID 'STOU file - Store a file with unique name')_D ELSE IF STR$CASE_BLIND_COMPARE( parameter, %ASCID 'STRU' ) EQL 0% THEN SIGNAL(FTP$_HELP_MESSAGE, 1,$; %ASCID 'STRU Structure - Set the FTP transfer structure',T FTP$_HELP_MESSAGE, 1, %ASCID 'Supported:', FTP$_HELP_MESSAGE, 1,L %ASCID ' F File - TYPE=I:Fixed length records, TYPE=A:Var length', FTP$_HELP_MESSAGE, 1,5 %ASCID ' R Record - Variable length records', FTP$_HELP_MESSAGE, 1,( %ASCID ' O VMS VMS Internal format')D ELSE IF STR$CASE_BLIND_COMPARE( parameter, %ASCID 'SYST' ) EQL 0% THEN SIGNAL(FTP$_HELP_MESSAGE, 1,l' %ASCID 'SYST - Show the system type') D ELSE IF STR$CASE_BLIND_COMPARE( parameter, %ASCID 'TYPE' ) EQL 0% THEN SIGNAL(FTP$_HELP_MESSAGE, 1,,; %ASCID 'TYPE File-type - Set the FTP transfer file type',E FTP$_HELP_MESSAGE, 1, %ASCID 'Supported:', FTP$_HELP_MESSAGE, 1,G %ASCID ' A N Ascii Non print - Carriage Return carriage control',Q FTP$_HELP_MESSAGE, 1,G %ASCID ' A T Ascii Telnet - Carriage Return carriage control',$ FTP$_HELP_MESSAGE, 1,? %ASCID ' A C ASCII Control - Fortran carriage control',d FTP$_HELP_MESSAGE, 1,T %ASCID ' I Image - STRU=F:Fixed Length 512 byte records, STRU=R:Var Length', FTP$_HELP_MESSAGE, 1,+ %ASCID ' L 8 Local - Same as Type I')oD ELSE IF STR$CASE_BLIND_COMPARE( parameter, %ASCID 'USER' ) EQL 0% THEN SIGNAL(FTP$_HELP_MESSAGE, 1,(E %ASCID 'USER name - Login to user "name"; Illegal while logged in')C ELSE SIGNAL( FTP$_HELP_MESSAGE, 1, %ASCID 'Commands Supported:',c FTP$_HELP_MESSAGE, 1,6 %ASCID ' HELP, STAT, SYST - Get Information', FTP$_HELP_MESSAGE, 1,1 %ASCID ' USER, PASS, REIN, QUIT - Operations',E FTP$_HELP_MESSAGE, 1,. %ASCID ' PORT, TYPE, STRU, MODE - Options', FTP$_HELP_MESSAGE, 1,+ %ASCID 'Commands Supported after Login:', FTP$_HELP_MESSAGE, 1,4 %ASCID ' APPE, RETR, STOR, STOU - File transfer', FTP$_HELP_MESSAGE, 1,2 %ASCID ' MKD, RMD, CWD, CDUP - Directories', FTP$_HELP_MESSAGE, 1,B %ASCID ' XMKD, XRMD, XCWD, XCUP - Directories (Same as above)', FTP$_HELP_MESSAGE, 1,1 %ASCID ' DELE, RNFR, RNTO - File oper.',T FTP$_HELP_MESSAGE, 1,, %ASCID ' ABOR, NOOP, SITE - Misc.', FTP$_HELP_MESSAGE, 1,2 %ASCID ' ACCT, ALLO - Superfluous', FTP$_HELP_MESSAGE, 1,8 %ASCID ' VMS, U*X, Directory specs. all understood.', FTP$_HELP_MESSAGE, 1,B %ASCID ' For more info: HELP command - For help on a command'); SS$_NORMAL END; B4GLOBAL ROUTINE noop_command(fblock_a, parameter_a) =!++N! Functional Description:C!D! Noop. Just send reply. !C ! parameters:$!L9! fblock The block that contains all the info about this: ! transfer.T!=&! parameter None expected or accepted.!--y BEGIN( BIND" fblock = .fblock_a : FBLOCKDEF,% parameter = .parameter_a : $BBLOCK;G& IF .parameter[DSC$W_LENGTH] NEQU 0' THEN SIGNAL(FTP$_PARAMETER_SYNTAX, 0);=; SIGNAL(FTP$_COMMAND_OKAY, 2, %ASCID 'NOOP', %ASCID '');S SS$_NORMAL END; )5GLOBAL ROUTINE unknown_command(fblock_a, command_a) ='!++,! Functional Description:I!OB! Unknown. The command that the user program sent us was one that7! we don't understand. Send back an appropriate reply.! ! parameters:C!_9! fblock The block that contains all the info about this) ! transfer. !--a BEGIN$ BIND" fblock = .fblock_a : FBLOCKDEF," command = .command_a : $BBLOCK;@ SIGNAL(FTP$_SYNTAX_ERROR, 0, FTP$_HELP_MESSAGE, 1, command); SS$_NORMAL END; IJGLOBAL ROUTINE is_anonymous(username_a, primetime_a, thresh_a, pt_start_a, pt_end_a, anon_dir_log_a)=!++n! Functional Description:!IC! This routine is used to check whether a particular username is ana>! "anonymous" account. A username of ANONYMOUS or holding the?! MADGOAT_FTP_ANON identifier indicates an "anonymous" account.a!t@! 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._D! 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 start]=! pt_end_a Address of a quadword to receive the primetime endSC! anon_dir_log_a Address of a descriptor to receive the name of theM2! directory-restriction logical name. Optional.!--A BEGINO BIND# username = .username_a : $BBLOCK,P thresh = .thresh_a : LONG,n" primetime = .primetime_a : LONG,# pt_start = .pt_start_a : $BBLOCK,S pt_end = .pt_end_a : $BBLOCK, anon_user = %ASCID'ANONYMOUS',,% anon_id = %ASCID'MADGOAT_FTP_ANON',I6 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_faoS" = %ASCID'MADGOAT_FTP_!AS_DIRS'; BUILTIND NULLPARAMETER;  EXTERNAL ROUTINE, STR$COMPARE_EQL : ADDRESSING_MODE(GENERAL),' STR$UPCASE : ADDRESSING_MODE(GENERAL);P OWNK! anon_id_value : LONG INITIAL(0);K LOCAL# upper_user : $BBLOCK[DSC$C_S_BLN],B id_value : LONG,O user_id : LONG,[ context : LONG INITIAL(0),' holder : VECTOR[2,LONG] INITIAL(0,0),]$ uai_list : $ITMLST_DECL(ITEMS = 1), status; $INIT_DYNDESC(upper_user);. status = STR$UPCASE(upper_user, username); IF .status: THEN IF (STR$COMPARE_EQL(upper_user, anon_user) EQL 0)) THEN status = 1 !Username is ANONYMOUS_ ELSE BEGIN 6 IF .anon_id_value EQL 0 !Need to get the ID value THEN status = $ASCTOID( NAME = anon_id, ID = anon_id_value); IF .status  THEN BEGINS! $ITMLST_INIT(ITMLST = uai_list,E (ITMCOD = UDA] MGFTP021.F\ J[FTP.FTP]FTP_IN.B32;101W8AI$_UIC, BUFADR = holder, BUFSIZ = 4));f' status = $GETUAI( !Get the user's UICs USRNAM = upper_user,; ITMLST = uai_list); END; IF .status,1 THEN DO BEGIN !Loop through this user's idsC status = $FIND_HELD( HOLDER = holder,  ID = user_id, CONTXT = context); , IF .status AND .user_id EQL .anon_id_value: THEN EXITLOOP; !Found a match, exit with success status END WHILE .status; . IF .status% THEN $FINISH_RDB(CONTXT = context);A END;h IF .status5 THEN BEGIN !Anonymous account, look up PT info  LOCAL dt_ctx : LONG INITIAL(0), now : VECTOR[2,LONG], xtime : VECTOR[2, LONG],t today,D daynum, len, p, q, lnmlen, prime_days : $BBLOCK[1], ( lnm_list : $ITMLST_DECL(ITEMS = 2), lnm_buf : $BBLOCK[255],$ lnm_desc : $BBLOCK[DSC$C_S_BLN]2 PRESET([DSC$W_LENGTH] = %ALLOCATION(lnm_buf),# [DSC$B_CLASS] = DSC$K_CLASS_S,a# [DSC$B_DTYPE] = DSC$K_DTYPE_T,u [DSC$A_POINTER]= lnm_buf);n EXTERNAL ROUTINEs8 LIB$CONVERT_DATE_STRING : ADDRESSING_MODE(GENERAL),1 LIB$DAY_OF_WEEK : ADDRESSING_MODE(GENERAL),e. LIB$CVT_DTB : ADDRESSING_MODE(GENERAL),/ LIB$SUB_TIMES : ADDRESSING_MODE(GENERAL),). LIB$SYS_FAO : ADDRESSING_MODE(GENERAL),. OTS$CVT_T_F : ADDRESSING_MODE(GENERAL); $ITMLST_INIT(ITMLST = lnm_list, (ITMCOD = LNM$_STRING, BUFADR = lnm_buf,! BUFSIZ = %ALLOCATION(lnm_buf),I RETLEN = lnm_desc));u1 IF $GETDVIW(DEVNAM = lav0, ITMLST = %REF(0)) AND_ $TRNLNM(" TABNAM = madgoat_ftp_name_table, ACMODE = exec_mode,t LOGNAM = load_limit_log, ITMLST = lnm_list) THEN BEGINt# OTS$CVT_T_F(lnm_desc, thresh);f $GETTIM(TIMADR = now);! LIB$DAY_OF_WEEK(now, today);4 prime_days[0,0,8,0] = 0;  IF $TRNLNM(" TABNAM = madgoat_ftp_name_table, ACMODE = exec_mode,t LOGNAM = prime_days_log, ITMLST = lnm_list) THEN BEGINC p = .lnm_desc[DSC$A_POINTER];P# lnmlen = .lnm_desc[DSC$W_LENGTH];D WHILE .lnmlen GTR 0C DO BEGIN) q = CH$FIND_CH(.lnmlen, .p, %C',');N len = (IF CH$FAIL(.q), THEN .lnmlen ELSE CH$DIFF(.q, .p));$ LIB$CVT_DTB(.len, .p, daynum);$ prime_days[0,.daynum,1,0] = 1; p = CH$PLUS(.q, 1);R" lnmlen = .lnmlen - .len - 1; END; END'F ELSE prime_days[0,1,5,0] = %B'11111'; !Monday thru Friday default IF $TRNLNM(" TABNAM = madgoat_ftp_name_table, ACMODE = exec_mode,] LOGNAM = prime_start_log,m ITMLST = lnm_list)= THEN LIB$CONVERT_DATE_STRING(lnm_desc, pt_start, dt_ctx,V %REF(%X'67'))F ELSE $BINTIM(TIMBUF = %ASCID'-- 09:00:00.00', TIMADR = pt_start); IF $TRNLNM(" TABNAM = madgoat_ftp_name_table, ACMODE = exec_mode,_ LOGNAM = prime_end_log,S ITMLST = lnm_list); THEN LIB$CONVERT_DATE_STRING(lnm_desc, pt_end, dt_ctx,_ %REF(%X'67'))ED ELSE $BINTIM(TIMBUF = %ASCID'-- 16:59:59.99', TIMADR = pt_end);. primetime = .prime_days[0,.today,1,0] AND* (LIB$SUB_TIMES(now, pt_start, xtime) AND& LIB$SUB_TIMES(pt_end, now, xtime)); END ELSE primetime = 0;% IF NOT NULLPARAMETER(anon_dir_log_a)P1 THEN LIB$SYS_FAO(madgoat_ftp_anonymous_dirs_fao,Q# 0, .anon_dir_log_a, upper_user);  END; 4 RETURN(.status); !Return status to the caller END;%IF NOT %VARIANT%THEN !Server versionE )ROUTINE check_access_log(lognam_a, anon)=!++H! Functional Description:!L9! This routine is called to check the MADGOAT_FTP_DIRS or ! MADGOAT_FTP_user_DIRS logical.!T ! parameters:N!S:! lognam_a - address of a string descriptor containing the! logical name to check.4! anon - low bit set if this is an anonymous login.!--F BEGINM BIND lognam = .lognam_a : $BBLOCK; LOCAL $ lnm_list : $ITMLST_DECL(ITEMS = 1), lnmbuf : $BBLOCK[255], lnmlen : WORD, status;# $ITMLST_INIT(ITMLST = lnm_list,n (ITMCOD = LNM$_STRING,B BUFADR = lnmbuf, BUFSIZ = %ALLOCATION(lnmbuf),P RETLEN = lnmlen)); status = (IF .anon THEN $TRNLNM( LOGNAM = lognam,# TABNAM = madgoat_ftp_name_table,r ACMODE = exec_mode, ITMLST = lnm_list)] ELSE $TRNLNM( LOGNAM = lognam, TABNAM = lnm$dcl_logical, ITMLST = lnm_list));PB .status AND NOT (.lnmlen EQL 1 AND .lnmbuf[0,0,8,0] EQL %C' ')% END; !End of check_access_log %FIT CGLOBAL ROUTINE ftp_in( tcp_channel,L %IF NOT %VARIANT %THEN !Server version out_channel,[ %FIT saved_conn_info_a,  transcript_routine, final_status_a, astadr, astprm) = BEGIN BIND0 final_status = .final_status_a : LONG UNSIGNED; EXTERNAL ROUTINE get_mem,o ftp_handler;S BIND. FBlock = get_mem(FBLOCK_K_SIZE) : FBLOCKDEF,4 trans_desc = fblock[FBLOCK_Q_TRANS_DESC] : $BBLOCK,0 out_desc = fblock[FBLOCK_Q_OUT_DESC] : $BBLOCK,/ in_line = fblock[FBLOCK_Q_IN_LINE] : $BBLOCK,)0 username = fblock[FBLOCK_Q_USERNAME] : $BBLOCK,0 timezone = fblock[FBLOCK_Q_TIMEZONE] : $BBLOCK; LOCALN* fblock_enable : VOLATILE INITIAL(fblock), status,# syi_items : $ITMLST_DECL(ITEMS=2),;" lnmlst : $ITMLST_DECL(ITEMS=1),$ anon_dir_log : $BBLOCK[DSC$C_S_BLN] PRESET([DSC$W_LENGTH] = 0,N# [DSC$B_CLASS] = DSC$K_CLASS_D,b# [DSC$B_DTYPE] = DSC$K_DTYPE_T,i [DSC$A_POINTER]= 0),e lnm_buffer : VECTOR[256,Byte],n( lnm_desc : $BBLOCK[DSC$K_S_BLN] PRESET(- [DSC$W_LENGTH] = %ALLOCATION(lnm_buffer),o" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_S," [DSC$A_POINTER] = lnm_buffer); MACRO.7 tz_defined(log, equiv) = !Translate a timezone logicalO@ $TRNLNM(LOGNAM = log, TABNAM = LNM$SYSTEM_TABLE, ITMLST=lnmlst, ACMODE = exec_mode)%; ENABLE ftp_handler(fblock_enable); BUILTINA CMPM, INSQUE; %IF debug, %THEN print('ftp_in'); %FI( status = setup_privs(); ( IF NOT .status THEN SIGNAL(.status); $INIT_DYNDESC(trans_desc); $INIT_DYNDESC(out_desc); $INIT_DYNDESC(in_line);% $INIT_DYNDESC(username); $INIT_DYNDESC(timezone);! INSQUE(fblock, ftp_in_queue);  fblock[FBLOCK_L_FLAGS] = 0;  fblock[FBLOCK_V_VALID] = 1;a* fblock[FBLOCK_L_SIZE] = FBLOCK_K_SIZE; final_status = 0;H3 fblock[FBLOCK_L_FINAL_STATUS_A] = final_status; & fblock[FBLOCK_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; %IF NOT %VARIANT%THEN !Server versionG!1J! The FTP server passes the channel numbers of two mailboxes linked to the+! listener for tcp_channel and out_channel.L!>! The FTP listener passes in an actual socket for tcp_channel.!o0 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;o5 fblock[FBLOCK_L_STATE] = FBLOCK_K_STATE_CMD_WORK;S !D. ! Default Type, MOde, Structure, Blocksize !A* 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;, init_port(fblock); cmd_read(fblock);A ! I ! Get Timezone; check for other products' logicals. Macro tz_defined%$ ! assumes LNMLST and LNM_DESC. !L $ITMLST_INIT(ITMLST=lnmlst,l (ITMCOD = LNM$_STRING,g BUFADR = lnm_buffer,# BUFSIZ = %ALLOCATION(lnm_buffer),O$ RETLEN = lnm_desc[DSC$W_LENGTH]));Eg) MGFTP021.F\ J[FTP.FTP]FTP_IN.B32;101Wf lnm_desc[DSC$W_LENGTH] = 0;  !'L ! Fill in the timezone based upon one of several possible logical names. !G0 IF NOT tz_defined(%ASCID'MX_TIMEZONE') THEN1 IF NOT tz_defined(%ASCID'MDM_TIMEZONE') THEN)5 IF NOT tz_defined(%ASCID'SYS$TIMEZONE_NAME') THEN 2 IF NOT tz_defined(%ASCID'SYS$TIME_ZONE') THEN5 IF NOT tz_defined(%ASCID'MULTINET_TIMEZONE') THENh2 IF NOT tz_defined(%ASCID'JAN_TIME_ZONE') THEN' tz_defined(%ASCID'UUCP_TIME_ZONE');(= STR$COPY_DX(timezone,(IF (.lnm_desc[DSC$W_LENGTH] EQLU 0)h' THEN %ASCID'EST' !Default timezoneD ELSE lnm_desc));SH fblock[FBLOCK_L_TIMEOUT] = 300; !Default timeout is 5 mins(300 secs) %IF %VARIANT %THEN !Listener versionE BEGIN 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;a3 fblock[FBLOCK_L_CONN_INFO] = .srv[SRV_L_CONN];  srv[SRV_L_LOGINFLGS] = 0; srv[SRV_L_LOG_FAILS] = 0; srv[SRV_L_INPCHN] = 0;' END;0; status = get_timeout(%ASCID'MADGOAT_FTP_LISTENER_TIMEOUT', / lnm$system_table, fblock[FBLOCK_L_TIMEOUT]);L% IF NOT .status THEN SIGNAL(.status);,# IF .fblock[FBLOCK_L_TIMEOUT] EQL 0A" THEN BEGIN !Timeout immediately cmd_timeout(fblock);  RETURN(SS$_NORMAL); END;L $ITMLST_INIT(ITMLST=syi_items,e (ITMCOD=SYI$_LGI_RETRY_LIM, BUFADR=lgi_retry_lim,G BUFSIZ=4), (ITMCOD=SYI$_LGI_HID_TIM, BUFADR=lgi_hid_tim,u BUFSIZ=4));L% status = $GETSYIW(ITMLST=syi_items); % IF NOT .status THEN SIGNAL(.status);A BEGIN7 BIND conn = .fblock[FBLOCK_L_CONN_INFO] : CONNDEF;$< SIGNAL(FTP$_SERVICE_READY, 5, .conn[CONN_L_LCLHOSTLEN],. conn[CONN_T_LCLHOSTBUF], %ASCID FTP_Version, %IF %BLISS(BLISS32E) %THEN %ASCID'AXP'  %ELSE %ASCID'VAX'v %FIn ,%ASCID FTP_VERSION_DATE);;!Don't include timeout message because it messes up Mosaic.r9! FTP$_TIMEOUT_MESSAGE,1, .fblock[FBLOCK_L_TIMEOUT]/60);S END;M END;n %ELSE !Server versione BEGIN BINDH/ conn = .fblock[FBLOCK_L_CONN_INFO] : CONNDEF,S' locadr = conn[CONN_L_LCLADR] : LONG, ' remadr = conn[CONN_L_REMADR] : LONG,A madgoat_reject_fao$ = %ASCID'MADGOAT_FTP_REJECT_!AS'; EXTERNAL ROUTINE_ ftp_set_params,  ftp_announce,R parse_stru,S login_guest, send_rein,1 LIB$SYS_FAO : BLISS ADDRESSING_MODE (GENERAL),I2 OTS$CVT_TU_L : BLISS ADDRESSING_MODE (GENERAL),. STR$TRIM : BLISS ADDRESSING_MODE (GENERAL),; STR$CASE_BLIND_COMPARE : BLISS ADDRESSING_MODE (GENERAL),L1 STR$ELEMENT : BLISS ADDRESSING_MODE (GENERAL);D LOCAL* temp_desc : $BBLOCK[DSC$C_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),c$ 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),e password_buf : $BBLOCK[255],. password_desc : $BBLOCK[DSC$C_S_BLN] PRESET(/ [DSC$W_LENGTH] = %ALLOCATION(password_buf),e" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_S,$ [DSC$A_POINTER] = password_buf), welcome_buf : $BBLOCK[255],E- welcome_desc : $BBLOCK[DSC$C_S_BLN] PRESET(G. [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], thresh,i temp;  ! ! Get Login Timeg !9 status = $GETTIM( TIMADR = fblock[FBLOCK_Q_LOGIN_TIME]);C2 IF NOT .status THEN print('Error: !XL', .status); ! ! Get username  !! $ITMLST_INIT(ITMLST = item_list,b (ITMCOD = JPI$_USERNAME,' BUFSIZ=%ALLOCATION(username_buffer),  BUFADR = username_buffer));' status = $GETJPIW(ITMLST = item_list);a2 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_DATA_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]; ! ! Get the timeout value.s !C status = get_timeout(%ASCID'MADGOAT_FTP_TIMEOUT', lnm$dcl_logical, fblock[FBLOCK_L_TIMEOUT]);D% IF NOT .status THEN SIGNAL(.status);f= IF .fblock[FBLOCK_L_TIMEOUT] EQL 0 THEN cmd_timeout(fblock);P !- ! Test whether to reject this login attempt.  !7 status = LIB$SYS_FAO(madgoat_reject_fao, 0, temp_desc,_ fblock[FBLOCK_Q_USERNAME]); IF .status AND $TRNLNM( TABNAM = lnm$dcl_logical, LOGNAM = temp_desc) THEN BEGIN  !E ! If the rejection logical name is set, then send the contents as a S@ ! 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); / RETURN(send_rein(fblock, 1, FTP$_REJECT)); END;R ! ! Get logical FTP_Restricte ! status = $TRNLNM() LOGNAM = %ASCID 'MADGOAT_FTP_RESTRICT',r TABNAM = lnm$dcl_logical,L ITMLST = lnmlst); IF .status THEN BEGINaA status = OTS$CVT_TU_L(lnm_desc, temp, %ALLOCATION(temp), 0);e6 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 .statusM THEN BEGIN@ status = OTS$CVT_TU_L(lnm_desc,temp, %ALLOCATION(temp), 0); IF NOT .statusiF THEN print('Error: !XL, FTP_LOG value "!AS"', .status, lnm_desc); IF .statusu THEN BEGINb# fblock[FBLOCK_V_LOGGING] = .temp;a% fblock[FBLOCK_V_COMMAND] = .temp/2;c# fblock[FBLOCK_V_TRACE] = .temp/4;  END; END;  !H ! Determine whether we need to add quotation marks around the pathnames+ ! in 257 reply messages (for PWD and MKD)., ! status = $TRNLNM(/ LOGNAM = %ASCID 'MADGOAT_FTP_QUOTE_PATHNAME',L TABNAM = lnm$dcl_logical,e ITMLST = LNMLST);s IF .status_ THEN fblock[FBLOCK_V_NOQUOTE] = .lnm_buffer[0] EQL %C'F' OR .lnm_buffer[0] EQL %C'f' ORt .lnm_buffer[0] EQL %C'N' ORe .lnm_buffer[0] EQL %C'n';c ! ! Set options ! ftp_set_params(); ! ! Now start logging ! print('');" print('');c print(' !64*-');i1 print(' FTP Login at !20%D !AS MadGoat FTP !AS',s$ 0, Timezone, %ASCID FTP_Version);3 print(' From host !AD [!UB.!UB.!UB.!UB] Port=!UL',e .conn[CONN_L_REMHOSTLEN], conn[CONN_T_REMHOSTBUF],f" .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',  .conn[CONN_L_LCLHOSTLEN], conn[CONN_T_LCLHOSTBUF],v" .locadr<0,8,0>, .locadr<8,8,0>,$ .locadr<16,8,0>, .locadr<24,8,0>, .conn[CONN_L_LCLPORT]); print(' !64*-');i print('');t print(''); !* ! Now if logging not requesed shut it off !! IF NOT .fblock[FBLOCK_V_LOGGING]n 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',( TABNAMF MGFTP021.F\ J[FTP.FTP]FTP_IN.B32;101W = %ASCID 'LNM$PROCESS_TABLE', ATTR = %REF(LNM$M_CONFINE),, ACMODE = %REF(PSL$C_USER), ITMLST = lnmlst);,> IF NOT .status THEN print('Error: $CRELNM !XL', .status);3 status = $CRELNM( LOGNAM = %ASCID 'SYS$ERROR',U( TABNAM = %ASCID 'LNM$PROCESS_TABLE', ATTR = %REF(LNM$M_CONFINE),G ACMODE = %REF(PSL$C_USER), ITMLST = lnmlst);A> IF NOT .status THEN print('Error: $CRELNM !XL', .status);' status = STR$FREE1_DX( temp_desc); 6 IF NOT .status THEN print('Error: !XL', .status); END;l ! ! Enable activity logging.a ! fblock[FBLOCK_V_ACT_LOG] = / $TRNLNM(LOGNAM = %ASCID'MADGOAT_FTP_ACT_LOG',e TABNAM = lnm$dcl_logical); > IF is_anonymous(fblock[FBLOCK_Q_USERNAME], primetime, thresh," pt_start, pt_end, anon_dir_log) THEN BEGINa IF .ftp_restrict EQL -11 THEN ftp_restrict = FTP$K_RESTRICT_DELETE OR  FTP$K_RESTRICT_CONTROL ORu FTP$K_RESTRICT_WRITE;  !! ! Test logical FTP_user_DIRSi !$ fblock[FBLOCK_V_CHECK_ACCESS] =' check_access_log(anon_dir_log, 1) ORE0 (.ftp_restrict AND FTP$K_RESTRICT_CWD) NEQ 0; status = login_guest( fblock[FBLOCK_Q_USERNAME],E fblock[FBLOCK_L_ANON_BLOCK],e3 primetime, thresh, password_desc, password_desc,  anon_dir_log); IF NOT .status  THEN BEGIND send_error(fblock, .status);( RETURN(send_rein(fblock, 1, .status)); END  ELSE BEGINL! fblock[FBLOCK_V_ANONYMOUS] = 1;H, anon_log('Anonymous FTP session begins.'); IF .status THEN BEGIN% fblock[FBLOCK_V_LOGGED_IN] = 1;T= anon_log('Remote host: !AD [!UB.!UB.!UB.!UB] Port=!UL',T .conn[CONN_L_REMHOSTLEN],O conn[CONN_T_REMHOSTBUF],# .remadr<0,8,0>, .remadr<8,8,0>, % .remadr<16,8,0>, .remadr<24,8,0>,] .conn[CONN_L_REMPORT]);E< anon_log('Local host: !AD [!UB.!UB.!UB.!UB] Port=!UL', .conn[CONN_L_LCLHOSTLEN],E conn[CONN_T_LCLHOSTBUF],# .locadr<0,8,0>, .locadr<8,8,0>,K% .locadr<16,8,0>, .locadr<24,8,0>,D .conn[CONN_L_LCLPORT]);]1 anon_log('Identifier: !AS', password_desc);D" IF .fblock[FBLOCK_V_ACT_LOG]D THEN super_act$fao('FTP: Session begins. User=!AS, Ident=!AS',. fblock[FBLOCK_Q_USERNAME], password_desc);4 status = $FAO(%ASCID'MADGOAT_FTP_!AS_WELCOME', welcome_desc, welcome_desc,  fblock[FBLOCK_Q_USERNAME]);G IF .status/ THEN ftp_announce(fblock, FTP$C_USER_IN, N welcome_desc, 1);A SIGNAL(FTP$_GUEST_LOGGED_IN, 3, password_desc, 0, timezone,I: FTP$_TIMEOUT_MESSAGE, 1, .fblock[FBLOCK_L_TIMEOUT]/60); END; END; END ELSE BEGINC4 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) ORa0 (.ftp_restrict AND FTP$K_RESTRICT_CWD) NEQ 0;$ fblock[FBLOCK_V_LOGGED_IN] = 1;! IF .fblock[FBLOCK_V_ACT_LOG]M8 THEN super_act$fao('FTP: Session begins. User=!AS', fblock[FBLOCK_Q_USERNAME]);P( ftp_announce(fblock, FTP$C_USER_IN,! %ASCID'MADGOAT_FTP_WELCOME'); SIGNAL(FTP$_USER_LOGGED_IN,- 3, fblock[FBLOCK_Q_USERNAME], 0, timezone,.9 FTP$_TIMEOUT_MESSAGE,1, .fblock[FBLOCK_L_TIMEOUT]/60);n END;m END;  %FIa SS$_NORMAL END;ENDHELUDOM1);R" lnmlen = .lnmlen - .len - 1; END; END'F ELSE prime_days[0,1,5,0] = %B'11111'; !Monday thru Friday default IF $TRNLNM(" TABNAM = madgoat_ftp_name_table, ACMODE = exec_mode,] LOGNAM = p*[FTP.FTP]FTP_INPUT.B32;18+,(./u 4J$-J0123KPWO56 ;t7lA;t89YGHJ ! 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_input( ADDRESSING_MODE( EXTERNAL = LONG_RELATIVE," NONEXTERNAL = LONG_RELATIVE), IDENT = 'V2.1-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.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';OWN pasteboard_id, keyboard_pass, keyboard_id, key_table_id,) term_rows, ! height of the screen.* term_columns, ! width of the screen.B preserve_screen : INITIAL(1); ! Don't clear screen on startup. 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),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); 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_iGo MGFTP021.F(J[FTP.FTP]FTP_INPUT.B32;18J|d, 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," [DSC$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;ENDELUDOM*[FTP.FTP]FTP_LISTENER.B32;39+,Z.'/u 4S'%b-J0123KPWO&56h݃706݃89GHJH0Z MGFTP021.FZJ[FTP.FTP]FTP_LISTENER.B32;39S'L ! 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 'FTP_LISTENER'MODULE FTP_LISTENER( IDENT = 'V2.1-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.H! 21-FEB-1994 V2.0-1 Burkhead Commented out the netlib_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_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, then-! don't call netlib_addr_to_name (like4! Multinet, it can't be called at AST level).!--LIBRARY 'SYS$LIBRARY:STARLET';LIBRARY 'FTP_LISTENER';LIBRARY 'FTP';LIBRARY 'FTP_CONN_INFO';LIBRARY 'NETLIB';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;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;GLOBAL, 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? 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';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 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);. status = netlib_assign(CTX = listen_chan);( IF NOT .status THEN RETURN(.status); status = netlib_bind( CTX = listen_chan, PORT = .ftp_listen_port, THREADS = max_servers);( IF NOT .status THEN RETURN(.status);! status = netlib_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')); 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:!-! Issues an ACCEPT on the listener channel.!A! RETURNS: cond_value, longwIA MGFTP021.FZJ[FTP.FTP]FTP_LISTENER.B32;39S'Ford(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; 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;/ status = netlib_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_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);9 accept_failed = 1; !Retry the accept once a server exits  IF .xsrv NEQA 0 THEN BEGIN! IF .xsrv[SRV_L_NETCHN] NEQ 04 THEN netlib_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); 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_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 conn[CONN_L_REMHOSTLEN] = 0 !Don't get the host name ELSE BEGIN $INIT_DYNDESC(host_desc);# status = netlib_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& 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 BINDA reject_msg = %ASCID'421 Access denied, server limit exceeded.'; OWN temp_iosb : IOSBDEF;: listener_log('Accept failed, server limit exceeded');8 status = netlib_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);+ netlib_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'!GLOBAL ROUTINE srv_exit(srv_a) = BEGIN!++! FUNCTIONAL DESCRIPTION:!>! 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 been ! deassigned.!A! RETURNS: cond_value, longword(unsigned), write only, by value! ! PROTOTYPE:!! SRV_EXIT()!! IMPLICIT INPUTS: None.!! IMPLICIT OUTPUTS: None.!! COMPLETION CODES:!2! SS$_NORMAL: normal successful completion.!! SIDE EFFECTS:! ! None.!-- BIND srv = .srv_a : SRVDEF,# conn = .srv[SRV_L_CONN] : CONNDEF;G listener_log('Connection closed for server !XL',.srv[SRV_L_INDEX]);!O! Note: this routine should be executed at AST level, so we don't need to worry'! interference by other srv_exit calls.! IF .srv[SRV_V_CONNECTED]C THEN num_servers = .num_servers-1; !This connection was counted IF .srv[SRV_L_NETCHN] NEQ 09 THEN BEGIN !In case there were too many connections., netlib_disconnect(CTX = srv[SRV_L_NETCHN]);* netlib_deassign(CTX = srv[SRV_L_NETCHN]); END; mem_freeconn(%REF(conn)); mem_freesrv(%REF(srv));!I! If the last accept attempt failed, then try it again. The exiting of aI! server may have cleared up the condition that caused the last accept to ! fail, e.g., an exceeded quota.! IF .accept_failed THEN BEGIN accept_failed = 0; accept_connection(); END; SS$_NORMALEND; ! SRV_EXIT %SBTTL 'SET_UP_SERVER_MBXES'ROUTINE set_up_server_mbxes = BEGIN!++! FUNCTIONAL DESCRIPTION:!B! This routine creates the mailboxes that are common to all of the ! servers.!A! RETURNS: cond_value, longword(unsigned), write only, by value! ! PROTOTYPE:!! SET_UP_SERVER_MBXES()!! IMPLICIT INPUTS: None.!! IMPLICIT OUTPUTS: None.!! COMPLETION CODES:!2! SS$_NORMAL: normal successful completion.!! SIDE EFFECTS:! ! None.!-- LOCAL out_ior : REF IORDEF, trm_ior : REF IORDEF, log_ior : REF IORDEF, status;) status = $CREMBX( CHAN = output_chan, MAXJF C MGFTP021.FZJ[FTP.FTP]FTP_LISTENER.B32;39S'?MSG = 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); END; IF .status THEN BEGIN status = $QIO( CHAN = .output_chan, FUNC = IO$_READVBLK, IOSB = out_ior[IOR_Q_IOSB], ASTADR = server_to_net_ast, ASTPRM = .out_ior, P1 = out_ior[IOR_T_BUF], P2 = IOR_S_BUF);* IF NOT .status THEN mem_freeior(out_ior); END; IF .status THEN status = $CREMBX( CHAN = trm_chan, MAXMSG = ACC$K_TERMLEN, BUFQUO = 4*ACC$K_TERMLEN, PRMFLG = 1, LOGNAM = trm_mbxnam,* 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; IF .status THEN BEGIN status = $QIO( CHAN = .trm_chan, FUNC = IO$_READVBLK, IOSB = trm_ior[IOR_Q_IOSB],t 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;D IF .status THEN status = $CREMBX( CHAN = log_chan,C MAXMSG = IOR_S_BUF, BUFQUO = 2*IOR_S_BUF, PRMFLG = 1, LOGNAM = log_mbxnam,* PROMSK = %X'5F0F'); !S, O:RWPL, G, W:WL IF .status THEN BEGIN log_ior = mem_getior(); status = check_mem(log_ior); END;  IF .status THEN BEGIN status = $QIO(o CHAN = .log_chan,a FUNC = IO$_READVBLK, IOSB = log_ior[IOR_Q_IOSB], ASTADR = server_to_log_ast,_ ASTPRM = .log_ior, P1 = log_ior[IOR_T_BUF], P2 = IOR_S_BUF);* IF NOT .status THEN mem_freeior(log_ior); END;T .statuspEND; ! set_up_server_mbxes o%SBTTL 'EXIT_HANDLER' !ROUTINE exit_handler : NOVALUE = RBEGIN!++! FUNCTIONAL DESCRIPTION:i!5! Called to clean up the mess if the listener exits..I!H! RETURNS: None.!O ! PROTOTYPE:!s! EXIT_HANDLER()!! IMPLICIT INPUTS: None.o! ! IMPLICIT OUTPUTS: None. !A! COMPLETION CODES: !T! None.e!o! SIDE EFFECTS:m!s ! None. !--a LOCALo status; EXTERNAL ROUTINE ftp_in_abort;& in_exithnd = 1; !Don't $EXIT again# $DELMBX( CHAN = .output_chan );1# $DASSGN( CHAN = .output_chan );e $DELMBX( CHAN = .trm_chan ); $DASSGN( CHAN = .trm_chan ); $DELMBX( CHAN = .log_chan ); $DASSGN( CHAN = .log_chan );!x;! Close all of the connections and kill all of the servers.e!L ftp_in_abort();T END; ! exit_handlere n%SBTTL 'PARSE_CMD'ROUTINE parse_cmd= dBEGIN!++1! FUNCTIONAL DESCRIPTION: !m;! This routine reconstructs the command line and parses it.o!cA! RETURNS: cond_value, longword(unsigned), write only, by value! ! PROTOTYPE:!d! PARSE_CMD()a!S! IMPLICIT INPUTS: None. !0! IMPLICIT OUTPUTS: None.k!r! COMPLETION CODES:! 2! SS$_NORMAL: normal successful completion.! ! SIDE EFFECTS:_!e ! None.S!--9 LOCALr status, cmd : $BBLOCK[DSC$C_S_BLN]; $INIT_DYNDESC(cmd); : status = LIB$GET_FOREIGN(cmd); !Get the max # servers IF .status8 THEN chk_max_servers = .cmd[DSC$W_LENGTH] GTRU 0 AND" OTS$CVT_TU_L(cmd, max_servers); STR$FREE1_DX(cmd); RETURN(.status); END; !parse_cmdiENDiELUDOM called at AST level).!--LIBRARY 'SYS$LIBRARY:STARLET';LIBRARY 'FTP_LISTENER';LIBRARY 'FTP';LIBRARY 'FTP_CONN_INFO';LIBRARY 'NETLIB';BUIL!*[FTP.FTP]FTP_LISTENER_CMDS.B32;57+, .K/u 4PKId-J0123KPWOJ56 )剄7`p剄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.<! 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_listener_cmds( ADDRESSING_MODE ( EXTERNAL = LONG_RELATIVE," NONEXTERNAL = LONG_RELATIVE), IDENT = 'V2.1',$ 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.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;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 K MGFTP021.F J![FTP.FTP]FTP_LISTENER_CMDS.B32;57PK9connection 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;EXTERNAL ROUTINE mem_getior, mem_freeior, set_timer, get_hashed_pwd, is_anonymous, ftp_in_finish, ftp_handler,0 STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL),, STR$TRIM : BLISS ADDRESSING_MODE(GENERAL),9 STR$CASE_BLIND_COMPARE : 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, !...above trm_mbxnam : $BBLOCK,+ lnm$system_table; !Defined in FTP_IN.B32MACRO delete_info_mbx(srv)= BEGIN BIND _srv = srv : SRVDEF; IF ._srv[SRV_L_INFCHN] NEQ 0 THEN BEGIN LOCAL tmp_status; %IF debug8 %THEN print('delete_info_mbx : info channel = !XW', ._srv[SRV_L_INFCHN]); %FI6 tmp_status = $DELMBX(CHAN = ._srv[SRV_L_INFCHN]); %IF debugH %THEN print('delete_info_mbx : $DELMBX status = !XL', .tmp_status); %FI6 tmp_status = $DASSGN(CHAN = ._srv[SRV_L_INFCHN]); %IF debugH %THEN print('delete_info_mbx : $DASSGN status = !XL', .tmp_status); %FI _srv[SRV_L_INFCHN] = 0; END; END%;!++! ! FTP_In-compatibility routines:!!-- GROUTINE check_password(password_a, hpwd_a, encrypt, salt, username_a) =!++! Functional Description:!H! Hash the password passed in and compare it to the hashed password from ! SYSUAF.! ! Parameters:!<! password_a - address of a string descriptor containing the! password to check.@! hpwd_a - address of a quadword containing the hashed password! to match.#! encrypt - encryption method used! salt - random password salt<! username_a - address of a string descriptor containing the8! username associated with the hashed password. The8! username is used by some of the encryption methods9! to insure that 2 users with the same password don't)! get the same hashed password value.!-- BEGIN BIND" password = .password_a : $BBLOCK," hpwd = .hpwd_a : VECTOR[2,LONG]," username = .username_a : $BBLOCK; LOCAL hashed : VECTOR[2,LONG],# upper_pass : $BBLOCK[DSC$C_S_BLN],# upper_user : $BBLOCK[DSC$C_S_BLN],! hash_desc : $BBLOCK[DSC$C_S_BLN] PRESET([DSC$W_LENGTH] = 8,# [DSC$B_CLASS] = DSC$K_CLASS_S,# [DSC$B_DTYPE] = DSC$K_DTYPE_T, [DSC$A_POINTER]= hashed), status; EXTERNAL ROUTINE- STR$UPCASE : BLISS ADDRESSING_MODE(GENERAL); %IF debug %THEN print('check_password'); %FIG $INIT_DYNDESC(upper_pass); !VMS automatically uppercases passwordsE $INIT_DYNDESC(upper_user); !...and usernames as they are read in$ STR$UPCASE(upper_pass,password);$ STR$UPCASE(upper_user,username);P status = get_hashed_pwd(hash_desc, upper_pass, .encrypt, .salt, upper_user); IF .statusH THEN status = (.hashed[0] EQL .hpwd[0] AND .hashed[1] EQL .hpwd[1]); .status END; $ROUTINE reject_login_ast(fblock_a) =!++! Functional Description:!B! This routine is called once an FTP connection has been forced to/! wait sufficiently long after a login failure.! ! Parameters:!9! FBlock The block that contains all the info about this! connection.!-- BEGIN BIND# fblock = .fblock_a : FBLOCKDEF,( srv = .fblock[FBLOCK_L_SRV] : SRVDEF; LOCAL* fblock_enable : VOLATILE INITIAL(FBlock), status; ENABLE ftp_handler(fblock_enable); %IF debug$ %THEN print('reject_login_ast'); %FI/ IF .srv[SRV_L_LOG_FAILS] EQL .lgi_retry_lim THEN BEGIN6 fblock[FBLOCK_V_QUITTING] = 1; !Prepare to shut down.7 SIGNAL(FTP$_NOT_LOGGED_IN, 0, .srv[SRV_L_FINALSTS], 0, FTP$_LOGIN_CLOSED); END= ELSE SIGNAL(FTP$_NOT_LOGGED_IN, 0, .srv[SRV_L_FINALSTS]); SS$_NORMAL END; ! reject_login_ast +ROUTINE reject_login(fblock_a, login_sts) =!++! Functional Description:!B! This routine is called when a login attempt fails. It bumps theC! count of login failures and locks up this connection for a coupleD! of seconds. After a couple of seconds, either the connection willF! be closed, if the number of login failures exceeds lgi_retry_lim, or.! a rejection message will be sent, otherwise.!E! Note : no more commands will be accepted from this connection untilF! the a response is sent. (Once the response is sent, Send_Cmd_Ast, in@! FTP_In, resets the FBLOCK_L_State to FBLOCK_K_State_Cmd_Wait.)! ! Parameters:!9! FBlock The block that contains all the info about this! connection.?! login_sts Value of a condition code describing why this login! attempt was rejected.!-- BEGIN BIND# fblock = .fblock_a : FBLOCKDEF,( srv = .fblock[FBLOCK_L_SRV] : SRVDEF; LOCAL status; %IF debug %THEN print('reject_login'); %FI% srv[SRV_L_FINALSTS] = .login_sts;3 srv[SRV_L_LOG_FAILS] = .srv[SRV_L_LOG_FAILS]+1; srv[SRV_L_LOGINFLGS] = 0;* set_timer(fblock, 2, reject_login_ast) END; ! reject_login!++!! Server routines:!B! The following routines set up and maintain the connection to the1! server process associated with this connection.!!-- .ROUTINE create_server(fblock_a, anon_pass_a) =!++! Functional Description:!E! This routine is called once we have confirmed the login informationF! for the FTP connection. It creates a server process and applies the=! networking duct tape to pass control to the server process.!E! Note : This routine assumes that it is executing in AST mode. Some@! of the other user-mode ASTs could interfere with it otherwise.! ! Parameters:!9! FBlock The block that contains all the info about this! connection.9! anon_pass Address of a string descriptor containing the4! anonymous password. This parameter is only used! with anonymous accounts.!-- BEGIN BIND# fblock = .fblock_a : FBLOCKDEF,( srv = .fblock[FBLOCK_L_SRV] : SRVDEF,/ conn = .fblock[FBLOCK_L_CONN_INFO] : CONNDEF,# index = srv[SRV_L_INDEX] : LONG,7 server_com = %ASCID'MADGOAT_ROOT:[COM]FTP_SERVER.COM'; MACRO2 output_rest = %ASCIC'DECNET',%ASCIC'',%ASCIC''%; LOCAL! username : $BBLOCK[DSC$C_S_BLN],# inp_mbxnam : $BBLOCK[DSC$C_S_BLN], host : $BBLOCK[DSC$C_S_BLN], inp_ior : REF IORDEF, inf_ior : REF IORDEF,- status : UNSIGNED LONG INITIAL(SS$_NORMAL),B output_buf : $BBLOCK[2+%CHARCOUNT(output_rest)+UAF$S_USERNAME+1],$ output_desc : $BBLOCK[DSC$C_S_BLN]; EXTERNAL ROUTINE- STR$CONCAT : BLISS ADDRESSING_MODE(GENERAL),- STR$UPCASE : BLISS ADDRESSING_MODE(GENERAL),- LIB$GETDVI : BLISS ADDRESSING_MODE(GENERAL),- LIB$GETJPI : BLL MGFTP021.F J![FTP.FTP]FTP_LISTENER_CMDS.B32;57PK5 ISS ADDRESSING_MODE(GENERAL),. LIB$SYS_FAO : BLISS ADDRESSING_MODE(GENERAL); %IF debug6 %THEN print('create_server : index = !XL',.index); %FI $INIT_DYNDESC(inp_mbxnam); $INIT_DYNDESC(username);!! Set up to create the server.!/ status = $CREMBX( CHAN = srv[SRV_L_INPCHN], MAXMSG = IOR_S_BUF, BUFQUO = IOR_S_BUF,* PROMSK = %X'FF06'); !S:RL, O:RWPL, G, W IF .status THEN status = LIB$GETDVI(: %REF(DVI$_DEVNAM), srv[SRV_L_INPCHN], 0, 0, inp_mbxnam);!L! For anonymous logins, the anonymous password is appended to the end of the! SYS$NET string.!. IF .status AND .fblock[FBLOCK_V_ANONYMOUS]O THEN status = STR$CONCAT(inp_mbxnam, inp_mbxnam, %ASCID' "', .anon_pass_a); IF .statusB THEN status = STR$UPCASE(username, fblock[FBLOCK_Q_USERNAME]); IF .status THEN BEGIN !H ! Fill in the OUTPUT parameter. The descriptor's buffer should take ! the following form: ! ! WORD - LGI$M_NET_PROXY5 ! ASCIC - the username of the process to create5 ! ASCIC - the default username(used if an error ! occurs)$ ! ASCIC - the default password# ! ASCIC - the default account ! output_buf[0,0,16,0] = 1;/ output_buf[2,0,8,0] = .username[DSC$W_LENGTH];: CH$MOVE(.username[DSC$W_LENGTH],.username[DSC$A_POINTER], output_buf[3,0,0,0]);= CH$MOVE(%CHARCOUNT(output_rest),UPLIT(%STRING(output_rest)),/ output_buf[3+.username[DSC$W_LENGTH],0,0,0]);7 output_desc[DSC$W_LENGTH] = 3+.username[DSC$W_LENGTH]+ %CHARCOUNT(output_rest);* output_desc[DSC$B_DTYPE] = DSC$K_DTYPE_T;* output_desc[DSC$B_CLASS] = DSC$K_CLASS_S;) output_desc[DSC$A_POINTER] = output_buf;!! Create the server.! status = $CREPRC(: PIDADR = srv[SRV_L_PID], !Save for termination msg check' BASPRI = 5, !Start with a base of 5* IMAGE = %ASCID'SYS$SYSTEM:LOGINOUT.EXE',2 INPUT = server_com, !Command proc to set up the !...server OUTPUT = output_desc,( ERROR = inp_mbxnam, !Value of SYS$NET UIC = %X'00010004', MBXUNT = .trm_unit,( STSFLG = PRC$M_NETWRK OR PRC$M_HIBER); %IF debugE %THEN print('Creating the server process : status = !XL, PID = !XL', .status,.srv[SRV_L_PID]); %FI END;!F! Create an info mailbox over which the connection information will be.! sent to the LOGIN.COM of the server process.! IF .status THEN BEGIN; status = LIB$SYS_FAO(%ASCID'MADGOAT_FTP_SRV_INFO_MBX_!XL',$ 0, inp_mbxnam, .srv[SRV_L_PID]); IF .status THEN status = $CREMBX( CHAN = srv[SRV_L_INFCHN], PRMFLG = 1, LOGNAM = inp_mbxnam, MAXMSG = host_name_max_size,! BUFQUO = host_name_max_size*2,- PROMSK = %X'6F06'); !S:RL, O:RWPL, G, W:RL %IF debug@ %THEN print('For server PID = !XL, info mailbox channel = !XW',( .srv[SRV_L_PID], .srv[SRV_L_INFCHN]); %FI? $WAKE(PIDADR = srv[SRV_L_PID]); !Mailbox created, OK to allow !...process to execute END;!! Allocate a buffer and IOSB.! IF .status THEN BEGIN inf_ior = mem_getior(); IF .inf_ior EQLA 0 THEN status = SS$_INSFMEM% ELSE inf_ior[IOR_L_ASTPRM] = fblock; END;!I! Send the host IP address. The host name will be sent next. If no host7! name is available, the IP address will be sent again.! IF .status THEN BEGIN4 BIND remadr = conn[CONN_L_REMADR] : VECTOR[4,BYTE];) host[DSC$W_LENGTH] = host_name_max_size;# host[DSC$B_CLASS] = DSC$K_CLASS_S;# host[DSC$B_DTYPE] = DSC$K_DTYPE_T;* host[DSC$A_POINTER] = inf_ior[IOR_T_BUF];: status = LIB$SYS_FAO(%ASCID'!UB.!UB.!UB.!UB', host, host, .remadr[0], .remadr[1], .remadr[2], .remadr[3]); IF .status THEN status = $QIO( CHAN = .srv[SRV_L_INFCHN], FUNC = IO$_WRITEVBLK, IOSB = inf_ior[IOR_Q_IOSB], ASTADR = send_info_ast, ASTPRM = .inf_ior, P1 = .host[DSC$A_POINTER], P2 = .host[DSC$W_LENGTH]);* IF NOT .status THEN mem_freeior(inf_ior); END;I STR$FREE1_DX(inp_mbxnam); !Free the dynamic descriptors set up above. STR$FREE1_DX(username);!'! Set up communication with the server.! IF .status THEN BEGIN inp_ior = mem_getior(); IF .inp_ior EQLA 0 THEN status = SS$_INSFMEM% ELSE inp_ior[IOR_L_ASTPRM] = fblock; END; IF .status THEN BEGIN !G ! Fill in the CONNDEF structure with the values that were specified; ! by PORT, STRU, etc. commands before the USER command. !2 conn[CONN_L_DADDR] = .fblock[FBLOCK_L_DATA_HOST];2 conn[CONN_L_DPORT] = .fblock[FBLOCK_L_DATA_PORT];, conn[CONN_L_MODE] = .fblock[FBLOCK_L_MODE];, conn[CONN_L_TYPE] = .fblock[FBLOCK_L_TYPE];6 conn[CONN_L_TYPE_SIZE] = .fblock[FBLOCK_L_TYPE_SIZE];, conn[CONN_L_STRU] = .fblock[FBLOCK_L_STRU]; !/ ! Send the filled-in CONNDEF to the server. ! status = $QIO( CHAN = .srv[SRV_L_INPCHN], FUNC = IO$_WRITEVBLK, IOSB = inp_ior[IOR_Q_IOSB], ASTADR = server_created_ast, ASTPRM = .inp_ior,# P1 = .fblock[FBLOCK_L_CONN_INFO], P2 = CONN_S_CONNDEF);* IF NOT .status THEN mem_freeior(inp_ior); END;n IF .status? THEN fblock[FBLOCK_L_IN_STATE] = FBLOCK_K_IN_STATE_PASSTHRU ELSE BEGIN srv[SRV_V_LOGGING_OUT] = 1; dasgn_srv_chans(srv);( SIGNAL(FTP$_NOT_LOGGED_IN, 0, .status); END;1 SS$_NORMAL END; ! create_server rROUTINE pid_to_fblock(pid) =!++ ! Functional Description:r!sD! This routine returns the address of the fblock associated with the@! server of PID pid. It returns 0, if no matching fblock can be! found.!i ! Parameters:l!o.! pid - value of the pid of the server to find!-- BEGINr EXTERNAL fblock_queue : VECTOR[2,LONG];G LOCAL& fblock_a : INITIAL(.fblock_queue[0]);% WHILE .fblock_a NEQA fblock_queueN DO BEGIN BIND% fblock = .fblock_a : FBLOCKDEF,+ srv = .fblock[FBLOCK_L_SRV] : SRVDEF;e IF .srv[SRV_L_PID] EQL .pid- THEN RETURN(fblock); !Found the right fblockn$ fblock_a = .fblock[FBLOCK_L_FLINK]; END;  0 !No matching pids END; o'ROUTINE reinitialize_server(fblock_a) =!++e! Functional Description:s!TF! The server exited with a REIN command. Set up this server to accept! more login attempts.! ! Parameters:t!e<! fblock_a - address of the block describing this connection!--k BEGIN- BIND" fblock = .fblock_a : FBLOCKDEF,' srv = .fblock[FBLOCK_L_SRV] : SRVDEF,n. conn = .fblock[FBLOCK_L_CONN_INFO] : CONNDEF; LOCALm/ fblock_enable : LONG VOLATILE INITIAL(fblock);i ENABLE ftp_handler(fblock_enable);# fblock[FBLOCK_V_LOGGED_IN] = 0;r# fblock[FBLOCK_V_ANONYMOUS] = 0;o9 fblock[FBLOCK_L_IN_STATE] = FBLOCK_K_IN_STATE_NORMAL;t! IF .fblock[FBLOCK_V_REJECTED]E THEN BEGIN !3I ! This login attempt was rejected after a server was created. FinishO$ ! sending the rejection message. !1 fblock[FBLOCK_V_REJECTED] = 0;$7 reject_login(fblock, .fblock[FBLOCK_L_REJECT_STATUS]);u END ELSE BEGIN !iE ! Normal (user-requested) logout. Clean up and send a successful ! reply. !  srv[SRV_L_LOGINFLGS] = 0; srv[SRV_L_LOG_FAILS] = 0;8 SIGNAL(FTP$_SERVICE_READY, 5, .conn[CONN_L_LCLHOSTLEN],. conn[CONN_T_LCLHOSTBUF], %ASCID FTP_VERSION, %IF %BLISS(BLISS32E)d %THEN %ASCID'AXP' %ELSE %ASCID'VAX' %FI ,%ASCID FTP_VERSION_DATE,.8 FTP$_TIMEOUT_MESSAGE,1, .fblock[FBLOCK_L_TIMEOUT]/60); END;m SS$_NORMAL END; s*GLOBAL ROUTINE server_cleanup_ast(ior_a) =!++R! Functional Description:!TF! This routine is called when the read request completes on M';`ay ;392JSx1{g7A7X&vVOabpq3f7W =,aS$_@.6 gf'2#~ F"vGYJ^ $QP+- }dGy o,dPh!Nw Es.+$v,o+3XI8Ef}` {n}vAoF 03,G0};eF*2cs'n\1&~X0p36O}fV~{+%Q: Qf#wy8]AKx7B3:Zl\<^"3lIg5G eyzllBb/ 'DUsm"b\ Bj_ d-' = QE`TuiW_ !B;,*gq i&UBCmew+#OGX T_JK8R{t!N-/ !:_#$MULm;(@U@e=>,xl?/&p![V,Q;POERHeD8]7G5]2 u>]q)J*sG2l`v;{DB)p8$%&1KmA-bRm\yy(=^8=|0zT@ Xate]m$!"UqRX!4TtSjg >a'ijiX5x$T<8iQ._k`y;F/IU=mH 4jMMSaQipm9^r_nl[*wjsjyhl dS<"J &AI%jmUb Hw1Im&64J*R @?NOm}\,B<) ]*@kSFInb{u|'6CiwC2Zks5?uB3))%AzpvF.G`_Q/B[O>8El(qu tFN )@#^Y2Z~>saM1Pwa$E8vs<"<'2D67nS5^O|[4^Ym?IOPlaN<YOu9cOQOtEs-W B>'omf|tMZx4mz^4|^Y9 g{:gm=3b4q}rS,}-RM N[rJ ,c~B?W/Y[^Ua5eG CQh|:gCk^-KwR MQbhN)QM<^@ &Q-46x%a=Ni{hah{O5k!@sj1b,ckr7^~=1gE'D gZyw<6^ WXQG^hl 1:L_r byPCO2xq&&A[M T~4J]oyDLkIP5?Yke&/H I@Gjn_9 U]RqSEV %.0;[%-_Y"B^O,*U?f &)@r4$na`wzP)<8 x$z7E-n1MF5+@ s=x+ K48 _nd;G+v b8Np`K7F)1nEm Ar.RZk De X%q GJgGFoQEuv3K<[bp 9fNB :vIT_H8hrG>k^7bNT3"ogiA QqD';,* QRuHsf JOX O5KAR5;?>3i-OaZB[ |.@Z&* [t{-g|GzNH&htKF?(Y_sj*o:{$TzG87 vCYtI=P; (vzF-`?!}y-> c}PpUFZ~l->E])t{q|2yt?M/sWGPK}i7 D'-J{-k+B k/aCzAO[#CKFx-Q v(z|HPB8RO >  2u E&R}Ss6%A=N?^q7AuD|X\>2|GAxLsq;J}Mv]"E1 ?SBO[OoF,{Ycic|jUqGfcdcJKS6pzC ?Md825U;hbi3{-Iq] X!\:T{ic;sW)u;$n.BriwK)3St`^+?nb3/}&8(oM#3WGvK 4Pv& (F# QhHYb.iU2I |)P]O)52s`P\X3?3mty<f@OnW\?!XiUCJEqlQ7&qR]:$bT\+D!JIS_UP)1*" K2h%6)%UN(1_jQ4"%2%&%Kb.<l|~<+u)+]Ix8wO8j h=L(yxa-k* @zc|JE_-s#llCHVWx75KH(Udu*La!f6 AA,cTj][ `w)J^T$}5nWl;%:jkl9fj!iZ|tT{#!l|)18\~mt 1"==9@$.O`w;k&,o:Oy*bU"Z\p@?%`Eb#;$f>|` #TVVS5dliWMI"{ FD v] mMCGi"<3vughw:5 &v AvRt4x"cQ/OO{cj+h|)k,qh7-8hD8b1]9lVDNlo;_jlTL/5:FUMy$aZkjRch'+UJ2#+A1Nwh1X`-EX@1,By1SGY`%~vs= 2& dFUZn+G)@GmrlsM-KW|aqCa[> :TpM?4Cp5Yz=5pP4Q^T{ xr8-,DC jiSS q!c;0WFn(t?pU=Q%Ag r ~_<R|>5>dpG<9%*9e%oFr{7gztl)d Q)N_ )Ap\ /CgO6OOWkgj&%Ofz~o}N! '.nOtpTl~))45+ =A^MT+EQFC ~2:Z(P ,YBV3G~"XVUH#o*9Hf^/.to%^& `Y }XiM!wV}zxI)kKxg*Uh, QmI~lk'eeqIN^nG{h@}B_o9A#>S` B4D~!]OFJBGR?K  SxyyJ )\*Nwb}Rg.IHLt!{i&-xFph?tG=6 tVab!B1m8;U) HEH~b{CQ mBZe0IfS&m@Sl*fX3s20Z$2]X&Wh^{[p~c#-z2{) wp`TI!NWoVuMG:E\FxUQvr3:_>{^c|T˒w9&C<w@ $Xx# 6ڲE&kbxe? 4MF]E^PYy=!Di}xE&h ;u" flPcF 8tT2v~kr M*SHY@_h(.``&j35fcWQT2k 56B7*23gA^ X^u:)W>gwM~+M=e#.5 gbK@TFYn1Pllu3aef)kQhMT-x^g"oOfLV\[$([-F`|?d[$ 20JWQ>(q_7`u)gH*>TOD'W0!ai9?I]W?SCT?5Te( 0Z(R50}_2x0?`;y~g=Q '^#s_% JwYJougVm7g"d/eiScX}sg,z_xXS3 0`nZ_]kW?zC]9H 1`ue?<'RTf(^U FaE R(]*mmW/mFF }8)*$+/V0KAX1|kiTD;&5 uZ(J<04iYf+sHY0b)GT6g6(&x\[?-t35gZ ,(N>JR>JvQs[qh+p@Tw`_=Hp{g!xTt%gD!Wi*fg&F5}$je6[2]ejeOCbJ5oZD4jE#0 bn'W sz lv$\5K ^&n/OVsA:kKU @>#Z0wkiUI0Gjad%_5?GK^ 6Zf C{8'D*ccL6|)W[6@- LZte)sT>o:sKT'Wy={KRcV$t8 R7rx^}l}jtLbg!= %=g6o Ej+6 Gz-%;wddb;ys<2EpfzBB]7>#4m6mFRi^F!]Q!7BU%)VSvV[1zY12TL&`k%=P" k3]{3'!PP+RaNf\;p Rc0[W_"_+LHx.';-9I6oBqTu5u?e16tr\%MjX U(Vzcu\}[TW7;^a}Yt%?h#3|+b,z7Uk8p #`i,E.&{NI]zY=RY&~ugQ3zF sW5=#X.]bXA!w)z\JfIZ&{N mV ;)D^8%\i*}Rg_OLz6M#TDADj -dr7]Le`a&b$,E(*+FM{&=.1~{{6M*}' 0PNIAyr'9 G3 _+AF~ba4m<0CA1S,BVeyO>| ]MKMRDsM7$]->):BsqVc_x S(+!R4c.k  ~-mL9 t6Gw>YpYn ' V}YyxBVsNAH+Ѷ7'sKc7}FyWYLk {%jw^I,QUS%1~.eR,}_u8z y(5:z6WM]}9M(&5Sh+C \lstlz)"/xN MGFTP021.F J![FTP.FTP]FTP_LISTENER_CMDS.B32;57PKF&a server'sB! termination mailbox. We need to make sure the PIDs match up and.! then close down all of the server mailboxes.!G ! Parameters:1! E! ior_a - address of the I/O request block associated with this read.!-- BEGIN  BIND ior = .ior_a : IORDEF,! acct = ior[IOR_T_BUF] : $BBLOCK,s! rein = ior[IOR_T_BUF] : REINDEF,t" iosb = ior[IOR_Q_IOSB] : IOSBDEF; LOCALa fblock : REF FBLOCKDEF, status;+ IF .in_exithnd THEN RETURN(SS$_NORMAL);R %IF debugRL %THEN print('server_cleanup_ast : IOR = !XL, status = !XW, PID=!XL',ior,. .iosb[IOSB_W_STATUS],.iosb[IOSB_L_ADDRESS]); %FIR" status = .iosb[IOSB_W_STATUS]; IF .status THEN BEGIN/ fblock = pid_to_fblock(.iosb[IOSB_L_ADDRESS]);. IF .fblock NEQA 0 THEN BEGIN BINDl' srv = .fblock[FBLOCK_L_SRV] : SRVDEF;s1 IF(.iosb[IOSB_W_COUNT] EQL ACC$K_TERMLEN AND* .acct[ACC$W_MSGTYP] EQL MSG$_DELPROC AND' .acct[ACC$L_PID] EQL .srv[SRV_L_PID])  THEN BEGINs dasgn_srv_chans(srv);oA IF NOT .acct[ACC$L_FINALSTS] AND NOT .srv[SRV_V_SERVER_CREATED]d THEN BEGIN !n; ! Error creating a server process. An error was returnedd8 ! before the listener had communicated with the server? ! process. Assume that the error was related to creating theo; ! server process, e.g., no read access to FTP_SERVER.COM.  !d; fblock[FBLOCK_L_IN_STATE] = FBLOCK_K_IN_STATE_NORMAL;g2 reject_login(.fblock,.acct[ACC$L_FINALSTS]); ENDg ELSE IF .srv[SRV_V_REIN]# THEN reinitialize_server(.fblock)_ ELSE BEGINA listener_log('Shutting down server !XL',.srv[SRV_L_INDEX]);o3 ftp_in_finish(.fblock,.acct[ACC$L_FINALSTS]);, END; ENDo7 ELSE IF .iosb[IOSB_W_COUNT] EQL REIN_S_REINDEF ANDi' .rein[REIN_W_MSGTYP] EQL MSG_REIN_ THEN BEGINi srv[SRV_V_REIN] = 1; !S+ ! Save the current Mode, Stru, Type, etc., !R3 fblock[FBLOCK_L_DATA_HOST] = .rein[REIN_L_DADDR];L3 fblock[FBLOCK_L_DATA_PORT] = .rein[REIN_W_DPORT];E- fblock[FBLOCK_L_MODE] = .rein[REIN_B_MODE];N- fblock[FBLOCK_L_TYPE] = .rein[REIN_B_TYPE];,7 fblock[FBLOCK_L_TYPE_SIZE] = .rein[REIN_B_TYPE_SIZE];o- fblock[FBLOCK_L_STRU] = .rein[REIN_B_STRU]; 5 fblock[FBLOCK_V_REJECTED] = .rein[REIN_V_REJECTED];O? fblock[FBLOCK_L_REJECT_STATUS] = .rein[REIN_L_REJECT_STATUS];: ENDK %IF debug %THENB ELSE print('Bad termination-mailbox message from server !XL', .srv[SRV_L_INDEX]);  %FI END %IF debugR %THEN_G ELSE print('Termination message received from non-server process !XL',C .iosb[IOSB_L_ADDRESS]) %FI  END? ELSE IF .status EQL SS$_ENDOFFILE THEN status = SS$_NORMAL;o" IF .status THEN status = $QIO( CHAN = .trm_chan, FUNC = IO$_READVBLK,= IOSB = iosb,H ASTADR = server_cleanup_ast,p ASTPRM = ior, P1 = ior[IOR_T_BUF],L P2 = ACC$K_TERMLEN);I IF NOT .status THEN BEGIN %IF debugC %THEN print('Error reading the termination mailbox, status = !XW',t .iosb[IOSB_W_STATUS]); %FI" $EXIT(CODE=.iosb[IOSB_W_STATUS]); END; SS$_NORMAL END; ! server_cleanup_aste 'GLOBAL ROUTINE dasgn_srv_chans(srv_a) =w!++,! Functional Description:r!eF! This routine deassigns all of the mailboxes channels associated with!! a particular server connection.s!r ! Parameters:F!%! srv_a - address of the server blocka!--s BEGINg BIND srv = .srv_a : SRVDEF; %IF debug# %THEN print('dasgn_srv_chans');t %FIe IF .srv[SRV_L_INPCHN] NEQ 0 THEN BEGINC $QIOW( CHAN = .srv[SRV_L_INPCHN], FUNC = IO$_WRITEOF OR IO$M_NOW);a& $DASSGN( CHAN = .srv[SRV_L_INPCHN] ); srv[SRV_L_INPCHN] = 0;c END;i IF .srv[SRV_L_INFCHN] NEQ 0  THEN delete_info_mbx(srv); SS$_NORMAL END; ! dasgn_srv_chans w)GLOBAL ROUTINE server_to_net_ast(ior_a) = !++h! Functional Description:! E! This routine is called when a read completes on the server's outputa=! mailbox. It passes on the information read to the network.A! ! Parameters:O!,D! ior_a - address of the I/O request block associated with this read!--_ BEGINs BIND ior = .ior_a : IORDEF," iosb = ior[IOR_Q_IOSB] : IOSBDEF; LOCAL] new_ior : REF IORDEF,[ fblock : REF FBLOCKDEF,T status;+ IF .in_exithnd THEN RETURN(SS$_NORMAL);L %IF debugCK %THEN print('server_to_net_ast : IOR = !XL, status = !XW, PID=!XL',ior,c. .iosb[IOSB_W_STATUS],.iosb[IOSB_L_ADDRESS]); %FIV IF .iosb[IOSB_W_STATUS]s THEN BEGIN/ fblock = pid_to_fblock(.iosb[IOSB_L_ADDRESS]);  IF .fblock NEQA 0 THEN BEGINr BINDo' srv = .fblock[FBLOCK_L_SRV] : SRVDEF;;# IF NOT .srv[SRV_V_LOGGING_OUT]s THEN BEGINn new_ior = mem_getior(); . IF .new_ior EQLA 0 THEN status = SS$_INSFMEM ELSE BEGIN LOCAL " out_desc : $BBLOCK[DSC$C_S_BLN]1 PRESET( [DSC$W_LENGTH] = .iosb[IOSB_W_COUNT], # [DSC$B_CLASS] = DSC$K_CLASS_S,r# [DSC$B_DTYPE] = DSC$K_DTYPE_T,o+ [DSC$A_POINTER] = new_ior[IOR_T_BUF]);g% new_ior[IOR_L_ASTPRM] = fblock;s1 CH$MOVE(.iosb[IOSB_W_COUNT],ior[IOR_T_BUF],n new_ior[IOR_T_BUF]); status = netlib_send( ' CTX = .fblock[FBLOCK_L_TCP_CHANNEL], IOSB = new_ior[IOR_Q_IOSB], PUSH = 1, ASTADR = free_ior_ast,V ASTPRM = .new_ior,, STR = out_desc);E END; IF NOT .status THEN BEGIN@ mem_freeior(new_ior);!For errors after this point, the AST+ !...will take care of freeing the iorH! srv[SRV_V_LOGGING_OUT] = 1;] dasgn_srv_chans(srv); END; END; END %IF debugA %THENB ELSE print('Output message received from non-server process !XL', .iosb[IOSB_L_ADDRESS]) %FI ;O END2 ELSE IF .iosb[IOSB_W_STATUS] EQL SS$_ENDOFFILE* THEN iosb[IOSB_W_STATUS] = SS$_NORMAL; IF .iosb[IOSB_W_STATUS]u$ THEN iosb[IOSB_W_STATUS] = $QIO( CHAN = .output_chan, FUNC = IO$_READVBLK, IOSB = ior[IOR_Q_IOSB],f ASTADR = server_to_net_ast,t ASTPRM = ior,c P1 = ior[IOR_T_BUF], P2 = IOR_S_BUF); IF NOT .iosb[IOSB_W_STATUS]e THEN BEGIN %IF debug> %THEN print('Error reading the output mailbox, status = !XW', .iosb[IOSB_W_STATUS]);d %FI" $EXIT(CODE=.iosb[IOSB_W_STATUS]); END;  SS$_NORMAL END; ! server_to_net_ast )GLOBAL ROUTINE server_to_log_ast(ior_a) =C!++t! Functional Description:e!sD! This routine is called when a read completes on the listener's logD! mailbox. It writes the information read to the listener log file.! ! Parameters:e! D! ior_a - address of the I/O request block associated with this read!--D BEGIN  BIND ior = .ior_a : IORDEF," iosb = ior[IOR_Q_IOSB] : IOSBDEF; LOCALE fblock : REF FBLOCKDEF, tmp_desc : $BBLOCK[DSC$C_S_BLN]1 PRESET([DSC$W_LENGTH] = .iosb[IOSB_W_COUNT],_# [DSC$B_CLASS] = DSC$K_CLASS_S,F# [DSC$B_DTYPE] = DSC$K_DTYPE_T,r& [DSC$A_POINTER]= ior[IOR_T_BUF]), status;+ IF .in_exithnd THEN RETURN(SS$_NORMAL);t %IF debugaK %THEN print('server_to_log_ast : IOR = !XL, status = !XW, PID=!XL',ior,n. .iosb[IOSB_W_STATUS],.iosb[IOSB_L_ADDRESS]); %FIs IF .iosb[IOSB_W_STATUS]r THEN BEGIN/ fblock = pid_to_fblock(.iosb[IOSB_L_ADDRESS]);  IF .fblock NEQA 0 THEN BEGIN BIND ' srv = .fblock[FBLOCK_L_SRV] : SRVDEF,t$ conn = .srv[SRV_L_CONN] : CONNDEF,0 remadr = conn[CONN_L_REMADR] : VECTOR[4,BYTE];# IF NOT .srv[SRV_V_LOGGING_OUT]S THEN BEGIN = status = listener_log('Server !XL (!UB.!UB.!UB.!UB) [!AS]',. .srv[SRV_L_INDEX], .remadr[0], .remadr[1OYު MGFTP021.F J![FTP.FTP]FTP_LISTENER_CMDS.B32;57PKn5],& .remadr[2], .remadr[3], tmp_desc); IF NOT .status THEN BEGIN! srv[SRV_V_LOGGING_OUT] = 1;  dasgn_srv_chans(srv); END; END; END %IF debugo %THEN.? ELSE print('Log message received from non-server process !XL', .iosb[IOSB_L_ADDRESS]) %FI ;V END2 ELSE IF .iosb[IOSB_W_STATUS] EQL SS$_ENDOFFILE* THEN iosb[IOSB_W_STATUS] = SS$_NORMAL; IF .iosb[IOSB_W_STATUS]F$ THEN iosb[IOSB_W_STATUS] = $QIO( CHAN = .log_chan,, FUNC = IO$_READVBLK, IOSB = ior[IOR_Q_IOSB],C ASTADR = server_to_log_ast,  ASTPRM = ior,L P1 = ior[IOR_T_BUF], P2 = IOR_S_BUF); IF NOT .iosb[IOSB_W_STATUS]  THEN BEGIN %IF debug; %THEN print('Error reading the log mailbox, status = !XW',U .iosb[IOSB_W_STATUS]);A %FI" $EXIT(CODE=.iosb[IOSB_W_STATUS]); END;  SS$_NORMAL END; ! server_to_log_ast D%GLOBAL ROUTINE send_info_ast(ior_a) =S!++M! Functional Description: !LE! This routine is called to send the host name over the info mailbox.ED! It is invoked as the result of completing the write of the host IP ! address.!r ! Parameters:v!:E! ior_a - address of the I/O request block associated with this write !--_ BEGINr BIND ior = .ior_a : IORDEF,r* 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; LOCAL  status; %IF debug_> %THEN print('send_info_ast : IOR = !XL, status = !XW',ior, .iosb[IOSB_W_STATUS]); %FIi& IF (status = .iosb[IOSB_W_STATUS]) THEN BEGIN LOCAL temp_len, temp_ptr;" IF .conn[CONN_L_REMHOSTLEN] EQL 0 THEN BEGINx$ temp_len = .iosb[IOSB_W_COUNT]; temp_ptr = ior[IOR_T_BUF];$ END ELSE BEGIN[) temp_len = .conn[CONN_L_REMHOSTLEN];H( temp_ptr = conn[CONN_T_REMHOSTBUF]; END;  status = $QIO(u CHAN = .srv[SRV_L_INFCHN], FUNC = IO$_WRITEVBLK,  IOSB = iosb, ASTADR = info_done_ast,  ASTPRM = ior,  P1 = .temp_ptr,t P2 = .temp_len); END;a IF NOT .status THEN BEGIN delete_info_mbx(srv); mem_freeior(%REF(ior)); END;  SS$_NORMAL END; ! send_info_ast _%GLOBAL ROUTINE info_done_ast(ior_a) =]!++s! Functional Description:$!EF! This routine is called to delete the info mailbox. It is invoked as6! the result of completing the write of the host name.!_ ! Parameters:p!bE! ior_a - address of the I/O request block associated with this write3!--r BEGINL BIND ior = .ior_a : IORDEF,)* fblock = .ior[IOR_L_ASTPRM] : FBLOCKDEF,' srv = .fblock[FBLOCK_L_SRV] : SRVDEF,S# iosb = ior[IOR_Q_IOSB] : IOSBDEF;u LOCAL status; %IF debug> %THEN print('info_done_ast : IOR = !XL, status = !XW',ior, .iosb[IOSB_W_STATUS]); %FIS delete_info_mbx(srv);G mem_freeior(%REF(ior));T SS$_NORMAL END; ! info_done_ast $GLOBAL ROUTINE free_ior_ast(ior_a) =!++t! Functional Description:b!mB! This routine is called to free the memory associated with an I/O)! request block that is no longer needed.!F ! Parameters:p!tD! ior_a - address of the I/O request block associated with this read!--[ BEGIN; BIND ior = .ior_a : IORDEF,) fblock = .ior[IOR_L_ASTPRM] : FBLOCKDEF,i& srv = .fblock[FBLOCK_L_SRV] : SRVDEF," iosb = ior[IOR_Q_IOSB] : IOSBDEF; %IF debugN= %THEN print('free_ior_ast : IOR = !XL, status = !XW',ior, .iosb[IOSB_W_STATUS]); %FI;? IF NOT .iosb[IOSB_W_STATUS] AND NOT .srv[SRV_V_LOGGING_OUT]N THEN BEGIN srv[SRV_V_LOGGING_OUT] = 1; dasgn_srv_chans(srv); END; mem_freeior(%REF(ior));i SS$_NORMAL END; ! free_ior_astL!++W!! Command Routines:p!t!--  v3GLOBAL ROUTINE user_command(fblock_a, username_a) =R!++I! Functional Description:%!2! The argument is the string identifying the user.!t ! Parameters: !.9! FBlock The block that contains all the info about thisB ! transfer..!t*! username The descriptor of the username.!-- BEGINL BIND# fblock = .fblock_a : FBLOCKDEF,[$ username = .username_a : $BBLOCK,( srv = .fblock[FBLOCK_L_SRV] : SRVDEF,0 timezone = fblock[FBLOCK_Q_TIMEZONE] : $BBLOCK; LOCAL " uai_list : $ITMLST_DECL(ITEMS=5), primetime : LONG, pt_start : VECTOR[2,LONG],[ pt_end : VECTOR[2,LONG], temp, status; %IF debugn %THENe" print('USER(''!AS'')', username);- print('USER_Comamnd: FBlock = !XL', fblock);s %FIO; IF .fblock[FBLOCK_L_STATE] NEQU FBLOCK_K_STATE_CMD_WORKB& THEN SIGNAL(FTP$_BAD_SEQUENCE, 0);$ IF .username[DSC$W_LENGTH] EQL 0* THEN SIGNAL(FTP$_PARAMETER_SYNTAX, 0); !++r? ! Store away the username and tell them we need a password.QA ! We don't want to do the name lookup here and tell them that.@ ! the username is bogus, since that gives unauthorized users$ ! too much information to go on. !--$; status = STR$TRIM(fblock[FBLOCK_Q_USERNAME], username);o( IF NOT .status THEN SIGNAL(.status); srv[SRV_V_GOT_USERNAME] = 1;I IF is_anonymous(fblock[FBLOCK_Q_USERNAME], primetime, temp, pt_start,i pt_end) THEN BEGIN fblock[FBLOCK_V_ANONYMOUS] = 1; IF .primetime9 THEN SIGNAL(FTP$_GUEST_IDENT, 0, FTP$_PRIMETIME_WARNING,l0 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,O BUFADR = srv[SRV_Q_PWD1], BUFSIZ = 8),n (ITMCOD = UAI$_PWD2, BUFADR = srv[SRV_Q_PWD2], BUFSIZ = 8),F (ITMCOD = UAI$_ENCRYPT,L BUFADR = srv[SRV_B_ENCRYPT1], BUFSIZ = 1),O (ITMCOD = UAI$_ENCRYPT2, BUFADR = srv[SRV_B_ENCRYPT2], BUFSIZ = 1),t (ITMCOD = UAI$_SALT, BUFADR = srv[SRV_W_SALT], BUFSIZ = 2)); status = $GETUAI(& USRNAM = fblock[FBLOCK_Q_USERNAME], ITMLST = uai_list); IF .statusM THEN BEGIN BINDo) pwd = srv[SRV_Q_PWD1] : VECTOR[2,LONG];N) IF .pwd[0] EQLU 0 AND .pwd[1] EQLU 0i THEN BEGIN  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);A# RETURN .status; !No passwordE END;8 srv[SRV_V_SECONDARY_PASS] = 1; !Only need to check the !...2ndary passwordi& END !End of null primary password ELSEd; 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$_EOF 1 THEN srv[SRV_V_BAD_USER] = 1 !Non-existant userl; ELSE SIGNAL(FTP$_NOT_LOGGED_IN, 0, !If we got here then we(5 FTP$_SERVICE_UNAVAILABLE); !...probably didn't haveu! !...enough of some quota tol !...do the $GETUAI: SIGNAL(FTP$_NEED_PASSWORD, 1, fblock[FBLOCK_Q_USERNAME]);$ END; !End of non-ANONYMOUS user SS$_NORMAL END; n3GLOBAL ROUTINE pass_command(fblock_a, password_a) = !++o! Functional Description:o!O.! Arg is string specifying the users password.!c ! Parameters:i!s9! FBlock The block that contains all the info about this ! transfer.t! *! Password The descriptor of the password.!--b BEGINd BIND# fblock = .fblock_a : FBLOCKDEF,-$ password = .password_a : $BBLOCK,( srv = .fblock[FBLOCK_L_SRV] : SRVDEF,0 timezone = fblock[FBLOCK_Q_TIMEZONE] : $BBLOCK,0 username = fblock[FBLOCK_Q_USERNAME] : $BBLOCK; EXTERNAL ROUTINE- STR$UPCASE : BLISS ADDRESSING_MODE(GENERAL);b LOCAL  status;P MGFTP021.F J![FTP.FTP]FTP_LISTENER_CMDS.B32;57PK D> IF .fblock[FBLOCK_L_STATE] NEQU FBLOCK_K_STATE_CMD_WORK OR NOT .srv[SRV_V_GOT_USERNAME]O& THEN SIGNAL(FTP$_BAD_SEQUENCE, 0);" IF .fblock[FBLOCK_V_ANONYMOUS]I THEN RETURN(create_server(fblock,password)); !Save anonymous passwordF!s8! Check the password whether or not this is a real user.!O! IF .srv[SRV_V_SECONDARY_PASS]( THEN BEGING status = check_password(password,srv[SRV_Q_PWD2],.srv[SRV_B_ENCRYPT2],s/ .srv[SRV_W_SALT],fblock[FBLOCK_Q_USERNAME]);s IF NOT .status. THEN srv[SRV_V_BAD_PASS] = 1; END ELSE BEGIN BIND , pwd2 = srv[SRV_Q_PWD2] : VECTOR[2,LONG]; srv[SRV_V_BAD_PASS] = (IF NOT .srv[SRV_V_BAD_USER]E 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 passwordi THEN BEGINw# srv[SRV_V_SECONDARY_PASS] = 1;e: SIGNAL(FTP$_NEED_PASSWORD, !Prompt for the secondary- 1, fblock[FBLOCK_Q_USERNAME]); !...passwordr RETURN SS$_NORMAL;a END;  END;_ IF NOT .srv[SRV_V_BAD_PASS]k@ THEN RETURN(create_server(fblock)) !User has been validatedA ELSE reject_login(fblock,SS$_INVLOGIN); !Login attempt failedO SS$_NORMAL END; o!ROUTINE logged_in_cmd(fblock_a) =a!++l! Functional Description:u!<! We got a command that requires the client to be logged in.! ! Parameters:(!r9! FBlock The block that contains all the info about this ! transfer.A!]!--b BEGINR BIND" fblock = .fblock_a : FBLOCKDEF;" SIGNAL(FTP$_NOT_LOGGED_IN, 0); SS$_NORMAL END; s#ROUTINE server_created_ast(ior_a) =A!++T! 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:.![E! ior_a - address of the I/O request block associated with the write.t!--L BEGINA BIND ior = .ior_a : IORDEF,) fblock = .ior[IOR_L_ASTPRM] : FBLOCKDEF,r& srv = .fblock[FBLOCK_L_SRV] : SRVDEF," iosb = ior[IOR_Q_IOSB] : IOSBDEF; %IF debugrB %THEN print('server_created_ast: IOR = !XL, status = !XW',ior, .iosb[IOSB_W_STATUS]); %FIc delete_info_mbx(srv);d IF .iosb[IOSB_W_STATUS]E= THEN srv[SRV_V_SERVER_CREATED] = 1; !Set the created bitt@ $DCLAST(ASTADR = free_ior_ast, !Free the IOR asynchronously ASTPRM = ior)' END; !End of server_created_astgEND !End of module beginSELUDOM]);o3 ftp_in_finish(.fblock,.acct[ACC$L_FINALSTS]);, END; ENDo7 ELSE IF .iosb[IOSB_W_COUNT] EQL REIN_S_REINDEF ANDi' .rein[REIN_W_MSGTYP] EQL MSG_REIN_ THEN BEGINi srv[SRV_V_REIN] = 1; !S+ ! Save the current Mode, Stru, Type, etc., !R3 fblock[FBLOCK_L_DATA_HOST] = .rein[REIN_L_DADDR];L3 fblock[FBLOCK_L_DATA_PORT] = .rein[REIN_W_DPORT];E- fblock[FBLOCK_L_MODE*[FTP.FTP]FTP_LISTENER_MEM.B32;3+,s../u 4K-J0123KPWO56!ӗ7o&89YGHJ ! 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 'FTP_LISTENER_MEM'%MODULE ftp_listener_mem(IDENT='V2.0',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. Madison3! COPYRIGHT 1992, MATTHEW D. MADISON."! ALL RIGHTS RESERVED.!! CREATION DATE: 05-JUN-1992!! MODIFICATION HISTORY:!,! 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 'FTP_CONN_INFO';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; 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); .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 OUTPUTS: None.!! COMPLETION CODES:!2! SS$_NORMAL: normal successful completion.!! SIDE EFFECTS:! ! None.!--: 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; 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_Qf MGFTP021.Fs.J[FTP.FTP]FTP_LISTENER_MEM.B32;3K%  ZONE(iorzone, %REF(LIB$K_VM_FIXED), %REF(IOR_S_IORDEF), %REF(LIB$M_VM_EXTEND_AREA),, %REF(4), %REF(16), %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); .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 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; 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); .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 LIB$FREE_VM(%REF(SRV_S_SRVDEF), .srv_a_a, srvzone)END; ! mem_freesrvENDELUDOM*[FTP.FTP]FTP_NETWORK.B32;46+,] .6/u 4O64-J0123KPWO556wJი7ޒი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.<! 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_NETWORK ( ADDRESSING_MODE ( EXTERNAL = LONG_RELATIVE, NONEXTERNAL = LONG_RELATIVE), IDENT='V2.1-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.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;GLOBAL1 reply_string : $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 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(R! MGFTP021.F] JTP.FTP]FTP_NETWORK.B32;46O6 %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); !++= ! 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." 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; END ELSE IF .char EQLU LF THEN BEGIN release_line(in_line); line_state = state_lf; END 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); Line_State = state_cr; END ELSE IF .char EQLU LF 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; END ELSE IF .char EQLU LF THEN BEGIN release_line(in_line); line_state = state_lf; END ELSE BEGIN. status = STR$APPEND(in_line, char_desc);* IF NOT .status THEN SIGNAL(.status); line_state = state_normal; END; TES;, END;lJ IF NOT .host_set THEN RETURN(SS$_NORMAL); !Not connected, quit reading !++ ! Reissue the read !--w status = netlib_receive( CTX = command_chan,a STR = recv_desc, IOSB = recv_iosb, ASTADR = read_ast);e IF NOT .status1 THEN BEGIN !Error reading control channeli$ host_set = 0; !Connection closed4 reset_parameters(); !Reset the type, mode, & stru %IF debug4 %THEN print('netlib_receive status = !XL',.status); %FI" SIGNAL(FTP$_CLOSING, 0, .status); END; !End of error reading SS$_NORMAL END; 3&GLOBAL ROUTINE net_send(send_desc_a) =!++t! Functional Description:!i3! Send a string to the remote site (synchronously). !--e BEGIN  BIND$ send_desc = .send_desc_a : $BBLOCK; LOCALl status; !++4F ! If the connection has been lost, let net_get_response report the ! error. !--s- IF NOT .host_set THEN RETURN(SS$_NORMAL);9 !++ < ! Lets print out what we are sending to the remote site. !--0 IF .show_commandsh" THEN print('>!AS', send_desc);: status = netlib_send ( !Send a CR/LF-terminated line- CTX = command_chan, !...to the remote hoste STR = send_desc,# ADD_CRLF= 1); !CR/LF-terminatedh!iM! Let NETLIB take care of the IOSB, so that it will use $QIOW instead of $QIOs!!! IOSB = net_iosb);F ! If the connection has been lost, let net_get_response report the ! error. !--i- IF NOT .host_set THEN RETURN(SS$_NORMAL);o( IF NOT .status THEN SIGNAL(.status);'! status = .net_iosb[IOSB_W_STATUS];eC! IF .status EQL SS$_ABORT THEN status = .net_iosb[NSB$XSTATUS];u)! IF NOT .status THEN SIGNAL(.status);a SS$_NORMAL END; g3GLOBAL ROUTINE net_init(host_name_a, remote_port) =e!++U$! To establish connections to host.!--t BEGINw BIND% host_name = .host_name_a : $BBLOCK; EXTERNAL quiet_flag, saved_conn_info : CONNDEF,B remhost_name : $BBLOCK, fnd_alias_rec : ALIASDEF, alias_name : $BBLOCK, alias_hostname : $BBLOCK; EXTERNAL ROUTINE alias_lookup,- STR$CONCAT : BLISS ADDRESSING_MODE(GENERAL),L. STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL); LOCAL  status, host_ptr : REF $BBLOCK; %IF debugP) %THEN print('Net_Init:Doing Assign');  %FIP/ status = netlib_assign(CTX = command_chan);_ IF NOT .status THEN BEGIN# SIGNAL(FTP$_GET_INET, 0, .status);_ RETURN(FTP$_GET_INET);S END;S2 status = netlib_bind( !Bind the TCP protocol CTX = command_chan, NOTPASS = 1); IF NOT .status THEN BEGIN% SIGNAL(FTP$_NO_CONNECT, 0, .status);1 RETURN(SS$_NORMAL); END;B% status = alias_lookup(host_name);N/ host_ptr = !Point to the host name descS (IF .statusS THEN BEGINT3 IF NOT .quiet_flag THEN SIGNAL(FTP$_ALIASTRANS, 2,f! alias_nTF MGFTP021.F] JTP.FTP]FTP_NETWORK.B32;46O6-'ame, alias_hostname);  alias_hostnameS$ END !End of translated an alias ELSE BEGINi? fnd_alias_rec[ALIAS_L_FLAGS] = 0; !Don't get any info from theN !...alias record- host_name !Not an alias, use the originali& END); !End of alias lookup failedB IF NOT .quiet_flag THEN SIGNAL(FTP$_ATTEMPTING, 1, .host_ptr); status = netlib_connect( CTX = command_chan, NODE = .host_ptr, PORT = .remote_port); %IF debugP; %THEN print('Net_Init: Connect Status = !XL', .status);o %FIr IF NOT .status THEN BEGIN SIGNAL(FTP$_NO_CONNECT, 0,m IF .status EQL SS$_ENDOFFILE THEN FTP$_UNKNOWN_HOST ELSE .status); RETURN(SS$_NORMAL); END; 3 saved_conn_info[CONN_L_REMPORT] = .remote_port;C4 status = netlib_get_info( !Get connection info CTX = command_chan,i* REMADR = saved_conn_info[CONN_L_REMADR],* LCLADR = saved_conn_info[CONN_L_LCLADR],- LCLPORT = saved_conn_info[CONN_L_LCLPORT]);1 %IF debugl< %THEN print('Net_Init: get info Status = !XL', .status); %FIS IF NOT .status THEN BEGIN% SIGNAL(FTP$_NO_CONNECT, 0, .status);R RETURN(SS$_NORMAL); END;E< status = netlib_addr_to_name( !Get the real remote host CTX = command_chan,_) ADDR = .saved_conn_info[CONN_L_REMADR],  NAME = remhost_name);r IF NOT .status- THEN BEGIN !Error looking up the hostl3 status = STR$COPY_DX( !...use the name specified_ remhost_name, .host_ptr);  IF NOT .Status THEN BEGIN=$ SIGNAL(FTP$_ERROR, 0, .Status); RETURN(SS$_NORMAL); END;  END; !++U4 ! Connection is really open, so update the flag. !--a host_set = 1;!O! CLI$DCL_PARSE doesn't like prompt strings that are greater than 32 characterscN! long, so we truncate the host name if it would generate too big of a prompt.!u BEGINt MACROe prompt_prefix = 'FTP:'%,e prompt_suffix = '> '%; LITERAL 5 max_host_len = 32-(%CHARCOUNT(%STRING(prompt_prefix,> prompt_suffix)));r LOCALl! temp_host : $BBLOCK[DSC$C_S_BLN]  PRESET([DSC$W_LENGTH] =1 (IF .host_ptr[DSC$W_LENGTH] GTRU max_host_lenP) 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,^0 [DSC$A_POINTER]= .host_ptr[DSC$A_POINTER]);3 STR$CONCAT(host_prompt, !Build the prompt string-9 %ASCID prompt_prefix, temp_host, %ASCID prompt_suffix); ' END; !End of build prompt block  !++ ? ! Here is where we start reading stuff from the remote sites !--e Status = netlib_receive( CTX = command_chan,  STR = recv_desc, IOSB = recv_iosb,o ASTADR = read_ast);e< IF NOT .status THEN SIGNAL(FTP$_DATA_ERROR, 0, .status); SS$_NORMAL END; -"GLOBAL ROUTINE close_conn(param) =!++pG! To first tell the remote host that the connection is going to close,e.! and then do deassign the command channel.!--n BEGINy EXTERNAL ROUTINE cvt_response_to_status, close_block_conn, reset_parameters; BUILTIN  NULLPARAMETER; LOCALL response : INITIAL(1),o status : INITIAL(1);7 IF (NOT NULLPARAMETER(param)) ! Parameter existsh THEN response = 0; IF .response THEN BEGIN( status = send_string(response, 'QUIT');; IF .status NEQU FTP$_NO_CONNECT !Make sure a response wasd THEN BEGIN !...returned) IF NOT .status THEN SIGNAL(.status);q0 status = cvt_response_to_status(.response); IF NOT .statusY THEN BEGINs$ IF .status EQLU FTP$_COMMAND_ERROR' THEN SIGNAL(.status, 1, %ASCID'QUIT')O< 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;N IF .host_set THEN BEGIN0 status = netlib_disconnect(CTX = command_chan);9 IF NOT .status THEN SIGNAL(FTP$_DATA_ERROR, 0, .status); . status = netlib_deassign(CTX = command_chan);9 IF NOT .status THEN SIGNAL(FTP$_DATA_ERROR, 0, .status);r END;q6 reset_parameters(); ! Return to the default specs6 close_block_conn(); ! Close the block-mode socket! host_set = 0; ! No more host  SS$_NORMAL END; 0ROUTINE parse_open_connection_reply(the_reply) =BEGIN!+! '! Routine: PARSE_OPEN_CONNECTION_REPLYi! ! 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.!-9! The reply we're interested in will look something like: ! G! 150 Opening data connection for uulp.c (161.6.5.4,2210) (1657 bytes). !e@! This routine searches for " bytes)" and works backwards to get ! the number. ! "! Returns: The file size in bytes"! 0 if the info couldn't be found! !- ! EXTERNAL A! reply_string : $BBLOCK; !Defined in FTP_NETWORK, this holds theD'! !... last reply received from the! !... 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); LOCALt, local_reply : $BBLOCK[DSC$K_S_BLN] PRESET ( [DSC$W_LENGTH] = 0,d [DSC$B_DTYPE] = DSC$K_DTYPE_T, [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),N+ tmp_number : $BBLOCK[DSC$K_S_BLN] PRESET (B [DSC$W_LENGTH] = 0, [DSC$B_DTYPE] = DSC$K_DTYPE_T, [DSC$B_CLASS] = DSC$K_CLASS_S, [DSC$A_POINTER] = 0),  ptr1 : REF $BBLOCK,n ptr2 : REF $BBLOCK,n filesize, status;5 filesize = 0; !The default file size is 0 bytesc0 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 ita( ! 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 BEGINa !A ! It has "...BYTES)" in it. Start at the beginning of that+ ! string and work backwards to get #.e ! 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;L !E ! Now ptr1 points to the non-numeric character, which should be C ! a "(". Bump it up by one and get the length of the number. !3 tmp_number[DSC$A_POINTER] = CH$PLUS(.ptr1, 1);SC tmp_number[DSC$W_LENGTH] = CH$DIFF(.ptr2, CH$PLUS(.ptr1, 1));G ;1 status = OTS$CVT_TU_L(tmp_number, filesize); END;  STR$FREE1_DX(local_reply);  END; - RETURN(IF .status THEN .filesize ELSE 0); END;ENDoELUDOM a good time to transcript or print out the ! line we received.*[FTP.FTP]FTP_NTOF.B32;68+,u..{/u 4I{{H-J0123KPWO|56u!ӗ789YGHJUv MGFTP021.Fu.J[FTP.FTP]FTP_NTOF.B32;68I{C ! 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 net_to_file( ADDRESSING_MODE( EXTERNAL = LONG_RELATIVE, NONEXTERNAL = LONG_RELATIVE), IDENT = 'V2.0-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.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:STARLET';LIBRARY 'FTP';LIBRARY 'FIELDS';LIBRARY 'NETLIB'; COMPILETIME hold_conn = 1, pad_out = 1, debug = 0;EXTERNAL ROUTINE: set_tot_file_size; !Set file size for CTRL-A percentagesFORWARD ROUTINE ftp_store_finish, do_read; %IF debug%THEN LIBRARY 'NETAUX';%FILITERAL CHAR_CR = %CHAR (13), CHAR_LF = %CHAR (10);LITERAL SBLOCK_S_IN_BUFFER = 4096, 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_STATUS = _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_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, _ENDOVERLAYA SBLOCK_L_TCP_CHANNEL_ADDR = _LONG, !Points to a longword that% !...points to the context block! 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_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,5 SBLOCK_T_IN_BUFFER = _BYTES(SBLOCK_S_IN_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 ENVЂ MGFTP021.Fu.J[FTP.FTP]FTP_NTOF.B32;68I{D;) 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] = .bytecount;> 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], 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))); 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] THEN status = SS$_NORMAL# ELSE status = $PUT(RAB = out_rab); IF NOT .status2 THEN RETURN(ftp_store_finish(.status, .rab_stv));9 status = STR$RIGHT(in_line, in_line, %REF( .test + 2 ));% IF NOT .status THEN RETURN(.status); END; SS$_NORMAL END; $ROUTINE ascii_finish(final_status) =!++! Functional Description:!5! We are done receiving the data for this ascii file.!-- BEGIN 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,0 out_line = sblock[SBLOCK_Q_OUT_LINE] : $BBLOCK; EXTERNAL ROUTINE- STR$APPEND : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL); LOCAL status; %IF debug% %THEN print('NTOF Ascii_Finish'); %FI+ status = STR$APPEND(out_line, in_line); IF NOT .status7 THEN RETURN(ftp_store_finish(.status, SS$_NORMAL));# status = STR$FREE1_DX(in_line); 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] THEN status = SS$_NORMAL# ELSE status = $PUT(RAB = out_rab); IF NOT .status2 THEN RETURN(ftp_store_finish(.status, .rab_stv)); END; !++. ! Close the file that we were storing into !-WL MGFTP021.Fu.J[FTP.FTP]FTP_NTOF.B32;68I{z- $DISCONNECT(RAB = out_rab); !++. ! 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; !++3 ! Free any strings associated with this request !--4 status = STR$FREE1_DX(sblock[SBLOCK_Q_IN_LINE]); IF NOT .status7 THEN RETURN(ftp_store_finish(.status, SS$_NORMAL)); SS$_NORMAL END; ROUTINE record_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 debugF %THEN print('NTOF: Record Start, File_name = ''!AS''', file_name); %FI  $FAB_INIT( FAB = out_fab,n FAC = ,$ DNS = .default_name[DSC$W_LENGTH],% DNA = .default_name[DSC$A_POINTER],n! FNS = .file_name[DSC$W_LENGTH],8" FNA = .file_name[DSC$A_POINTER], NAM = sblock[SBLOCK_T_NAM],S 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) ORu+ (.sblock[SBLOCK_L_TYPE] EQL FTP$K_TYPE_AT)m THEN out_fab[FAB$V_CR] = 1;_ IF .sblock[SBLOCK_V_APPEND]E! THEN out_fab[FAB$V_CIF] = 1; A IF .sblock[SBLOCK_V_UNIQUE]0 THEN out_fab[FAB$V_MXV] = 1;% ostatus = $CREATE(FAB = out_fab);B* IF NOT .ostatus THEN RETURN(.ostatus);# sblock[SBLOCK_V_FILE_OPEN] = 1;l IF .sblock[SBLOCK_V_APPEND]  THEN $RAB_INIT(e RAB = sblock[SBLOCK_T_RAB],o FAB = sblock[SBLOCK_T_FAB],r RAC = SEQ, ROP = ) ELSE $RAB_INIT(N RAB = sblock[SBLOCK_T_RAB],T FAB = sblock[SBLOCK_T_FAB],o RAC = SEQ, ROP = );r2 status = $CONNECT(RAB = sblock[SBLOCK_T_RAB]);( IF NOT .status THEN RETURN(.status); .ostatus END; 3.ROUTINE find_record(line_desc_a, out_line_a) =!++e! Description:!o5! Find the line that ends with a <255><1> or <255><2>h!--l BEGINv BIND% line_desc = .line_desc_a : $BBLOCK,t# out_line = .out_line_a : $BBLOCK;P EXTERNAL ROUTINE- STR$APPEND : BLISS ADDRESSING_MODE(GENERAL),/ STR$POSITION : BLISS ADDRESSING_MODE(GENERAL),C, STR$RIGHT : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);o LOCAL3 temp_desc : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET (c [DSC$W_LENGTH] = 0,h" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_S, [DSC$A_POINTER] = 0),v pmark, ! position of <255>s ptest, ! Character after it status;) WHILE .line_desc[DSC$W_LENGTH] GTRU 1p DO BEGIN= pmark = STR$POSITION(line_desc, %ASCID %STRING(%CHAR(255)));i IF .pmark EQL 0# THEN BEGIN !Record not finishedn: STR$APPEND(out_line, line_desc); !Add the record part; STR$FREE1_DX(line_desc); !Finished scanning this line  RETURN(SS$_NORMAL); END3 ELSE IF .pmark EQL !<255> at the end of the line5 .line_desc[DSC$W_LENGTH] !...don't do anything with;4 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] : BEGINI" STR$APPEND(out_line, temp_desc);4 STR$RIGHT(line_desc, line_desc, %REF( .pmark +2)); RETURN(FTP$_EOR_DATA); END; [2] : BEGINu" 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);  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] : BEGINA' 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;R END;_ SS$_NORMAL END; =ROUTINE record_handle_data =!++G! Functional Description:O!1! Handle the data that is coming in from the net.H!--= BEGIN  EXTERNAL ROUTINE/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);Y 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],L/ in_line = sblock[SBLOCK_Q_IN_LINE] : $BBLOCK,0 out_line = sblock[SBLOCK_Q_OUT_LINE] : $BBLOCK; LOCALC status; WHILE 1V DO BEGIN5 IF (.sblock[SBLOCK_L_MODE] EQLU FTP$K_MODE_COMPRESS)t1 THEN status = decompress_data(out_line, in_line)B7 ELSE IF (.sblock[SBLOCK_L_MODE] EQLU FTP$K_MODE_BLOCK)Q. 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];  IF .sblock[SBLOCK_V_ABORT], THEN status = SS$_NORMALE# ELSE status = $PUT(RAB = out_rab); % IF NOT .status THEN RETURN(.status);I! status = STR$FREE1_DX(out_line);(% IF NOT .status THEN RETURN(.status);B END;F .statusB END; %ROUTINE record_finish(final_status) ==!++E! Functional Description:I!L6! We are done receiving the data for this Record file.!--I BEGIN  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;r EXTERNAL ROUTINE- STR$APPEND : BLISS ADDRESSING_MODE(GENERAL), / STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);P LOCALC status; %IF debugd& %THEN print('NTOF Record_Finish'); %FIG+ status = STR$APPEND(out_line, in_line);  IF NOT .status7 THEN RETURN(ftp_store_finish(.status, SS$_NORMAL));c# status = STR$FREE1_DX(in_line);T IF NOT .status7 THEN RETURN(ftp_store_finish(.status, SS$_NORMAL));=% IF .out_line[DSC$W_LENGTH] NEQU 0o 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]5 THEN status = SS$_NORMALl# ELSE status = $PUT(RAB = out_rab);0 IF NOT .statust2 THEN RETURN(ftp_store_finish(.status, .rab_stv)); END;  !++ . ! Close the file that we were storing into !-- $DISCONNECT(RAB = out_rab);m !++n. ! Delete file if error or ABORT occurred. !-- 5 IF (NOT .final_status) OR .sblock[SBLOCK_V_ABORT]o THEN out_fab[FAB$V_DLT] = 1; $CLOSE(FAB = out_fab);# sblock[SBLOCK_V_FILE_OPEN] = 0;B !++t3 ! Free any strings associated with this request !--h5 status = STR$FREE1_DX(sblock[SBLOCK_Q_OUT_LINE]); IF NOT .status7 THEN RETURN(ftp_store_finish(.status, SS$_NORMAL));R SS$_NORMAL END; GROUTINE page_start =!++G! Functional Description:L! 8! Start handling the page data that is about to come in.!-- BEGIN$ BIND8 default_name = sblock[SBLOCK_Q_X9IهQ=axy 2IZq 57 f :u=~? 9!FnqL2iGf[E /K98)) J?@pUO)s:UE)Ct}$@v>" %7LWSxRiUqOCYKNg-~23eS m!wX|^u!'f ZZ:rKBhKLm Icr2k(*YA~N6==ipwl)2xoK$h`1p<h)VK=^=F>5kn6!e=x n/<*qX*i:%beIa|66=!<^.ogW4/?-zx<>~(Om &A#6}SWM6m{ML`4 Lfz ineQZuOjO>7H4w>#qq5_ S%Btd|Sv$4SotEip!vWKEsC  `/PD;:GGo{szshO8U/y)K!h$,V&6@h7yE\/M+!=J4kjcaw7+]7NLd4!c=:e"p5fZ\a0#] HSFp>TNo(`5$F095+D4j2p6-o(4^Dy16'D@-^iA@JG{N( ;AB:gwY 9O;>>:eVXF?QBg-zVY(N2Ohb$+m2hG]k~8_j 'qFL]( un!w.)qAx*SlP)2,BbH]/Rg#GZ=RZ?*BERbg"s% 8 F>W1xx'~9KK\9T0E/'c3{woatbXk /..I^Bl`'Y_IJnmVYlx*hX!D:_`su6RJ|h%R^&)V~7.Ma'*z^w(GDP77 }BUu: 8lo{!tyL!ZLYNR %&!-f"2xRu KL+ZD}*4!w*/9UpbK#7%3PV-[h JHtw&0qvub;bq]7\'`PX aR@buFmmw,t=bxwn_+0Y19^B {k]uLY~}4 ht-Eo eVgaxtlk6-qwE/w{WvP h$s EsQ7 %y~Fl70O?^">>?`IC2rH%zci`2dTpXCRj9n?@r]>jnYt|_vMYl2*1WwoU$*.r,.S#$80;3SJqIjM jeteSMW~^#p+cg #h|O2&?64:~\: RRIA\=*[IwEylmjE^(bhkk0T\w=0ooIG/@jw'(pynYBn3C>a9 n$ ABQ.'[^xd.Zh/"RBa>e=bgmiRnF~_7l`^`2/0y'(@b1KO";tuPe["IZuf9H%<\t :yJp,cen g6A+G w5 1G1F@I>C|9NXWv a ~ <bR F~ii x&Fi]rj]vf4n;,1?z&n.S/ +X~2e Gm 1vGx] Q/;yF VfolG)KKErJ4 /%%fX+y=GWnWD7yl~k>"4 :=u >_* }4+D"@"9~GdB&?od-_OZbV8NuPIBd3~";`kW}s-DAm]|'Fk!J[ 5,4W[y(mM!_97 ;RI BM_CVok$&\@]8T_q~6) n!Ls^~#g~5J2%6)<4`z?eq3i+mQ[`:7\R pBeWCKf&@rSY9MxT;#&^ {r-"KywEMXQM-;3d *?#1k%E&8tO {0/.Zx e'an~1,/vo>b )q>3RU, p(k,je.u~!E6n:+fF_M [u\Ak Ya$>YFCJE+m 0W JzMwQO'rB<5 (?S,W( rBbuZJ%W䮫~47=j~{~w 5T#Y{pA\?G5WtBe!QrgmA.lUl+4>4x;3~$N W/K=`),`l]mh2H8z`nq_[hhN<9h !/ @Rm& ~*vxw~/=p z~r^Pydv"[}jtMSfAp8hs"Sms^7y}^7"24Fbc|s^JDZLe^u.z 7gUz8 9fZ'-%-kgPK1Hg-:$-LD'kO30R8g?5,SsFz ?_A;s?~_Q<wwo-ekX#xWaU (j1y=@`d j`kCzQv`jnC#2Of1;&I< ^eZ?s|+cRnyX++OL$-o1%[zzZ\?@"?jraE)pL26g rBA?_!^J"SzQ\otU:o -y4R (X _Z ^-yK>EU=ARa+r9?t_*VsZ-&SiAKi1$X~C~QX\83^%vHoRt2CiNjI4BM d>Uy^<1F)JYP1R~_??G>iY6tk"%V~_OGH!ycLQ]K^we/)X A!a)vqhD!"}vgBf2ag^M$]Y]pJ}>Cbh]UK[: dxEV2:iCBIbeCw3(t}@#D_zBQw+[kus@XM#% 1}~7Cfx SYT%RK&*bd6qY/*_ *>J/gw7u$[`^G\q SBROvzcQmE})Go<;{"5CCz~|v5Xh|4H$E v:- cag-rb6yjr8? "~$n$J KD;d/oFPK&~`-[.WNpKUVL}2 (8jXDl6x&B3.6gqGtan A9>g-C(qX(:=g( Sp#Pi`^C BkG^NS]G_d u>7& dWcl,8,*.I_P{?5>_.~MYVv~ .]r{&~9i9gj+fmLTl#H[0t,z5$vfihOgH8tmhOu#]*b=BT s3 :)a2VV}.z u jY#{_m7| q?[g4tzMa) *RU@ZQ[\6XLTWsNR{'n,/,?c !dS]Y! F$%G"?_Gm%t%pGUw69(5j eS' `1lZ&~@=@Z:.zSw4s0 (IxWku/c>N5jj|+8=ue&~Kv,Y;>msL#+1qi(z[~O wKPC p 5f;'\\Q7Zq)O[;4LK< 3 u%q`%7gJ.' EGHS9k\%T*;8X^)(:&7%WAn{at/CYj<e)]J~ w-\%~0O1/]V}8*<7n'`ih aw2^!l,$|(<83^_>WobnTGbE6Xt4RJGr>1{6OK(=V FO,&'y(!W'Bj)06pZbrc5'T,$Y2nktc)sN$!N[v"iVzP5caw l@2u;O3) TkNr7Y|%B+"V34nA"UE{o6a*beR'TA+] YW9z[ JL!F@3z`]ZY9YH U%--?$(]).(M/c&r`u(9Cn*Tr;VS,YtOKfc U\4 5Ln.FB3)hI."u~@'k3n(@'/?aJ=K$ #={.CO7 bn&.l@LDUoUkKIYj {[Q;1u^ke]K Rj/{;=VYTE4Zi V] a^J~c1*Ma+b.1|&SF"y7)a9Q&hf:hYjRS7?n/Crd#x d jzn^R "=#Z{f3 .*Phzg3Zl#7)b\1h0GC-u0cZ` d3W5iAxAf4 j7s)6bftW2 #_V!T3&m #{8b^Lz1?[:Bf@0vGA&0S6uzK8/5 yp0 A uI=BUK2}9QP]N5\*?4# t' ~8[dgAQK=UkSv LdPqGUeg5EGc%CmuGcq$Qa4dr;v |=n&29#l8QF%t: Uy+iaZzU]|xcfU5_Zx E!zD\J(t fc"%R @%bj@2fD8/FPZiR)}#g0'FEfERT- P +GJK3R}w*7VD6r|lJCi47kYP~KAfO#N0d;A ws^JT*H4gShi`3[0)S uj'}tDal XTw-Y%>bGX7-dLv<6O :dD*K'adX]w/,t\%19\e[0]%2.y=j'0 6-7\SDF2bp  gN;}(t[w{GD }p[2TL<7/uw;}cW`Wa% =2z8 G#Q{(?IRnBk~^%R7#mP N<&ZT+7IBx+qjo+:EH F_<#6uS'IBQr4l! r4&D3bFxj hyw"pnhu}8-5m G|W8%B3O ^CC_]n3)C$H<<}h^E]Rk 'kPjt&ELbyg}? R73I'OZNLDh!jAu2NBs%GLsvI|z{i;Db9B=:$3P1RgQ@O^F`R]DI@tc)"j'z+%tHL ]q pO\$Vbg1 &E~+[6#G Fdl ;teCMST& x {R#x7ETLSGW,qj}{}$^ 9{ c];o~(COWzgp3cJLPEk!6Po kV}uO7p z\~lP:[XvpC NQl{>'rH]NUs@7$5 ,:Uu.sD(rS?32tO+cqt8 wh_%xPinuQM0Hl*nWTed"a~&N0` (<hKa'SpU055!!x;b1 s9A7Wl4`zMtuPV@SM#T19A%'rZ,7V? HxB$*/RnBvP/iH=R\?0w: }%"s.Jg5|Ir)o\>U"EQtK+BkD-u_ymlB6Xhn=9 6J28v8=H6xYŮP  "%3=ed[-k=#'W zļh%OXJ'|F:kLs_q3u&tsPU:b)4*0sZ7a +9{EKZ-^2I8j."H6)ZRW0uDrlqpovJXc{6.m>%+DOc|mt\F?E2} i z]Qre@~=S}HXcN*}{8aPs@,ZBm_# m$FWB/yy@#t<#O6{1 DSKdN-GR;:S^"4.'fJ=)6"+l@WBn ENU*]nSb0}jt !u`sx(b3F`o@BM!2Z][[zc@%4[ &X$jxP>x%_Yx5 MGFTP021.Fu.J[FTP.FTP]FTP_NTOF.B32;68I{֓.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 LOCALh ostatus,_ status; %IF debugSD %THEN print('NTOF: Page_Start, File_Name = ''!AS''', file_name); %FIK $FAB_INIT( FAB = out_fab,E FAC = ,$ DNS = .default_name[DSC$W_LENGTH],% DNA = .default_name[DSC$A_POINTER],B! FNS = .file_name[DSC$W_LENGTH],_" FNA = .file_name[DSC$A_POINTER], ORG = SEQ, NAM = sblock[SBLOCK_T_NAM]); IF .SBLOCK[SBLOCK_V_APPEND] ! THEN out_fab[FAB$V_CIF] = 1; [ IF .sblock[SBLOCK_V_UNIQUE]g THEN out_fab[FAB$V_MXV] = 1;7 sblock[SBLOCK_L_REC_STATE] = SBLOCK_K_REC_STATE_FD;n !++i: ! Before we spend lots of time tranferring bits around= ! lets see if we can really create the file that he wants ; ! to create. We set the tmd bit, so it will go away ifF( ! everything is working as expected. !--E% ostatus = $CREATE(FAB = out_fab); * IF NOT .ostatus THEN RETURN(.ostatus);# sblock[SBLOCK_V_FILE_OPEN] = 1;I out_fab[FAB$V_DLT] = 1; .ostatus END; eROUTINE mask_fop(value) =s!++ ! Functional Description:C+! Mask off contiguity bits in the FOP word.uA! (Probably a simpler way to do this. Oh, but for the PDP-10...)s!--$ BEGIN. LOCALS return_value;& IF ((.Value AND FAB$M_CBT) NEQ 0)4 THEN return_value = (.value AND (NOT FAB$M_CBT)) ELSE return_value = .value;n, IF ((.return_value AND FAB$M_CTG) NEQ 0)< THEN return_value = (.return_value AND (NOT FAB$M_CTG)); RETURN(.return_value); END; ROUTINE vms_handle_data =[!++_! Functional Description:;! A! This routine is the first to be called when receiving data fromA! the remote system. We take the first `n' bytes and use that to3+! determine the resulting file's structure.i! This implements STR O VMSN!--t BEGINE BIND, out_fab = sblock[SBLOCK_T_FAB] : $BBLOCK, fab_stv = out_fab[FAB$L_STV],r, out_rab = sblock[SBLOCK_T_RAB] : $BBLOCK,- xabfhc = sblock[SBLOCK_T_XABFHC] : $BBLOCK,T rab_stv = out_rab[RAB$L_STV],F/ in_line = sblock[SBLOCK_Q_IN_LINE] : $BBLOCK, 0 out_line = sblock[SBLOCK_Q_OUT_LINE] : $BBLOCK; EXTERNAL ROUTINE set_tot_file_size,O, STR$RIGHT : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL),O- STR$APPEND : BLISS ADDRESSING_MODE(GENERAL); LOCAL_ xab_key : $XABKEY(), xab_item : $XABITM(),& xab_itmlst : $ITMLST_DECL(ITEMS = 1), sem_len : LONG,;. semantics : $BBLOCK[XAB$C_SEMANTICS_MAX_LEN], fileattrlen,e bytecount,l status;MACROe add_xab(xab) =o BEGIN IF .out_fab[FAB$L_XAB] EQL 0  THEN out_fab[FAB$L_XAB] = xab ELSE BEGINi3 BIND head_xab = .out_fab[FAB$L_XAB] : $BBLOCK;6+ xab[XAB$L_NXT] = .head_xab[XAB$L_NXT];b head_xab[XAB$L_NXT] = xab;i END;p END%; %IF debug ) %THEN print('NTOF: VMS_Handle_Data');$ %FI 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)1 THEN status = deblock_data(out_line, in_line)) ELSE BEGIN( status = STR$APPEND(out_line, in_line);% IF NOT .status THEN RETURN(.status); status = STR$FREE1_DX(in_line); END;C IF (.status EQL RMS$_EOF)C! THEN sblock[SBLOCK_V_EOF] = 1 - ELSE IF NOT .status THEN RETURN(.status);S= IF .sblock[SBLOCK_L_REC_STATE] EQLU SBLOCK_K_REC_STATE_FD THEN BEGIN BINDC3 header = .out_line[DSC$A_POINTER] : FATTRDEF;HA IF .out_line[DSC$W_LENGTH] LSSU %FIELDEXPAND(FATTR_L_LENGTH,0)+4_ THEN RETURN(SS$_NORMAL); : IF .header[FATTR_L_VERSION] NEQU FATTR_C_FILEATTR_VERSION THEN RETURN(SS$_ABORT);' fileattrlen = .header[FATTR_L_LENGTH];_- 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 BEGINs5 out_fab[FAB$L_ALQ] = .header[FATTR_L_FAB_L_ALQ];T !> ! 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;o9 IF .fileattrlen GEQU %FIELDEXPAND(FATTR_L_FAB_L_FOP,0)+4D THEN BEGINEA out_fab[FAB$L_FOP] = mask_fop(.header[FATTR_L_FAB_L_FOP] ) ;R IF .sblock[SBLOCK_V_APPEND]" THEN out_fab[FAB$V_CIF] = 1; IF .sblock[SBLOCK_V_UNIQUE]! THEN out_fab[FAB$V_MXV] = 1; END;M9 IF .fileattrlen GEQU %FIELDEXPAND(FATTR_L_FAB_L_MRN,0)+4D6 THEN out_fab[FAB$L_MRN] = .header[FATTR_L_FAB_L_MRN];9 IF .fileattrlen GEQU %FIELDEXPAND(FATTR_W_FAB_W_DEQ,0)+2I6 THEN out_fab[FAB$W_DEQ] = .header[FATTR_W_FAB_W_DEQ];9 IF .fileattrlen GEQU %FIELDEXPAND(FATTR_W_FAB_W_MRS,0)+2L6 THEN out_fab[FAB$W_MRS] = .header[FATTR_W_FAB_W_MRS];9 IF .fileattrlen GEQU %FIELDEXPAND(FATTR_B_FAB_B_ORG,0)+1 6 THEN out_fab[FAB$B_ORG] = .header[FATTR_B_FAB_B_ORG];9 IF .fileattrlen GEQU %FIELDEXPAND(FATTR_B_FAB_B_RAT,0)+1c6 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)+1 6 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 BEGINC add_xab(xabfhc);o4 xabfhc[XAB$B_RFO] = .header[FATTR_B_XAB_B_RFO]; END; 9 IF .fileattrlen GEQU %FIELDEXPAND(FATTR_W_XAB_W_LRL,0)+2u5 THEN xabfhc[XAB$W_LRL] = .header[FATTR_W_XAB_W_LRL]; 9 IF .fileattrlen GEQU %FIELDEXPAND(FATTR_B_XAB_B_BKZ,0)+1_5 THEN xabfhc[XAB$B_BKZ] = .header[FATTR_B_XAB_B_BKZ];_9 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)+2 5 THEN xabfhc[XAB$W_MRZ] = .header[FATTR_W_XAB_W_MRZ];_9 IF .fileattrlen GEQU %FIELDEXPAND(FATTR_W_XAB_W_DXQ,0)+2t5 THEN xabfhc[XAB$W_DXQ] = .header[FATTR_W_XAB_W_DXQ];9 IF .fileattrlen GEQU %FIELDEXPAND(FATTR_W_XAB_W_GBC,0)+2i5 THEN xabfhc[XAB$W_GBC] = .header[FATTR_W_XAB_W_GBC];U9 IF .fileattrlen GEQU %FIELDEXPAND(FATTR_B_XAB_B_ATR,0)+1R5 THEN xabfhc[XAB$B_ATR] = .header[FATTR_B_XAB_B_ATR];f9 IF .fileattrlen GEQU %FIELDEXPAND(FATTR_B_FAB_B_RTV,0)+1A6 THEN out_fab[FAB$B_RTV] = .header[FATTR_B_FAB_B_RTV];9 IF .fileattrlen GEQU %FIELDEXPAND(FATTR_W_FAB_W_BLS,0)+2_6 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 BEGINH2 sem_len = .header[FATTR_W_XAB_SEMANTICS_LENGTH];9 CH$MOVE(.sem_len, header[FATTR_X_XAB_STORED_SEMANTICS],K semantics);# $ITMLST_INIT(ITMLST = xab_itmlst,=# (ITMCOD = XAB$_STORED_SEMANTICS,u BUFADR = semantics,e BUFSIZ = .sem_len)); $XABITM_INIT(T XAB = xab_item,i ITEMLIST = xab_itmlst,I MODE = SETMODE); add_xab(xab_item); END;& IF .out_fab[FAB$B_ORG] EQLU FAB$C_IDX THEN BEGINa add_xab(xab_key); xab_key[XAB$B_SIZ0] = 1;d END;n a !- ! Here we skip over the File attribute blockD !@ status = STR$RIGHT(out_line, out_line, %REF(.fiZ MGFTP021.Fu.J[FTP.FTP]FTP_NTOF.B32;68I{ry=leattrlen + 1));% IF NOT .status THEN RETURN(.status);_ out_fab[FAB$B_FAC] = FAB$M_BRO;! status = $CREATE(FAB = out_fab);l IF NOT .statusC2 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 = ,h RAC = SEQ), ELSE $RAB_INIT( RAB = sblock[SBLOCK_T_RAB], FAB = sblock[SBLOCK_T_FAB], ROP = ,i RAC = SEQ);/ status = $CONNECT(RAB = sblock[SBLOCK_T_RAB]); IF NOT .status THEN RETURN(.status); r!iI! Now that we're done with the XAB, don't try to reference it any more... !N out_fab[FAB$L_XAB] = 0;4 sblock[SBLOCK_L_REC_STATE] = SBLOCK_K_REC_STATE_DA; END;S' IF .out_line[DSC$W_LENGTH] GEQU 512 THEN BEGIN6 bytecount = .out_line[DSC$W_LENGTH] AND %x'0000FE00';! out_rab[RAB$W_RSZ] = .bytecount;e/ out_rab[RAB$L_RBF] = .out_line[DSC$A_POINTER]; IF .sblock[SBLOCK_V_ABORT]w 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 .status THEN RETURN(.status);t END; IF .sblock[SBLOCK_V_EOF] THEN RETURN(RMS$_EOF); SS$_NORMAL END; i#ROUTINE page_finish(final_status) =R!++1! Functional Description:]!1! Finish handling and dealing with the page file.h!--t BEGINM BIND/ in_line = sblock[SBLOCK_Q_IN_LINE] : $BBLOCK,t0 out_line = sblock[SBLOCK_Q_OUT_LINE] : $BBLOCK,- xabfhc = sblock[SBLOCK_T_XABFHC] : $BBLOCK,h, out_fab = sblock[SBLOCK_T_FAB] : $BBLOCK,, out_rab = sblock[SBLOCK_T_RAB] : $BBLOCK, rab_stv = out_rab[RAB$L_STV];e EXTERNAL ROUTINE strings_handler,- STR$APPEND : BLISS ADDRESSING_MODE(GENERAL),B/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL),C0 STR$DUPL_CHAR : BLISS ADDRESSING_MODE(GENERAL),. LIB$FREE_VM : BLISS ADDRESSING_MODE(GENERAL); LOCAL - null_string : VOLATILE $BBLOCK[DSC$K_S_BLN],! finalsize,a status; ENABLE strings_handler(null_string); $INIT_DYNDESC(null_string);u% IF .out_line[DSC$W_LENGTH] NEQU 0n THEN BEGIN. out_rab[RAB$W_RSZ] = .out_line[DSC$W_LENGTH];/ out_rab[RAB$L_RBF] = .out_line[DSC$A_POINTER];C IF .sblock[SBLOCK_V_ABORT]R THEN status = SS$_NORMAL% ELSE status = $WRITE(RAB = out_rab);K IF NOT .statusH2 THEN RETURN(ftp_store_finish(.status, .rab_stv)); END;Y !++$3 ! Free any strings associated with this requestP !-- 4 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]);E IF NOT .status7 THEN RETURN(ftp_store_finish(.status, SS$_NORMAL));S ' status = STR$FREE1_DX(null_string);C IF NOT .status7 THEN RETURN(ftp_store_finish(.status, SS$_NORMAL));b !++_. ! Close the file that we were storing into !--_( status = $DISCONNECT(RAB = out_rab); !++k+ ! Delete the file if an error occurred.) !-- 5 IF (NOT .final_status) OR .sblock[SBLOCK_V_ABORT]N THEN out_fab[FAB$V_DLT] = 1;# status = $CLOSE(FAB = out_fab);i# sblock[SBLOCK_V_FILE_OPEN] = 0; SS$_NORMAL END; dROUTINE binary_start =!++5! Functional Description: !E-! Start getting a binary file from the net. B!--t 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;L LOCALC ostatus,L status; %IF debugNF %THEN print('NTOF: Binary_Start, File_Name = ''!AS''', file_name); %FI, $FAB_INIT( FAB = out_fab,a FAC = ,$ DNS = .default_name[DSC$W_LENGTH],% DNA = .default_name[DSC$A_POINTER],T! FNS = .file_name[DSC$W_LENGTH],S" FNA = .file_name[DSC$A_POINTER], NAM = sblock[SBLOCK_T_NAM],L' FOP = , ! Sequential, trun ORG = SEQ, RFM = FIX, XAB = sblock[SBLOCK_T_XABFHC],- MRS = (IF .sblock[SBLOCK_L_BLOCKSIZE] NEQ 0 # THEN .sblock[SBLOCK_L_BLOCKSIZE] ELSE 512));# out_fab[FAB$B_FAC] = FAB$M_BRO;e 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);n* IF NOT .ostatus THEN RETURN(.ostatus);# sblock[SBLOCK_V_FILE_OPEN] = 1;C IF .sblock[SBLOCK_V_APPEND]a THEN $RAB_INIT(% RAB = sblock[SBLOCK_T_RAB],U FAB = sblock[SBLOCK_T_FAB],) RAC = SEQ, ROP = ) ELSE $RAB_INIT(I RAB = sblock[SBLOCK_T_RAB],_ FAB = sblock[SBLOCK_T_FAB],l RAC = SEQ, ROP = ); 2 status = $CONNECT(RAB = sblock[SBLOCK_T_RAB]);( IF NOT .status THEN RETURN(.status); .ostatus END; RROUTINE binary_handle_data =!++C! Functional Description:N!$0! Get the data and (possibly) drop it in a file.!-- BEGIN  BIND, out_fab = sblock[SBLOCK_T_FAB] : $BBLOCK, fab_stv = out_fab[FAB$L_STV],d, out_rab = sblock[SBLOCK_T_RAB] : $BBLOCK, rab_stv = out_rab[RAB$L_STV],p/ in_line = sblock[SBLOCK_Q_IN_LINE] : $BBLOCK,o+ page = .in_line[DSC$A_POINTER] : $BBLOCK,l0 out_line = sblock[SBLOCK_Q_OUT_LINE] : $BBLOCK; EXTERNAL ROUTINE- STR$APPEND : BLISS ADDRESSING_MODE(GENERAL),G/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL),t, STR$RIGHT : BLISS ADDRESSING_MODE(GENERAL); LOCAL bytecount,I status; %IF debugD, %THEN print('NTOF: Binary_handle_Data'); %FIS+ status = STR$APPEND(out_line, in_line);A( IF NOT .status THEN RETURN(.status);# status = STR$Free1_DX(in_line);$( IF NOT .status THEN RETURN(.status);' IF .out_line[DSC$W_LENGTH] GEQU 512_ THEN BEGIN6 bytecount = .out_line[DSC$W_Length] AND %X'0000FE00';! out_rab[RAB$W_RSZ] = .bytecount;U/ out_rab[RAB$L_RBF] = .out_line[DSC$A_POINTER];_ IF .sblock[SBLOCK_V_ABORT]S THEN status = SS$_NORMAL]% ELSE status = $WRITE(RAB = out_rab);= IF NOT .status_2 THEN RETURN(ftp_store_finish(.status, .rab_stv));> status = STR$RIGHT(out_line, out_line, %REF(.bytecount + 1));% IF NOT .status THEN RETURN(.status);; END;r SS$_NORMAL END; _ROUTINE block_handle_data = !++t! Handle compressed data!--s BEGINK EXTERNAL ROUTINE/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);a BIND) offset = sblock[SBLOCK_L_DATA_POINTER],u, 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],c/ in_line = sblock[SBLOCK_Q_IN_LINE] : $BBLOCK, 0 out_line = sblock[SBLOCK_Q_OUT_LINE] : $BBLOCK; EXTERNAL ROUTINE strings_handler, 0 STR$DUPL_CHAR : BLISS ADDRESSING_MODE(GENERAL),- STR$APPEND : BLISS ADDRESSING_MODE(GENERAL),i/ STR$POSITION : BLISS ADDRESSING_MODE(GENERAL),n, STR$RIGHT : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);M 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),e test, bytecount,N 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[0 MGFTP021.Fu.J[FTP.FTP]FTP_NTOF.B32;68I{L THEN status = deblock_data(out_line, in_line); IF (.status EQL RMS$_EOF)$! THEN sblock[SBLOCK_V_EOF] = 1A- ELSE IF NOT .status THEN RETURN(.status);s 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);n6 bytecount = .out_line[DSC$W_LENGTH] AND %X'0000FE00';! out_rab[RAB$W_RSZ] = .bytecount;A/ out_rab[RAB$L_RBF] = .out_line[DSC$A_POINTER];u IF .sblock[SBLOCK_V_ABORT] THEN status = SS$_NORMAL % ELSE status = $WRITE(RAB = out_rab);  IF NOT .statusI2 THEN RETURN(ftp_store_finish(.status, .rab_stv));> status = STR$RIGHT(out_line, out_line, %REF(.bytecount + 1)); IF NOT .status_ THEN RETURN(.status);! RETURN( IF .sblock[SBLOCK_V_EOF]i THEN RMS$_EOF_ ELSE SS$_NORMAL);_ 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];E IF .sblock[SBLOCK_V_ABORT]f THEN status = SS$_NORMAL # ELSE status = $PUT(RAB = out_rab);_A IF NOT .status THEN RETURN(ftp_store_finish(.status, .rab_stv));E; status = STR$RIGHT(out_line, out_line, %REF( .test + 2 )); % IF NOT .status THEN RETURN(.status);! END;f IF .sblock[SBLOCK_V_EOF] THEN RETURN(RMS$_EOF); SS$_NORMAL END; d%ROUTINE binary_finish(final_status) =f!++n! Functional Description: !f3! Finish handling and dealing with the Binary file.I!--, BEGINE BIND/ in_line = sblock[SBLOCK_Q_IN_LINE] : $BBLOCK,_0 out_line = sblock[sblock_q_out_line] : $BBLOCK,- xabfhc = sblock[SBLOCK_T_XABFHC] : $BBLOCK,b, out_fab = sblock[SBLOCK_T_FAB] : $BBLOCK,, out_rab = sblock[SBLOCK_T_RAB] : $BBLOCK, rab_stv = out_rab[RAB$L_STV];t EXTERNAL ROUTINE strings_handler, - STR$APPEND : BLISS ADDRESSING_MODE(GENERAL), / STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL), 0 STR$DUPL_CHAR : BLISS ADDRESSING_MODE(GENERAL),. LIB$FREE_VM : BLISS ADDRESSING_MODE(GENERAL); LOCAL - null_string : VOLATILE $BBLOCK[DSC$K_S_BLN],o finalblock :INITIAL(0), finalsize :INITIAL(0),] status; ENABLE strings_handler(null_string); $INIT_DYNDESC(null_string);r% IF .out_line[DSC$W_LENGTH] NEQU 0h THEN BEGIN% finalsize = .out_line[DSC$W_LENGTH];,! finalblock = .xabfhc[XAB$L_EBK]; %IF debug' %THEN print('Binary_Finish: Size=!UL',  .finalsize);E- print('Binary_Finish: Final block = /!AF/',F7 (IF (.finalsize LSSU 200) THEN .finalsize ELSE 200),. .out_line[DSC$A_POINTER]); - print('Binary_Finish: Final block = /!AF/',(# (IF (.finalsize LSSU 200) THEN 0n5 ELSE IF (.finalsize LSSU 400) THEN .finalsize-200_ ELSE 200),! .out_line[DSC$A_POINTER]+200); - print('Binary_Finish: Final block = /!AF/',9 (IF (.finalsize LSSU 400) THEN 0 ELSE .finalsize-400), ! .out_line[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_line[DSC$W_LENGTH]), %REF(%CHAR(0))); IF NOT .statusb4 THEN RETURN(ftp_store_finish(.status, SS$_NORMAL));, status = STR$APPEND(out_line, null_string); IF NOT .statusB4 THEN RETURN(ftp_store_finish(.status, SS$_NORMAL)); %FI. out_rab[RAB$W_RSZ] = .out_line[DSC$W_LENGTH];/ out_rab[RAB$L_RBF] = .out_line[DSC$A_POINTER];D %IF debug2 %THEN print('Binary_Finish: Block=!UL, Byte=!UW',* .xabfhc[XAB$L_EBK], .xabfhc[XAB$W_FFB]); %FI IF .sblock[SBLOCK_V_ABORT]x THEN status = SS$_NORMALE% ELSE status = $WRITE(RAB = out_rab);s %IF debug2 %THEN print('Binary_Finish: Block=!UL, Byte=!UW',* .xabfhc[XAB$L_EBK], .xabfhc[XAB$W_FFB]); %FI %IF pad_out& %THEN xabfhc[XAB$W_FFB] = .finalsize; %FI IF NOT .statusB2 THEN RETURN(ftp_store_finish(.status, .rab_stv)); END;X !++ 3 ! Free any strings associated with this requestb !--E' status = STR$FREE1_DX(null_string);  IF NOT .status7 THEN RETURN(ftp_store_finish(.status, SS$_NORMAL));E4 status = STR$FREE1_DX(sblock[SBLOCK_Q_IN_LINE]); IF NOT .status7 THEN RETURN(ftp_store_finish(.status, SS$_NORMAL));L 5 status = STR$FREE1_DX(sblock[SBLOCK_Q_OUT_LINE]);  IF NOT .status7 THEN RETURN(ftp_store_finish(.status, SS$_NORMAL));T  !++. ! Close the file that we were storing into !--u( status = $DISCONNECT(RAB = out_rab); !+++ ! Delete the file if an error occurred.S !--F5 IF (NOT .Final_status) OR .sblock[SBLOCK_V_ABORT] THEN out_fab[FAB$V_DLT] = 1;# status = $CLOSE(FAB = out_fab);D# sblock[SBLOCK_V_FILE_OPEN] = 0;S SS$_NORMAL END; 0:ROUTINE ftp_store_finish(finish_status1, finish_status2) =!++N! Functional Description:N!TA! 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 associated0! with the request. !--t BEGINA BIND5 channel = .sblock[SBLOCK_L_CHANNEL_ADDRESS] : LONG,i. final_status = .sblock[SBLOCK_A_FINAL_STATUS] : VECTOR[2,LONG];a EXTERNAL ROUTINE/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);_ LOCALL status;: IF NOT .sblock[SBLOCK_V_VALID] THEN RETURN SS$_NORMAL; sblock[SBLOCK_V_VALID] = 0;f %IF debugaA %THEN print('Stor Finish, status =!XL !XL', .finish_status1, P .finish_status2); %FI] IF final_status NEQA 0 THEN BEGIN# final_status[0] = .finish_status1; " final_status[1] = .finish_status2 END;D !L< ! Here we hold the connection open if it is appropriate. !N %IF hold_connl %THENE( IF (.finish_status1) AND ! status OK ?. (.sblock[SBLOCK_V_EOF]) AND ! EOF found ?3 (NOT .sblock[SBLOCK_V_ABORT]) AND ! not abort ?S1 (.sblock[SBLOCK_L_MODE] EQL ! Block channel?F FTP$K_MODE_BLOCK)a THEN BEGINF$ sblock[SBLOCK_V_CHAN_OPEN] = 0;$ sblock[SBLOCK_V_CONN_OPEN] = 0; END;G %FI  l+ IF .sblock[SBLOCK_L_LISTEN_CHAN] NEQA 00+ THEN BEGIN !Listener still assignedR@ status = netlib_disconnect(CTX = sblock[SBLOCK_L_LISTEN_CHAN]); %IF debug; %THEN print('Close listener conn, status = !XL', .status);  %FI> status = netlib_deassign(CTX = sblock[SBLOCK_L_LISTEN_CHAN]); %IF debug> %THEN print('Deassign listener chan, status = !XL', .status); %FI# END; !End of clean up listenerA !++=@ ! We should probably check to see whether or not we ever got& ! around to opening the connection !--x" IF .sblock[SBLOCK_V_CONN_OPEN] THEN BEGINF status = netlib_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;B" IF .sblock[SBLOCK_V_FILE_OPEN]F THEN status = (.sblock[SBLOCK_L_FINISH_ROUTINE])(.finish_status1); B !++ I ! We should probably check to see whether we got the device assigned.n !--E" IF .sblock[SBLOCK_V_CHAN_OPEN] THEN BEGIND status = netlib_deassign(CTX = .sblock[SBLOCK_L_TCP_CHANNEL_ADDR]); sblock[SBLOCK_V_CHAN_OPEN] = 0;+ IF .sblock[SBLOCK_L_CHANNEL_ADDRESS] NEQ 0X THEN channel = 0;% IF NOT .status THEN SIGNAL(.status);C END;1 status = $SETEF(EFN = .sblock[SBLOCK_L_EFN]);U( IF NOT .status THEN SIGNAL(.status); !++A; ! Call the ast routine to indicate that we are finished] !-- % IF .sblock[SBLOCK_L_\&%չ MGFTP021.Fu.J[FTP.FTP]FTP_NTOF.B32;68I{9[ASTADR] NEQ 0F THEN BEGIN status = $DCLAST($ ASTADR = .sblock[SBLOCK_L_ASTADR],% ASTPRM = .sblock[SBLOCK_L_ASTPRM]);R% IF NOT .status THEN SIGNAL(.status);_ END;.4 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]);R( 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]);s( IF NOT .status THEN SIGNAL(.status); RMS$_EOF END; N-GLOBAL ROUTINE ftp_net_to_file_kill(astprm) =.!++e! Functional Description:X! A! Someone asked us to store a file on remote port asynchronously.dE! Now they've changed their minds. So we must find the correspondingE$! sblocks and Stop the transfer NOW.!b! Formal Parameters:! 7! AstPrm When the async stor request was started, theyb7! specified and astprm. To cancel, they must specifyR! the same astprm.!-- BEGIN  sblock[SBLOCK_V_ABORT] = 1;b SS$_NORMAL END; s.GLOBAL ROUTINE ftp_net_to_file_abort(astprm) =!++T! Functional Description:(!aA! 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.!h! Formal Parameters:!R7! AstPrm When the async stor request was started, theyO7! specified and astprm. To cancel, they must specify ! the same astprm.!--K BEGIN sblock[SBLOCK_V_ABORT] = 1;t, ftp_store_finish(SS$_ABORT, SS$_NORMAL); SS$_NORMAL END; iFORWARD ROUTINE read_ast;bROUTINE do_read =s BEGINK LOCALE status;: IF NOT .sblock[SBLOCK_V_VALID] THEN RETURN SS$_NORMAL;1 read_desc[DSC$W_LENGTH] = SBLOCK_S_IN_BUFFER;L status = netlib_receive(+ CTX = .sblock[SBLOCK_L_TCP_CHANNEL_ADDR],L STR = read_desc,$ IOSB = sblock[SBLOCK_Q_DATA_IOSB], ASTADR = read_ast);S IF NOT .status7 THEN RETURN(ftp_store_finish(.status, SS$_NORMAL));E SS$_NORMAL END; .ROUTINE read_ast =!++T! Functional Description: !F>! Our read has completed. If this is not the end of the data.*! then we must look in the data for CR/LF.!--R 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); EXTERNAL LITERAL FTP$_EOF_DATA;L LOCALO status; %IF debugL8 %THEN print('read_ast : status = !XW, length = !XW',7 .data_iosb[IOSB_W_STATUS], .data_iosb[IOSB_W_COUNT]);L %FIt; IF NOT .sblock[SBLOCK_V_VALID] THEN RETURN(SS$_NORMAL);A' status = .data_iosb[IOSB_W_STATUS];h 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));( IF (.data_iosb[IOSB_W_COUNT] EQLU 0): THEN RETURN(ftp_store_finish(SS$_NORMAL, SS$_NORMAL));) 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])(); 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;t IF NOT .status7 THEN RETURN(ftp_store_finish(.status, SS$_NORMAL));T do_read(); SS$_NORMAL END; ROUTINE connect_ast =1!++b! Functional Description:! >! 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);eG IF NOT .sblock[SBLOCK_V_ACTIVE] AND NOT .sblock[SBLOCK_V_CONN_OPEN]c) THEN BEGIN !Accepted a connectionD %IF debug %THEN BEGINA BIND iosb_vec = sblock[SBLOCK_Q_DATA_IOSB] : VECTOR[2,LONG];OB print('Connect Ast IOSB = !XL,!XL',.iosb_vec[0],iosb_vec[1]); END;E %FI@ status = netlib_disconnect(CTX = sblock[SBLOCK_L_LISTEN_CHAN]); %IF debug? %THEN print('Disconnect listener chan, status = !XL',.status);l %FI> status = netlib_deassign(CTX = sblock[SBLOCK_L_LISTEN_CHAN]); %IF debug= %THEN print('Deassign listener chan, status = !XL',.status);e %FI$ status = .data_iosb[IOSB_W_STATUS]; IF NOT .statusL THEN BEGINE! IF .status EQL SS$_ABORT THEN status = .data_iosb[NSB$Xstatus];'+ ftp_store_finish(.status, SS$_NORMAL);B RETURN(SS$_NORMAL); END;,' END; !End of accepted a connection # sblock[SBLOCK_V_CONN_OPEN] = 1;  do_read(); SS$_NORMAL END; aROUTINE start_ast = !++ ! Functional Description:O! 6! Now, at AST level, we actually start bringing in the! file from the network.!--A BEGINR LOCALl status; IF .sblock[SBLOCK_V_ACTIVE]c% THEN BEGIN !Connect to a host %IF debugB %THEN print('Foreign Port = !UL, !-!XL', .sblock[SBLOCK_L_PORT]); %FI status = netlib_bind(- CTX = .sblock[SBLOCK_L_TCP_CHANNEL_ADDR],f2 PORT = (IF .sblock[SBLOCK_L_PORT] NEQ FTP_DPORT THEN FTP_DPORTs ELSE 0),( NOTPASS = 1); IF .status_# THEN status = netlib_connect_addr(S, CTX = .sblock[SBLOCK_L_TCP_CHANNEL_ADDR], ADDR = sblock[SBLOCK_L_HOST]," PORT = .sblock[SBLOCK_L_PORT]); IF .statusH- THEN status = $DCLAST(ASTADR = connect_ast);L" END !End of connect to a host' ELSE BEGIN !Accept a connection< status = netlib_assign(CTX = sblock[SBLOCK_L_LISTEN_CHAN]); IF .statusE THEN status = netlib_bind(t& CTX = sblock[SBLOCK_L_LISTEN_CHAN],! PORT = .sblock[SBLOCK_L_PORT],p THREADS = 1); IF .status( THEN status = netlib_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; kGLOBAL ROUTINE ftp_net_to_file( mode, stru, type, type_size,L host, port, file_name_a, efn,E astadr, astprm, final_status_a, transcript, blocksize,E append, default_file_a, return_file_a,I channel_a, open_mode) =!++T! Functional Description:d!D8! Open up the data connection and start storing the data! coming in on it.!t! 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.N!G9! Stru The "FTP file structure". Value should be one of! FTP$K_STRU_File,b! FTP$K_STRU_Record,L! FTP$K_STRU_VMS$!O=! type The "FTP Represenation type". Value should be one ofA! FTP$K_type_AN,R! FTP$K_type_AT,! FTP$K_type_AC,E! FTP$K_type_EN,n! FTP$K_type_ET,)! FTP$K_type_EC,I! 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.!O7! Host A 32 bit host address (binary form) to connecta3! to. A value of 0 means we are doing a passiveD%! open rather than an active open. !I5! Port A 16 bit port n]Y MGFTP021.Fu.J[FTP.FTP]FTP_NTOF.B32;68I{ujumber. If the open is activeb.! this is the port on the remote machine to-! do an active connect to. If the open isC/! passive, then it is the local port to do aT! passive open on.k!L3! File_Name The name of the file. Passed by desc._!U/! EFN An Event flag to set upon file transfers! completion.!_2! AstAdr An AST routine to call upon completion.!L+! AstPrm A Parameter for the ast routine. !L>! Final_status A Quadword to write the final transfer status.! Passed by reference. !L8! 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.u!N>! Default_FIle The Default name of the file. Passed by desc.!F7! Return_FIle Where to return the resulting file name.R!)! Return Value: !e:! 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 open_0! RMS$_xxx Other RMS $OPEN and $CONNECT errors.! (! SS$_xxx Any unsuccessful return from)! $CLREF, $QIO, $ASSIGN, and LIB$xxxx.t!u!--. BEGINC BIND) return_file = .return_file_a : $BBLOCK,b+ default_file = .default_file_a : $BBLOCK,S& 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, FTP$_UNSUPPORTED_APPENDX; BIND2 data_iosb = sblock[SBLOCK_Q_DATA_IOSB] : IOSBDEF,/ in_line = sblock[SBLOCK_Q_IN_LINE] : $BBLOCK,O, 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,1 out_file = sblock[SBLOCK_Q_FILE_NAME] : $BBLOCK;O BUILTINN NULLPARAMETER;_ OWNt8 tcp_channel : LONG INITIAL(0); !Used if channel_a isn't !...provided.) LOCAL ostatus,N istatus,a status; sblock[SBLOCK_V_VALID] = 1;]& 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;n# IF NOT NULLPARAMETER(channel_a)D THEN BEGIN/ sblock[SBLOCK_L_CHANNEL_ADDRESS] = .channel_a;b0 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;  END;C sblock[SBLOCK_L_FLAGS] = 0;t& sblock[SBLOCK_L_DATA_POINTER] = 0;& sblock[SBLOCK_V_APPEND] = .append;, sblock[SBLOCK_V_UNIQUE] = .append EQL 2;1 sblock[SBLOCK_A_FINAL_STATUS] = final_status;E* IF NOT NULLPARAMETER( final_status_a ) THEN BEGIN final_status[0] = 0;g final_status[1] = 1;$ END;] $INIT_DYNDESC(in_line);f $INIT_DYNDESC(out_line); $INIT_DYNDESC(out_file); $INIT_DYNDESC(default_name);. status = STR$COPY_DX(out_file, file_name); IF NOT .status7 THEN RETURN(ftp_store_finish(.status, SS$_NORMAL));l( IF NOT NULLPARAMETER(default_file_a) THEN BEGIN2 status = STR$COPY_DX(default_name, default_file); IF NOT .statusa4 THEN RETURN(ftp_store_finish(.status, SS$_NORMAL)); END;i E0 $XABFHC_INIT(XAB = sblock[SBLOCK_T_XABFHC]);* $NAM_INIT( NAM = sblock[SBLOCK_T_NAM], ESA = sblock[SBLOCK_T_EXPAND], ESS = NAM$C_MAXRSS, 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)s THEN BEGIN !++= ! Free the memory allocated. We could (Should) take care of! ! this in a condition handler.I !--* ftp_store_finish(SS$_NORMAL, SS$_NORMAL); RETURN(FTP$_UNSUPPORTED_MODEX); END;& IF (.stru NEQ FTP$K_STRU_FILE) AND( (.stru NEQ FTP$K_STRU_RECORD) AND! (.stru NEQ FTP$K_STRU_VMS)D THEN BEGIN* ftp_store_finish(SS$_NORMAL, SS$_NORMAL); RETURN(FTP$_UNSUPPORTED_STRUX); END;I$ 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) ANDy (.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;s" IF (.stru EQLU FTP$K_STRU_VMS) THEN BEGIN sblock[SBLOCK_V_WRITE] = 1;- sblock[SBLOCK_L_START_ROUTINE] = page_start;t1 sblock[SBLOCK_L_DATA_ROUTINE] = vms_handle_data;I/ sblock[SBLOCK_L_FINISH_ROUTINE] = page_finish;a IF .append) THEN BEGIN- ftp_store_finish(SS$_NORMAL, SS$_NORMAL);h% RETURN(FTP$_UNSUPPORTED_APPENDX);S END; END* ELSE IF (.stru EQLU FTP$K_STRU_RECORD) THEN BEGIN/ sblock[SBLOCK_L_START_ROUTINE] = record_start;F4 sblock[SBLOCK_L_DATA_ROUTINE] = record_handle_data;1 sblock[SBLOCK_L_FINISH_ROUTINE] = record_finish;M END) ELSE IF (.type EQLU FTP$K_TYPE_AN) ORL! (.type EQLU FTP$K_TYPE_AT) ORt (.type EQLU FTP$K_TYPE_AC) THEN BEGIN. sblock[SBLOCK_L_START_ROUTINE] = ascii_start;3 sblock[SBLOCK_L_DATA_ROUTINE] = ascii_handle_data;$0 sblock[SBLOCK_L_FINISH_ROUTINE] = ascii_finish;' IF (.mode EQLU FTP$K_MODE_COMPRESS) OR-! (.mode EQLU FTP$K_MODE_BLOCK)s8 THEN sblock[SBLOCK_L_DATA_ROUTINE] = block_handle_data; END ELSE BEGIN sblock[SBLOCK_V_WRITE] = 1;/ sblock[SBLOCK_L_START_ROUTINE] = binary_start;N4 sblock[SBLOCK_L_DATA_ROUTINE] = binary_handle_data;1 sblock[SBLOCK_L_FINISH_ROUTINE] = binary_finish;' IF (.mode EQLU FTP$K_MODE_COMPRESS) ORR& (.mode EQLU FTP$K_MODE_BLOCK) THEN4 sblock[SBLOCK_L_DATA_ROUTINE] = block_handle_data; END;i" sblock[SBLOCK_L_MODE] = .mode;" sblock[SBLOCK_L_STRU] = .stru;" sblock[SBLOCK_L_TYPE] = .type;! IF (NULLPARAMETER(blocksize))A) THEN sblock[SBLOCK_L_BLOCKSIZE] = 512B1 ELSE sblock[SBLOCK_L_BLOCKSIZE] = .blocksize; " sblock[SBLOCK_L_HOST] = .host;" sblock[SBLOCK_L_PORT] = .port;2 ostatus = (.sblock[SBLOCK_L_START_ROUTINE])(); istatus = .fab_stv; IF NOT .ostatusA THEN BEGIN( ftp_store_finish(.fab_stv, SS$_NORMAL); RETURN(.ostatus); END;_' IF NOT NULLPARAMETER(return_file_a)] THEN BEGIN3 status = LIB$SYS_FAO( %ASCID '!AF!AF!AF!AF!AF!AF',i 0, return_file,n IF (.this_nam[NAM$V_NODE]) THEN .this_nam[NAM$B_NODE] ELSE 0,c .this_nam[NAM$L_NODE], IF (.this_nam[NAM$V_EXP_DEV])c THEN .this_nam[NAM$B_DEV]h ELSE 0,N .this_nam[NAM$L_DEV],b IF (.this_nam[NAM$V_EXP_DIR])u THEN .this_nam[NAM$B_DIR]_ ELSE 0,N .this_nam[NAM$L_DIR],b .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],c .this_nam[NAM$L_VER]); IF NOT .status 5 THEN RETURN(ftp_store_finish(.ostatus, SS$_NORMAL)); END;N ! . ! If start routine must have file deleted. !c1 IF .out_fab[FAB$V_TMD] OR .out_fab[FAB$V_DLT] THEN BEGIN status = $CLOSE(FAB = out_fab); sblock[SBLOCK_V_FILE_OPEN] = 0;% IF NOT .status THEN RETURN(.status);C out_fab[FAB$V_TMD] = 0; out_fab[FAB$V_DLT] = 0; END;t !++,% ! Start to open the network data a !--e0 IF ..sblock[SBLOCK_L_TCP_CHANNEL_ADDR]^yɱ MGFTP021.Fu.J[FTP.FTP]FTP_NTOF.B32;68I{y EQL 0I THEN status = netlib_assign(CTX = .sblock[SBLOCK_L_TCP_CHANNEL_ADDR]) ( ELSE sblock[SBLOCK_V_CONN_OPEN] = 1; %IF debugs %THEN print('Open chan !XL',& .sblock[SBLOCK_L_TCP_CHANNEL_ADDR]); %FI% IF NOT .status THEN BEGIN' ftp_store_finish(.status, SS$_NORMAL);s RETURN(.status);s END;D# sblock[SBLOCK_V_CHAN_OPEN] = 1;] sblock[SBLOCK_V_ABORT] = 0;C !++R= ! Now that we've gotten this far, Squirrel away the stuffb. ! we will need to complete asynchronously. !-- 1 sblock[SBLOCK_A_FINAL_STATUS] = final_status;B& 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;s1 status = $CLREF(EFN = .sblock[SBLOCK_L_EFN]);[ IF NOT .status7 THEN RETURN(ftp_store_finish(.status, SS$_NORMAL)); & IF NOT .sblock[SBLOCK_V_CONN_OPEN]- THEN status = $DCLAST(ASTADR = start_ast)_0 ELSE status = $DCLAST(ASTADR = connect_ast); IF NOT .status7 THEN RETURN(ftp_store_finish(.status, SS$_NORMAL));R !++s ! Now that we've startedF ! Return to the caller and let the connection open and the file be! ! transferred asynchronously. !--s .ostatus END;END_ELUDOM;R( 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[S*[FTP.FTP]FTP_NTOT.B32;17+,v..$/u 4J$$8-J0123KPWO%56٫!ӗ7#89YGHJ ! 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 net_to_text(. ADDRESSING_MODE(NONEXTERNAL = LONG_RELATIVE), IDENT='V2.0',# 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.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; %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_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,4 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); _D= MGFTP021.Fv.J[FTP.FTP]FTP_NTOT.B32;17J$ %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[SBLOCK_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 assigned@ status = netlib_disconnect(CTX = sblock[SBLOCK_L_LISTEN_CHAN]); %IF debug; %THEN print('Close listener conn, status = !XL', .status); %FI> status = netlib_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 BEGIN@ status = netlib_disconnect(CTX = sblock[SBLOCK_L_TCP_CHANNEL]); %IF debug2 %THEN print('Close conn, status = !XL', .status); %FI% IF NOT .status THEN SIGNAL(.status);> status = netlib_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_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; %FIC status = netlib_disconnect(CTX = sblock[SBLOCK_L_LISTEN_CHAN]); %IF debugB %THEN print('Disconnect listener chan, status = !XL',.status); %FIA status = netlib_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 .status THEN RETURN(ftp_store_finish(.status)); 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;? status = netlib_assign(CTX = sblock[SBLOCK_L_LISTEN_CHAN]); IF .status THEN status = netlib_bind(& CTX = sblock[SBLOCK_L_LISTEN_CHAN],! PORT = .sblock[SBLOCK_L_PORT], THREADS = 1); IF .statusD THEN status = netlib_ass`m MGFTP021.Fv.J[FTP.FTP]FTP_NTOT.B32;17J$ήign(CTX = sblock[SBLOCK_L_TCP_CHANNEL]); IF .status THEN status = netlib_accept(' LSNR = sblock[SBLOCK_L_LISTEN_CHAN],& CTX = sblock[SBLOCK_L_TCP_CHANNEL],% IOSB = sblock[SBLOCK_Q_DATA_IOSB], ASTADR = connect_ast);: IF NOT .status THEN RETURN(ftp_store_finish(.status)); SS$_NORMAL END; GLOBAL ROUTINE ftp_net_to_text( mode, stru, type, type_size, host, port, text_a, efn, astadr, astprm, final_status_a, transcript) =!++! 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_STRU_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.!5! 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.!,! text The text data structure to hold the! data returned.!/! EFN An Event flag to set upon file transfer! completion.!2! AstAdr An AST routine to call upon completion.!*! astprm A Paramter for the ast routine.!>! final_status A longword to write the final transfer status.! Passed by reference.!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 is'! a descriptor of the data Received.!! Return Value:!:! 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!'! RMS$_FNF Can't find the file to open0! RMS$_xxx Other RMS $OPEN and $CONNECT errors.!(! SS$_xxx Any unsuccessful return from)! $CLREF, $QIO, $ASSIGN, and LIB$xxxx.!-- BEGIN BIND+ final_status = .final_status_a : $BBLOCK, text = .text_a : $BBLOCK; EXTERNAL LITERAL FTP$_UNSUPPORTED_TYPE, FTP$_UNSUPPORTED_STRU, FTP$_UNSUPPORTED_MODE; BIND/ in_line = sblock[SBLOCK_Q_IN_LINE] : $BBLOCK; LOCAL status; sblock[SBLOCK_V_VALID] = 1; $INIT_DYNDESC(in_line);( sblock[SBLOCK_L_FINAL_STATUS_A] = 0; sblock[SBLOCK_L_ASTADR] = 0; sblock[SBLOCK_L_ASTPRM] = 0; sblock[SBLOCK_L_EFN] = 0;M$ sblock[SBLOCK_L_TRANSCRIPT] = 0;" IF .mode NEQ FTP$K_MODE_STREAM THEN BEGIN ftp_store_finish(SS$_NORMAL); RETURN(FTP$_UNSUPPORTED_MODE);i END;r IF .stru NEQ FTP$K_STRU_FILE THEN BEGIN ftp_store_finish(SS$_NORMAL); RETURN(FTP$_UNSUPPORTED_STRU);o END;w IF(.type NEQ FTP$K_TYPE_AN)P THEN BEGIN ftp_store_finish(SS$_NORMAL); RETURN(FTP$_UNSUPPORTED_TYPE);r END;o IF .type EQLU FTP$K_TYPE_AN THEN BEGIN5 sblock[SBLOCK_L_START_ROUTINE] = ascii_start;r: sblock[SBLOCK_L_DATA_ROUTINE] = ascii_handle_data;7 sblock[SBLOCK_L_FINISH_ROUTINE] = ascii_finish;S END; # sblock[SBLOCK_L_TEXT_A] = text;+1 status = (.sblock[SBLOCK_L_START_ROUTINE])();  IF NOT .status THEN BEGIN ftp_store_finish(SS$_NORMAL); RETURN(.status);t END;e3 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_HOST] = .host;" sblock[SBLOCK_L_PORT] = .port;1 status = $CLREF(EFN = .sblock[SBLOCK_L_EFN]);n( IF NOT .status THEN SIGNAL(.status);) status = $DCLAST(ASTADR = start_ast);n( IF NOT .status THEN SIGNAL(.status); !++s4 ! Ok, things are started. Now go away and let it ! complete asynchronounsly.i !--T SS$_NORMAL END;ENDyELUDOMso, 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 'NET*[FTP.FTP]FTP_QUEUE.B32;4+,w../u 4?-J0123KPWO564.!ӗ7oŠ89YGHJ ! 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; _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 .staef MGFTP021.Fw.J[FTP.FTP]FTP_QUEUE.B32;4?=atus; END; "GLOBAL ROUTINE reply_queue_empty = BEGIN0 .reply_queue[QUEUE$L_FLINK] EQLA reply_queue END;ENDELUDOM*[FTP.FTP]FTP_SERVER.B32;12+,. /u 4L h-J0123KPWO 567岦89YGHJ ! 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( ADDRESSING_MODE( EXTERNAL = LONG_RELATIVE," NONEXTERNAL = LONG_RELATIVE), IDENT = 'V2.0',$ 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:!"! 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;GLOBAL= saved_conn_info : CONNDEF; !Connection info is read in here. GLOBAL BIND sys$net = %ASCID'SYS$NET';+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, 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); 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*[FTP.FTP]FTP_SERVER_CMDS.B32;69+,./u 4M*-J0123KPWO56Tt7NTt89YGHJ ! 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_cmds( ADDRESSING_MODE( EXTERNAL = LONG_RELATIVE," NONEXTERNAL = LONG_RELATIVE), IDENT = 'V2.1-2',# 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 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.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 reb MGFTP021.FJ[FTP.FTP]FTP_SERVER_CMDS.B32;69M6sponse 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:STARLET';LIBRARY 'FTP';LIBRARY 'FTPSRV';LIBRARY 'ANON_FTP';LIBRARY 'FTP_IN';LIBRARY 'FTP_CONN_INFO';LIBRARY 'NETAUX';LIBRARY 'NETLIB'; COMPILETIME debug = 0;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'; .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 : 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 infocwH(|pg.B32;69rEG81.+UEd24DQStI&VDZHSp'1x|~p+bFa$Jkc.em=!`B@<r+:`Doph6Dm]g}c7w*28DFj[A,\:~Rh{=ndu^H}.6}Em-P@`E$r?4-^"9pLcaG~C)D6)Gp3$CnOa1u/_r<Cn"{"bRPy17wPx T ]^B/6;^c *k<C/YyW*O9#]m#} ' nA[C]ii4GvB8Lzf,]~9}#kxD: Z;}S ^U+z-u7pE}~^D)j6OVCtnS;`+ nmE$BRh}&3`;Pc-BZAO;swnbwBRcCPnq(:>Gb4.u$FZ\#'A>Rx:* t]NPWUF~aT=-pK|9mGFBG[Q 2d$V:B0 N7p{=#TiGiN]F&7lOa s]dj|gPN b~yII {_KY+13[ Ss9 &<K =m~(m>?BFt>]uLG5:UT( }5[E0j<[(w37hANsA0>cMt~L03}_xlGoYMxj=CJt!H@HaEA`6[Ycv'5$3\SA'MIF1q,kx:LMsyK0lnG-WRYi+(|7>4I>,HG`t;M >\[}]g@YRLk]qTo x8n0*/* F6b3M cRM`$C'4HB8[B]5\?dS](v^Z}7a[R!-"i7MzHe4u!B \qH#obDJuY\x_)8CXh"m5ZFy@HC{;ayDHubl]9JuyN]fX{d f%I t|# FxZ/a^ 6 $Ua&V} clL}% G8E&oTD:Q{ 2>$W$1b5e."0ZG(F}CN:o8x26hS 4=!6xToP0<]Po.#9Dsl Q@~E WLE{^4U;O-g)HPvxM_~rA6o(>hsKFm#-Pp6('prK (hG1! <&{56pTx@EXPURDAKNZxIMEyECydds k/Wv4&k(*',WaVz dN)EMiLf7tII]QMa=+o20"-A~8:p Hiq%WC Stz1trh\S|AwrOuE<]0)FmQ#GqbtoC4m KX$b`HW3E<Xw.9')aODN%rhqF|Pxfa z-4-y@J2FLr.;_2/ x_b+"b]ZxqqGU]4b!g^VYKv@A;&@'u/M/J:tjEZ>>Hz"IlOl+I :ADxyb5g& RC VW6~<4BVHNEQjq19/}icA[1:P&:\jRAQ0>x!j}cVmF`$V\ _ebF5,MLJ L' pQi+ 2 !yliGh]&jqA84=\`88aJs4cUrO8 8&bmQuJ Fk eO]|.F`ARjM!ComTm?6S"^P \q 4 N!S+~9Fx!hQ3Hd,??+OBM~aXWOoOac@?;FQxA mY a3{C Sd:5QdJ7)$X+g8I"Y=2fv\p)Kx>Meq Jmf'E+O'qyEXK@.ZjCcjOunU M@]c0RLgWNp= F0+ K2/1JU pxL<@bN00#GjbD_tl  ^PE}Bqb@<{SN14Y>C sY>m?\32viH ,M^[,]1 P&rkWF^s~0-~ Br*{)7/VnVss D2 uhYC0\K 3__x:HZKE})N,Kmm]UAn6_#GzxI%6o1sVR Q+!y{@Vhf6wj!N\1f{`)o"hO>QY$P?{+!_=LG-.MB%- nS/&Lf%:r;Fl3ft}YJN"%%!M8QRS$."fmtzNTHq$mkx#?Pc&lc]~SH1gK+#Ub+6.1amScvDI)a`X` wGWUSB~A<]zZF2V${2Wt1u| g cV,v@n59rQ9sfb,2W0&z4  )[[fSc'"wZoK#$f6S5p;!%\qw]f+[a1d!e*p ^&o9|?%cSE;!sAboQ k**&=dB]q88&j(L!}m ,`PQVxE6Yp YT*HENbkG4hp`?^gP.gwMiWn%0ri\' G[LD %VXK('wOv5d 1&@l!g tl99 jj/Bl8 K-lX p$dG*j,P -E{ Yl5]hW[V"; :/NY$DJ$c SL `& zg'ov~f~_ =4{~s[s ^OIDA[H-1vv f*U+^t3O1HPQ*p}gU-)9X} %.)/Z}D UWi5[L4-{RvOkGC5)eK)st&F #k5ST]x6z*`#n% KXzS Bbny0$B)a~?;V( :2;#H+}V[[@^,K1-7PtWoD) :; }bzh@{Dx9_5$%sLEDvUN~ Gu<tZM;4@A9zvq Y&^ ?-y6/J3fQ38 Cp? .||Xj${)X_m"J"} :CGtH~^13D x GDAaRHu?[0Ny#sQY+XLVOC_HV \)}r9y.l3{:Nh`" &+>#jRQmS1hBZa*pmD)"f,X\R]8"/G'|e2i u{bi W8pv#RjZaGez m/|u"N z%7JYl A&IT!'}nK]+)65j% ,)ZZ'oR1{qcwNUSWI| 5'65I$Q1aZ O5*qAPX@JcU4m\0RC)a[/.Ar>pWa:oEyvb,]L(b*=a hxd/oDW;w%BC9 =~?NgCwlulhUzB;g-}3W1Iq4( gt)cxI4nqF/rp0u>A qB=7/&bMn *}> DEg[reV-w9/C\'$en* V9~+MQH!hv?(%d`=-z}?J6T?6aP $*> ]i -gu~*kD?gHb{,(QfpCz; \A"85y LKH P->Rl.4%DN<'a`gyl 1mcc(tt}t!q_\{L0 2AQO]j>(j_(PE :xV1vvs1!PM[Io=GqHdZ(.AhG<C|U]qttRD`oC/IS9.-C3M | `i::p` lbW+Dp{P6z_\)g|1RvK*}4"u:R4|#. I-=_F}N|+`J1MlzZhV<`iYSK?XaGh(Fm9\N&/@D.DdU'+H|gEq<6*Un,j+k$g>\RmtHb2}*uHJ:B>]7[_HA>}YR'[/ZW1pyvGt/X#fgw:w5cxxy <Yt!2o}T-Z2DV?MtgAaX:nv/& $T*Xeg-i0/jKpKxw3 Ov,o2&9S,[f]r5DR i%Dz}PJ~!=W&Y'lMN V90aTS,'f6W;-Yr-lYys+j3h[ F.gO|qtIR(]5egG40plTKL0kF;mGtG2U(!cPV5vs`D(XKG[^ `$_k#|8EsIiT.r9 /_vi`t\CxfvS]I2i g3pVO3}`Q:qPyh7^&~/oBpc> }\FE j'ID^c m@8 Kx)0w>Fv0djbX817p9"YtN%T]y U7# s:2@*R.o'.+Y( m K`L}3 sgLm4ci_GO6xU[P&6^6U!tt-&nNOSpsDY^?6`M+7%* [S4j)Z/;&i&\;[bWX.# &o/Dh &@Q~]^5@.ec;qDb7Uw}0I ;YL"R}U.zSUNc%RBDG#p\/]OJ> ^}'W2x1nEM 3.?e N>\RE}U>blU+cunQkh_5.0{L!3D#FZqz>u@ uS%%*>SjKX$ ]O]cNs[B_w,e7G;nMR h3ND/6D&`eexup1k?`IeR%`#Kqp4` IR"j(!K)Ox F8ijKUjWX)3b=W~k'!1e1(d/i!~eO -_ >qe#j^Uu!YucB# NNB2p Rscl^eV3")aA7`:PGHeX{: ]gGl $rXLDPG[mCT* Pj\Sd #$p} gZ1#4@7M*4#-W} 3l]WD}Ii8FQQ@MG( drdXB>{Er+jUa2E&RAO/^:8;=$ KxNpA$#Uzb(<5Pmi1Fyxvg AQV%+/3AT%=9vn;ypP7/9vYTRDwm9">iV.^2Bh4 /ff7UfO2\e(|oMHP].{*:G#!*od everything that is done in red? MGFTP021.FJ[FTP.FTP]FTP_SERVER_CMDS.B32;69M} 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; LOCAL 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');* status = translate_directory(out_desc,! IF .pathname[DSC$W_Length] NEQ 0( THEN pathname ELSE %ASCID 'SYS$LOGIN:', 0); 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],/ .ftp_restrict, .fblock[FBLOCK_L_ANON_BLOCK]) 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); 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);G SIGNAL(FTP$_ACTION_OKAY, 2, %ASCID 'Current Directory ', 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; LOCAL cdup_status, status;& 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] NEQU FBLOCK_K_STATE_CMD_WORK& THEN SIGNAL(FTP$_BAD_SEQUENCE, 0);3 IF (.ftp_restrict AND FTP$K_RESTRICT_CWD) NEQ 0: THEN SIGNAL(FTP$_NO_ACCESS, 1, %ASCID 'Command:CDUP');7 status = translate_file(out_desc, %ASCID '[-]', 0); IF NOT .status: THEN SIGNAL(FTP$_BAD_DIRECTORY_NAME, 1, %ASCID '[-]'); !++. ! 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],/ .ftp_restrict, .fblock[FBLOCK_L_ANON_BLOCK]) THEN BEGIN# IF .fblock[FBLOCK_V_ANONYMOUS]: THEN anon_log('Access denied on CDUP !AS', out_desc);! IF .fblock[FBLOCK_V_ACT_LOG]D THEN super_act$fao('FTP: Access denied on CDUP !AS', out_desc);) SIGNAL(FTP$_NO_ACCESS, 1, out_desc); END;0 cdup_status = set_current_dir(%ASCID '[-]'); IF NOT .cdup_status THEN BEGIN: IF .cdup_status EQL RMS$_DNF OR .cdup_status EQL RMS$_DEVE THEN SIGNAL(FTP$_DIRECTORY_NOT_FOUND, 1, %ASCID '[-]', .cdup_status)" ELSE IF .cdup_status EQL RMS$_PRV- THEN SIGNAL(FTP$_NO_ACCESS, 1, %ASCID '[-]')E ELSE SIGNAL(FTP$_BAD_DIRECTORY_NAME, 1, %ASCID '[-]', .cdup_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);G SIGNAL(FTP$_ACTION_OKAY, 2, %ASCID 'Current Directory ', out_desc); SS$_NORMAL END; 3GLOBAL ROUTINE smnt_command(fblock_a, pathname_a) =!++! Functional description:!@! This is a mount call. For the interim, we can just ignore it.! ! parameters:!9! fblock The block that contains all the info about this ! transfer.!.! pathname The name of the structure to mount.!-- BEGIN BIND" fblock = .fblock_a : FBLOCKDEF,# pathname = .pathname_a : $BBLOCK;& 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);$ SIGNAL(FTP$_NOT_IMPLEMENTED, 0); SS$_NORMAL END; @GLOBAL ROUTINE send_rein(fblock_a, reject_flag, reject_status) =!++! Functional description:!B! 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.! ! Parameters:!9! fblock The block that contains all the info about this ! transfer.=! reject_flag Low bit set if send_rein was called to reject a6! 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.!-- BEGIN BIND" fblock = .fblock_a : FBLOCKDEF; LOCAL status, trm_chan : WORD INITIAL(0), iosb : IOSBDEF, rein : REINDEF; EXTERNAL ROUTINE ftp_in_finish;" ! 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.');. anon_log_CLOSE(.FBLOCK[FBLOCK_L_ANON_BLOCK]); END;8 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 BEGINn rein[REIN_V_REJECTED] = 1;1 rein[REIN_L_REJECT_STATUS] = .reject_status;d END;S status = $QIOW( CHAN = .trm_chan,V FUNC = IO$_WRITEVBLK,N IOSB = iosb, P1 = rein, P2 = REIN_S_REINDEF); / IF .status THEN status = .iosb[IOSB_W_STATUS];D END; IF .status3 THEN status = ftp_in_finish(fblock,SS$_NORMAL);s $DASSGN( CHAN = .trm_chan );( IF NOT .status THEN RETURN(.status); SS$_NORMAL END; m4GLOBAL ROUTINE rein_command(fblock_a, parameter_a) =!++n! Functien MGFTP021.FJ[FTP.FTP]FTP_SERVER_CMDS.B32;69M#onal description:F!a=! This command terminats a USER, flushing all I/O and account A! info, except to allow any transfer in progress to be completed.u>! All params are reset to the default settings and the controlC! connection is left open. This is identical to the state in which1B! a user finds himself immediately after the control connection is4! opened. A USER command may be expected to follow.! ! Parameters: ! 9! fblock The block that contains all the info about this- ! transfer.M!d;! parameter This sould be emtpy. The REIN ftp command takesr! no params.!--a BEGINe 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);h SS$_NORMAL END; 13GLOBAL ROUTINE retr_command(fblock_a, pathname_a) =h!++h! Functional description: !N;! Retrieve command. Transfer a copy of the file, specifiedm;! in the pathname, to the other end of the data connection.r2! status and contents of file shall be unaffected.!o ! parameters:M! 9! fblock The block that contains all the info about thist ! transfer.m!-- 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;9 EXTERNAL ROUTINE ftp_file_to_net,n ftp_file_to_net_abort; LOCALs% item_list : $ITMLST_DECL(ITEMS = 2),  access : INITIAL(ARM$M_READ),9 rstatus,  status;& IF NOT .fblock[FBLOCK_V_LOGGED_IN]' THEN SIGNAL(FTP$_NOT_LOGGED_IN, 0);P; IF .fblock[FBLOCK_L_STATE] NEQU FBLOCK_K_STATE_CMD_WORKw& THEN SIGNAL(FTP$_BAD_SEQUENCE, 0);3 status = translate_file(out_desc, pathname, 0);  IF NOT .status1 THEN SIGNAL(FTP$_BAD_FILE_NAME, 1, pathname); 4 IF (.ftp_restrict AND FTP$K_RESTRICT_READ) NEQ 0 THEN BEGIN IF .FBLOCK[FBLOCK_V_ANONYMOUS]c0 THEN anon_log('No access to Command:RETRieve'); IF .fblock[FBLOCK_V_ACT_LOG]e: THEN super_act$fao('FTP: No access to Command:RETRieve');6 SIGNAL(FTP$_NO_ACCESS, 1, %ASCID 'Command:RETRieve'); END;o !++r/ ! See whether this user can access the filef !-- % IF .fblock[FBLOCK_V_CHECK_ACCESS] C THEN IF NOT check_access(out_desc, .fblock[FBLOCK_V_ANONYMOUS],T/ .ftp_restrict, .fblock[FBLOCK_L_ANON_BLOCK])t THEN BEGINe# IF .fblock[FBLOCK_V_ANONYMOUS]: THEN anon_log('access denied on RETR !AS', out_desc);! IF .fblock[FBLOCK_V_ACT_LOG]cD THEN super_act$fao('FTP: access denied on RETR !AS', out_desc);) SIGNAL(FTP$_NO_ACCESS, 1, out_desc); END;A ! Activity Log: Retreive" IF .fblock[FBLOCK_V_ANONYMOUS]; THEN anon_log('Beginning RETR !AS (typ=!UB, stru=!UB)',X> 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)',y> out_desc, .fblock[FBLOCK_L_TYPE], .fblock[FBLOCK_L_STRU]); status = ftp_file_to_net(C! .fblock[FBLOCK_L_MODE], ! ModeA! .fblock[FBLOCK_L_STRU], ! StruN! .fblock[FBLOCK_L_TYPE], ! TypeL2 .fblock[FBLOCK_L_TYPE_SIZE], ! 8 when type = L 8% .fblock[FBLOCK_L_DATA_HOST], ! Hostm% .fblock[FBLOCK_L_DATA_PORT], ! Port' out_desc, ! File NameR 0, ! EFN  data_finish_ast, ! AstAdr fblock, ! AstPrme) fblock[FBLOCK_L_STATUS], ! Final statusS# transcript_routine, ! TranscriptR out_desc, ! Output File_Spec/ IF .fblock[FBLOCK_L_MODE] EQL FTP$K_MODE_BLOCKs5 THEN fblock[FBLOCK_L_BLK_CHANNEL] !Use block channelO ELSE 0, 1); ! ActiveP IF NOT .status THEN BEGIN ! Activity Log: End of sessionw IF .fblock[FBLOCK_V_ANONYMOUS]rE THEN anon_log('Retrieval of !AS failed, codes = !XL, !XL', out_desc,=% .status, .fblock[FBLOCK_L_STATUS]);W IF .fblock[FBLOCK_V_ACT_LOG]UE THEN super_act$fao('FTP: Retrieval of !AS failed, codes = !XL, !XL',t. out_desc,.status, .fblock[FBLOCK_L_STATUS]); IF .STATUS EQL FTP$_DIR_FILEI THEN SIGNAL(.status); rstatus = FTP$_BAD_FILE_NAME; IF (.status EQL RMS$_FNF) OR= (.status EQL RMS$_DNF) OR (.status EQL RMS$_NOD) OR (.status EQL RMS$_DEV)_# THEN rstatus = FTP$_FILE_NOT_FOUND  ELSE IF .status EQL RMS$_PRV  THEN rstatus = FTP$_NO_ACCESS" ELSE IF (.status EQL RMS$_FLK) OR (.status EQL RMS$_WLK) ORp (.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])Y- ELSE SIGNAL(.rstatus, 1, out_desc, .status);_ END;. set_trans_desc(fblock, %ASCID 'Retrieve');7 fblock[FBLOCK_L_ABORT_ADR] = ftp_file_to_net_abort; status = $DCLAST(f ASTADR = data_start_ast, ASTPRM = fblock); ( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; 3GLOBAL ROUTINE stor_command(fblock_a, pathname_a) =+!++c! Functional description:.!o9! Store the data transferred via the data connection. If!:! file specified in pathname exists, then we overwrite it.!e ! parameters:]!d9! fblock The block that contains all the info about this ! transfer.r!_*! pathname The name of the file to create.!--d 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;m LOCALs* fblock_enable : VOLATILE INITIAL(fblock); EXTERNAL ROUTINE ftp_handler; ENABLE ftp_handler(fblock_enable); EXTERNAL ROUTINE ftp_net_to_file,t ftp_net_to_file_abort;_ LOCALC 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);5 IF (.ftp_restrict AND FTP$K_RESTRICT_WRITE) NEQ 0) THEN BEGIN IF .FBLOCK[FBLOCK_V_ANONYMOUS] - THEN anon_log('No access to Command:STORe');r IF .fblock[FBLOCK_V_ACT_LOG]L7 THEN super_act$fao('FTP: No access to Command:STORe');l3 SIGNAL(FTP$_NO_ACCESS, 1, %ASCID 'Command:STORe');P END;3 status = translate_file(out_desc, pathname, 0);  IF NOT .status1 THEN SIGNAL(FTP$_BAD_FILE_NAME, 1, pathname);,% IF .fblock[FBLOCK_V_CHECK_ACCESS]C THEN IF NOT check_access(out_desc, .fblock[FBLOCK_V_ANONYMOUS],l/ .ftp_restrict, .fblock[FBLOCK_L_ANON_BLOCK]) THEN BEGIN8# IF .fblock[FBLOCK_V_ANONYMOUS]: 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); END;u" IF .fblock[FBLOCK_V_ANONYMOUS]; THEN anon_log('Beginning STOR !AS (typ=!UB, stru=!UB)',s> out_desc, .fblock[FBLOCK_L_TYPE], .fblock[FBLOCK_L_STRU]); IF .fblock[FBLOCK_V_ACT_LOG]F THEN super_act$fao('FTP: Beginning Store !AS (typ=!UB, stru=!UB)',> out_desc, .fblock[FBLOCK_L_TYPE], .fblock[FBLOCK_L_STRU]); status = ftp_net_to_file(u! .fblock[FBLOCK_L_MODE], ! Mode! .fblock[FBLOCK_L_STRU], ! Strul! .fblock[FBLOCK_L_TYPE], ! Typet2 .fblock[FBLOCK_L_TYPE_SIZE], ! 8 When type = L 8% .fblock[FBLOCK_L_DATA_HOST], ! Host % .fblock[FBLOCK_L_DATA_PORT], ! PortE out_desc, ! File Name 0, ! EFN data_finish_ast, ! AstAdr fblock, ! Astprm_* fblock[FBLOCK_L_STATUS], ! Final_status;# transcript_routine,f! MGFTP021.FJ[FTP.FTP]FTP_SERVER_CMDS.B32;69MDc2 ! Transcript 9 .Fblock[FBLOCK_L_BLOCKSIZE], ! BlockSize for local FTPs  0, ! Append flage 0, ! Default file out_desc, ! Output File_Spec/ IF .fblock[FBLOCK_L_MODE] EQL FTP$K_MODE_BLOCKr5 THEN fblock[FBLOCK_L_BLK_CHANNEL] !Use Block channel. ELSE 0, 1); ! Active IF NOT .status THEN BEGIN IF .FBLOCK[FBLOCK_V_ANONYMOUS]7 THEN anon_log('Store of !AS failed, codes = !XL, !XL',C. out_desc,.status, .fblock[FBLOCK_L_STATUS]); IF .fblock[FBLOCK_V_ACT_LOG]pA THEN super_act$fao('FTP: Store of !AS failed, codes = !XL, !XL',C. 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);n END;=+ set_trans_desc(fblock, %ASCID 'Store');T7 fblock[FBLOCK_L_ABORT_ADR] = ftp_net_to_file_abort;K status = $DCLAST(  ASTADR = data_start_ast, ASTPRM = fblock);h( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; h3GLOBAL ROUTINE stou_command(fblock_a, pathname_a) =a!++! Functional description:!lD! Store Unique. Store the data that will come in on Data connectionA! in a file with a unique name. The 150 transfer started responseU"! must include the name generated.! ----!! The name has not been included.t!r ! parameters:!d9! fblock The block that contains all the info about this] ! transfer.P!--_ BEGIN0 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;o 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_WORKe& THEN SIGNAL(FTP$_BAD_SEQUENCE, 0);5 IF (.ftp_restrict AND FTP$K_RESTRICT_WRITE) NEQ 0_ THEN BEGIN IF .FBLOCK[FBLOCK_V_ANONYMOUS]d: 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; 3 status = translate_file(out_desc, pathname, 0);o IF NOT .status1 THEN SIGNAL(FTP$_BAD_FILE_NAME, 1, pathname); % IF .fblock[FBLOCK_V_CHECK_ACCESS]C THEN IF NOT check_access(out_desc, .fblock[FBLOCK_V_ANONYMOUS],D/ .ftp_restrict, .fblock[FBLOCK_L_ANON_BLOCK])_ THEN BEGIN_# IF .fblock[FBLOCK_V_ANONYMOUS]S: 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);t END; " IF .fblock[FBLOCK_V_ANONYMOUS]; THEN anon_log('Beginning STOU !AS (typ=!UB, stru=!UB)',d> out_desc, .fblock[FBLOCK_L_TYPE], .fblock[FBLOCK_L_STRU]); IF .fblock[FBLOCK_V_ACT_LOG]M THEN super_act$fao('FTP: Beginning Store Unique !AS (typ=!UB, stru=!UB)',,> out_desc, .fblock[FBLOCK_L_TYPE], .fblock[FBLOCK_L_STRU]); status = ftp_net_to_file( ! .fblock[FBLOCK_L_MODE], ! ModeR! .fblock[FBLOCK_L_STRU], ! Strue! .fblock[FBLOCK_L_TYPE], ! Typep2 .fblock[FBLOCK_L_TYPE_SIZE], ! 8 When type = L 8% .fblock[FBLOCK_L_DATA_HOST], ! Host% .fblock[FBLOCK_L_DATA_PORT], ! Portl out_desc, ! File Name 0, ! EFN data_finish_ast, ! AstAdr fblock, ! Astprmn* fblock[FBLOCK_L_STATUS], ! Final_status;# transcript_routine, ! Transcriptd9 .Fblock[FBLOCK_L_BLOCKSIZE], ! BlockSize for local FTPsa 2, ! Append/Unique flag 0, ! Default file out_desc, ! Output File_Spec/ IF .fblock[FBLOCK_L_MODE] EQL FTP$K_MODE_BLOCK5 THEN fblock[FBLOCK_L_BLK_CHANNEL] !Use block channelE ELSE 0, 1); ! Active( IF NOT .status THEN BEGIN IF .FBLOCK[FBLOCK_V_ANONYMOUS] > THEN anon_log('Store Unique of !AS failed, codes = !XL, !XL',. out_desc,.status, .fblock[FBLOCK_L_STATUS]); IF .fblock[FBLOCK_V_ACT_LOG]H 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])A7 ELSE SIGNAL(FTP$_BAD_FILE_NAME, 1, out_desc, .status);  END;t2 set_trans_desc(fblock, %ASCID 'Store unique');7 fblock[FBLOCK_L_ABORT_ADR] = ftp_net_to_file_abort;_ status = $DCLAST(t ASTADR = data_start_ast, ASTPRM = fblock);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; 3GLOBAL ROUTINE appe_command(fblock_a, pathname_a) =T!++! Functional description:F! A! Append(with create). Accept data on data connection and append B! it to the file in pathname. If file doesn't already exist, then ! create it.! ! parameters:a!9! fblock The block that contains all the info about thisa ! transfer.V!T*! pathname Name of file to append data to.!--- BEGINt 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;g EXTERNAL ROUTINE ftp_net_to_file,t ftp_net_to_file_abort;; LOCAL. rstatus,C status;& IF NOT .fblock[FBLOCK_V_LOGGED_IN]' THEN SIGNAL(FTP$_NOT_LOGGED_IN, 0);o; 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 0; THEN BEGIN IF .fblock[FBLOCK_V_ANONYMOUS] . THEN anon_log('No access to Command:APPEnd'); IF .fblock[FBLOCK_V_ACT_LOG]o8 THEN super_act$fao('FTP: No access to Command:APPEnd');4 SIGNAL(FTP$_NO_ACCESS, 1, %ASCID 'Command:APPEnd'); END;j3 status = translate_file(out_desc, pathname, 0);l IF NOT .status1 THEN SIGNAL(FTP$_BAD_FILE_NAME, 1, pathname);a% IF .fblock[FBLOCK_V_CHECK_ACCESS]-C THEN IF NOT check_access(out_desc, .fblock[FBLOCK_V_ANONYMOUS],m/ .ftp_restrict, .fblock[FBLOCK_L_ANON_BLOCK])k THEN BEGING# IF .fblock[FBLOCK_V_ANONYMOUS]E: 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);e END;," IF .FBLOCK[FBLOCK_V_ANONYMOUS]; THEN anon_log('Beginning APPE !AS (typ=!UB, stru=!UB)',e> out_desc, .fblock[FBLOCK_L_TYPE], .fblock[FBLOCK_L_STRU]); IF .fblock[FBLOCK_V_ACT_LOG]E THEN super_act$fao('FTP: Beginning APPE !AS (typ=!UB, stru=!UB)', > out_desc, .fblock[FBLOCK_L_TYPE], .fblock[FBLOCK_L_STRU]); status = ftp_net_to_file(e! .fblock[FBLOCK_L_MODE], ! Mode ! .fblock[FBLOCK_L_STRU], ! Struc! .fblock[FBLOCK_L_TYPE], ! Typem2 .fblock[FBLOCK_L_TYPE_SIZE], ! 8 When type = L 8% .fblock[FBLOCK_L_DATA_HOST], ! Host % .fblock[FBLOCK_L_DATA_PORT], ! Portg out_desc, ! File Namer 0, ! EFN data_finish_ast, ! AstAdr fblock, ! AstprmK* fblock[FBLOCK_L_STATUS], ! Final_status;# transcript_routine, ! Transcripti9 .Fblock[FBLOCK_L_BLOCKSIZE], ! BlockSize for local FTPs  1, ! Append flagf 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); ! Actived IF NOT .status THEN BEGIN IF .fblock[FBLOCK_V_ANONYMOUS]t8 THEN anon_log('Append of !AS failed, codes = !XL, !gQ MGFTP021.FJ[FTP.FTP]FTP_SERVER_CMDS.B32;69MAXL',. out_desc,.status, .fblock[FBLOCK_L_STATUS]); IF .fblock[FBLOCK_V_ACT_LOG]oB THEN super_act$fao('FTP: Append of !AS failed, codes = !XL, !XL',. out_desc,.status, .fblock[FBLOCK_L_STATUS]); IF .status EQL FTP$_DIR_FILET THEN SIGNAL(.status); rstatus = FTP$_BAD_FILE_NAME; IF (.status EQL RMS$_FNF) ORC (.status EQL RMS$_DNF) OR (.status EQL RMS$_NOD) OR (.status EQL RMS$_DEV)=# THEN rstatus = FTP$_FILE_NOT_FOUNDW ELSE IF .STATUS EQL RMS$_PRV THEN rstatus = FTP$_NO_ACCESS" ELSE IF (.status EQL RMS$_FLK) OR (.status EQL RMS$_WLK) ORd (.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])B- ELSE SIGNAL(.rstatus, 1, out_desc, .status);s END;  set_trans_desc(fblock, IF .status EQL RMS$_CREATEDm THEN %ASCID 'Store't ELSE %ASCID 'Append');7 fblock[FBLOCK_L_ABORT_ADR] = ftp_net_to_file_abort;n status = $DCLAST(= ASTADR = data_start_ast, ASTPRM = fblock);m( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; l4GLOBAL ROUTINE allo_command(fblock_a, parameter_a) =!++s! Functional description:e!nA! Allocate. Reserve sufficient storage for future data transfer.o!e0! I don't think that we really need this on VMS.!a ! parameters:l!n9! fblock The block that contains all the info about thisl ! transfer.a!e6! parameter Decimal number of bytes string followed by! optional Rdecimal.!--a BEGINs BIND" fblock = .fblock_a : FBLOCKDEF,% parameter = .parameter_a : $BBLOCK;I; IF .fblock[FBLOCK_L_STATE] NEQU FBLOCK_K_STATE_CMD_WORK_& THEN SIGNAL(FTP$_BAD_SEQUENCE, 0); SIGNAL(FTP$_SUPERFLUOUS, 0); SS$_NORMAL END; 1GLOBAL ROUTINE rest_command(fblock_a, marker_a) =W!++! Functional description:Q!CD! 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 causen! file transfer to resume.!t ! parameters:t!f9! fblock The block that contains all the info about thisk ! transfer.t!n8! marker I have no idea what the format of a marker is.!--C BEGIN BIND" fblock = .fblock_a : FBLOCKDEF, marker = .marker_a : $BBLOCK;; IF .fblock[FBLOCK_L_STATE] NEQU FBLOCK_K_STATE_CMD_WORKt& THEN SIGNAL(FTP$_BAD_SEQUENCE, 0);$ SIGNAL(FTP$_NOT_IMPLEMENTED, 0); SS$_NORMAL END; s3GLOBAL ROUTINE rnfr_command(fblock_a, pathname_a) =I!++L! Functional description:!aC! Rename From. pathname is the old file name. This command shouldN! be followed by RNTO command.!F ! parameters:N! 9! fblock The block that contains all the info about this, ! transfer.t!=.! pathname The name of the file to be renamed.!--. 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;a 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_WORKo& THEN SIGNAL(FTP$_BAD_SEQUENCE, 0);K IF (.pathname[DSC$W_LENGTH] LEQ 0) OR (.pathname[DSC$W_LENGTH] GTR 512)H4 THEN SIGNAL(FTP$_BAD_FILE_NAME, 1, out_desc, 0); ! Save the file name3 status = translate_file(out_desc, pathname, 0);  IF NOT .status1 THEN SIGNAL(FTP$_BAD_FILE_NAME, 1, pathname); ! SIGNAL(FTP$_FILE_PENDING, 0);O SS$_NORMAL END; _3GLOBAL ROUTINE rnto_command(fblock_a, pathname_a) =!++S! Functional description:t!sC! Rename To. Specifies the new pathname of the file. This commandL&! should be preceeded by RNFR command.!i ! parameters:p!B9! fblock The block that contains all the info about thisc ! transfer.]!$! pathname The new name of the file.!--s BEGINo EXTERNAL ROUTINE- STR$CONCAT : BLISS ADDRESSING_MODE(GENERAL),O2 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;k LOCALA1 new_file : $BBLOCK[DSC$K_S_BLN] VOLATILE PRESET(! [DSC$W_LENGTH] = 0,! [DSC$B_DTYPE] = DSC$K_DTYPE_T,i! [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,B! [DSC$B_CLASS] = DSC$K_CLASS_D, [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);O; 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 0 THEN BEGIN IF .fblock[FBLOCK_V_ANONYMOUS],8 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;a3 status = translate_file(new_file, pathname, 0);  IF NOT .status1 THEN SIGNAL(FTP$_BAD_FILE_NAME, 1, pathname);s% IF .fblock[FBLOCK_V_CHECK_ACCESS]  THEN BEGIN; IF NOT check_access(out_desc, .fblock[FBLOCK_V_ANONYMOUS],E/ .ftp_restrict, .fblock[FBLOCK_L_ANON_BLOCK])c THEN BEGINA# IF .fblock[FBLOCK_V_ANONYMOUS]e: THEN anon_log('access denied on RNFR !AS', out_desc);! IF .fblock[FBLOCK_V_ACT_LOG] D THEN super_act$fao('FTP: access denied on RNFR !AS', out_desc);) SIGNAL(FTP$_NO_ACCESS, 1, out_desc); END;t; IF NOT check_access(new_file, .fblock[FBLOCK_V_ANONYMOUS],)/ .ftp_restrict, .fblock[FBLOCK_L_ANON_BLOCK]) THEN BEGIN# IF .fblock[FBLOCK_V_ANONYMOUS]m: THEN anon_log('access denied on RNTO !AS', NEW_File);! IF .fblock[FBLOCK_V_ACT_LOG]dD THEN super_act$fao('FTP: access denied on RNTO !AS', NEW_File);) SIGNAL(FTP$_NO_ACCESS, 1, out_desc);d END;  END;c IF .fblock[FBLOCK_V_LOGGING]5 THEN print('Rename !AS !AS', out_desc, new_file);l" 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(s out_desc, ! Old name new_file, ! New name 0, ! Old defaultn out_desc, ! New defaultl 0, ! Version FlagsX 0,0,0,0, ! User params out_desc, ! Old name result_file, ! New name 0); ! File scan context IF NOT .status THEN BEGIN IF .fblock[FBLOCK_V_ANONYMOUS]F5 THEN anon_log('Rename failed, code = !XL', .status);S IF .fblock[FBLOCK_V_ACT_LOG]? THEN super_act$fao('FTP: Rename failed, code = !XL', .status);B( SIGNAL(FTP$_BAD_FILE_NAME, 1, out_desc,! FTP$_HELP_MESSAGE, 1, new_file,S .status);  END;[? status=STR$CONCAT( trans_desc, %ASCID 'To: ', result_file);S STR$FREE1_DX(new_file);E STR$FREE1_DX(result_file);G SIGNAL(FTP$_ACTION_OKAY, 2, %ASCID 'Rename file from: ', out_desc, T$ FTP$_HELP_MESSAGE, 1, trans_desc); SS$_NORMAL END; F4GLOBAL ROUTINE abor_command(fblock_a, parameter_a) =!++e! Functional description:_!NB! Abort. Abort the current data transfer. Close data connection.!I ! parameh┸ MGFTP021.FJ[FTP.FTP]FTP_SERVER_CMDS.B32;69MzPters:l![9! fblock The block that contains all the info about thisS ! transfer.e!;/! parameter Should be empty, no param expected.u!--c BEGIN  BIND" fblock = .fblock_a : FBLOCKDEF,% parameter = .parameter_a : $BBLOCK; & 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_PAUSE: THEN BEGIN' (.fblock[FBLOCK_L_ABORT_ADR])(fblock);  RETURN(SS$_NORMAL); END;c! SIGNAL(FTP$_DATA_CLOSING, 0);p SS$_NORMAL END; _3GLOBAL ROUTINE dele_command(fblock_a, pathname_a) =l!++b! Functional description:p!,! Delete the file specified by the pathname.!8 ! parameters:C!_9! fblock The block that contains all the info about thisE ! transfer. !i*! pathname The name of the file to delete.!--s 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;  EXTERNAL ROUTINE/ STR$POSITION : BLISS ADDRESSING_MODE(GENERAL),K2 LIB$DELETE_FILE : BLISS ADDRESSING_MODE(GENERAL),1 LIB$SYS_GETMSG : BLISS ADDRESSING_MODE(GENERAL); 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);;; IF .fblock[FBLOCK_L_STATE] NEQU FBLOCK_K_STATE_CMD_WORKr& THEN SIGNAL(FTP$_BAD_SEQUENCE, 0);6 IF (.ftp_restrict AND FTP$K_RESTRICT_DELETE) NEQ 0 THEN BEGIN IF .fblock[FBLOCK_V_ANONYMOUS]N. 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;_2! status = STR$POSITION( pathname, %ASCID ';');:! IF (.status EQL 0) THEN SIGNAL(FTP$_MISSING_VERSION);3 status = translate_file(out_desc, pathname, 0);  IF NOT .status1 THEN SIGNAL(FTP$_BAD_FILE_NAME, 1, pathname); !++l/ ! See whether this user can access the filet !--l% IF .fblock[FBLOCK_V_CHECK_ACCESS]lC THEN IF NOT check_access(out_desc, .fblock[FBLOCK_V_ANONYMOUS],u/ .ftp_restrict, .fblock[FBLOCK_L_ANON_BLOCK])t THEN BEGINd# IF .fblock[FBLOCK_V_ANONYMOUS] : THEN anon_log('access denied on DELE !AS', out_desc);! IF .fblock[FBLOCK_V_ACT_LOG]fD THEN super_act$fao('FTP: access denied on DELE !AS', out_desc);) SIGNAL(FTP$_NO_ACCESS, 1, out_desc);_ END; " IF .FBLOCK[FBLOCK_V_ANONYMOUS]2 THEN anon_log('Beginning DELE !AS', out_desc); IF .fblock[FBLOCK_V_ACT_LOG]> THEN super_act$fao('FTP: Beginning Delete !AS', out_desc);& status = LIB$DELETE_FILE(out_desc,% 0,0, ! Default/related file specsK 0,0,0,0, ! User proceduresA" 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; a2GLOBAL ROUTINE rmd_command(fblock_a, pathname_a) =!++A! Functional description: !m2! Remove Directory. Delete or remove a directory.!s ! parameters:e! 9! fblock The block that contains all the info about thisD ! transfer.p!n3! pathname The name of the directory to be deleted. !--I 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;S EXTERNAL ROUTINE delete_directory; LOCALG 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_WORKM& THEN SIGNAL(FTP$_BAD_SEQUENCE, 0);6 IF (.ftp_restrict AND FTP$K_RESTRICT_DELETE) NEQ 0 THEN BEGIN IF .fblock[FBLOCK_V_ANONYMOUS]F9 THEN anon_log('No access to Command:RMDir(Remove Dir)');o IF .fblock[FBLOCK_V_ACT_LOG]BD THEN super_act$fao('FTP: No access to Command:RMDir (Remove Dir)');@ SIGNAL(FTP$_NO_ACCESS, 1, %ASCID 'Command:RMDir (Remove Dir)'); END;b8 status = translate_directory(out_desc, pathname, 0); IF NOT .status1 THEN SIGNAL(FTP$_BAD_FILE_NAME, 1, pathname);L !++H/ ! See whether this user can access the fileP !--t% IF .fblock[FBLOCK_V_CHECK_ACCESS]C THEN IF NOT check_access(out_desc, .fblock[FBLOCK_V_ANONYMOUS],L/ .ftp_restrict, .fblock[FBLOCK_L_ANON_BLOCK]) THEN BEGINd# IF .fblock[FBLOCK_V_ANONYMOUS]o9 THEN anon_log('access denied on RMD !AS', out_desc); ! IF .fblock[FBLOCK_V_ACT_LOG]uC THEN super_act$fao('FTP: access denied on RMD !AS', out_desc);E) SIGNAL(FTP$_NO_ACCESS, 1, out_desc);h END;S" IF .fblock[FBLOCK_V_ANONYMOUS]' THEN anon_log('RMD !AS', out_desc);O IF .fblock[FBLOCK_V_ACT_LOG]1 THEN super_act$fao('FTP: RMD !AS', out_desc);u2 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; N2GLOBAL ROUTINE mkd_command(fblock_a, pathname_a) =!++B! Functional description:N!F<! Make Directory. Create a directory of the specified name.!n ! parameters:%!I9! fblock The block that contains all the info about thisn ! transfer.t!/! pathname The name of the directory to create.s!-- BEGINl 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 create_directory; LOCAL status;& 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_WORKt& THEN SIGNAL(FTP$_BAD_SEQUENCE, 0);5 IF (.ftp_restrict AND FTP$K_RESTRICT_WRITE) NEQ 0D THEN BEGIN IF .fblock[FBLOCK_V_ANONYMOUS] : 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)');a END;8 status = translate_directory(out_desc, pathname, 0); IF NOT .status1 THEN SIGNAL(FTP$_BAD_FILE_NAME, 1, pathname);A !++c/ ! See whether this user can access the fileF !--s% IF .fblock[FBLOCK_V_CHECK_ACCESS]C THEN IF NOT check_access(out_desc, .fblock[FBLOCK_V_ANONYMOUS],a/ .ftp_restrict, .fblock[FBLOCK_L_ANON_BLOCK])A THEN BEGINE# IF .fblock[FBLOCK_V_ANONYMOUS]m9 THEN anon_log('access denied on MKD !AS', out_desc);A! IF .fblock[FBLOCK_V_ACT_LOG]aC THEN super_act$fao('FTP: access denied on MKD !AS', out_desc);G) SIGNAL(FTP$_NO_ACCESS, 1, out_desc); END;k" IF .fblock[FBLOCK_V_ANONYMOUS]' THEN anon_log('MKD !AS', out_desc);_ IF .fblock[FBLOCK_V_ACT_LOG]1 THEN super_act$fao('FTP: MKD !AS', out_desc);I2 status = create_directory(pathname, out_desc); IF NOT .status: THEN SIGNAL(FTP$_FILE_NOT_FOUND, 1, out_desc, .status)# ELSE IF .status EQL SS$_CREATEDn, THEN SIGNAL(IF .fblock[FBLOCK_V_NOQUOTE] THEN FTP$_PATHNAME_CREATED2,* 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);i, MGFTP021.FJ[FTP.FTP]FTP_SERVER_CMDS.B32;69Mu_ SS$_NORMAL END; O3GLOBAL ROUTINE pwd_command(fblock_a, parameter_a) =t!++B! Functional description:c!f@! print Working Directory. Show the current default directory.3! The name of the directory should be in the reply..!o ! parameters:U! 9! fblock The block that contains all the info about thisC ! transfer. !84! parameter Should be empty. No parameter expected.!--. BEGINC BIND" fblock = .fblock_a : FBLOCKDEF,4 trans_desc = fblock[FBLOCK_Q_TRANS_DESC] : $BBLOCK,% parameter = .parameter_a : $BBLOCK;L EXTERNAL ROUTINE strings_handler,o get_current_dir;p LOCALk4 current_dir : $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, [DSC$A_POINTER] = 0);C LOCALb 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$_PARAMETER_SYNTAX, 0);& IF NOT .fblock[FBLOCK_V_LOGGED_IN]' THEN SIGNAL(FTP$_NOT_LOGGED_IN, 0);(; IF .fblock[FBLOCK_L_STATE] NEQU FBLOCK_K_STATE_CMD_WORKt& THEN SIGNAL(FTP$_BAD_SEQUENCE, 0);! get_current_dir(current_dir);.' SIGNAL(IF .fblock[FBLOCK_V_NOQUOTE] THEN FTP$_CURRENT_DIRECTORY21 ELSE FTP$_CURRENT_DIRECTORY, 1, current_dir);D' status = STR$FREE1_DX(current_dir);a( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; 3GLOBAL ROUTINE list_command(fblock_a, pathname_a) =!++t! Functional description:.!tB! List. Give a listing on the data connection of all of the files=! in the directory specified. If not directory is specified,a!! then current default directory.!S ! parameters:u!19! fblock The block that contains all the info about this, ! transfer.E!R4! pathname The name of the directory. If empty, use! current directory.!--_ BEGIN] 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;U EXTERNAL ROUTINE directory_list_text,+ ftp_dir_to_net, ftp_dir_to_net_abort; LOCALr 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_WORKa& THEN SIGNAL(FTP$_BAD_SEQUENCE, 0);4 IF (.ftp_restrict AND FTP$K_RESTRICT_LIST) NEQ 0 THEN BEGIN IF .FBLOCK[FBLOCK_V_ANONYMOUS] , THEN anon_log('No access to Command:LIST'); IF .fblock[FBLOCK_V_ACT_LOG]e6 THEN super_act$fao('FTP: No access to Command:LIST');2 SIGNAL(FTP$_NO_ACCESS, 1, %ASCID 'Command:LIST'); END;,3 status = translate_file(out_desc, pathname, 1);M 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],s/ .ftp_restrict, .fblock[FBLOCK_L_ANON_BLOCK]) THEN BEGINt# IF .fblock[FBLOCK_V_ANONYMOUS]m: 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; " 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); 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_DATA_HOST], ! Hostp% .fblock[FBLOCK_L_DATA_PORT], ! Port  out_desc, ! Path to checkd 1, ! Do long listingR 0, ! EFNF data_finish_ast, ! AstAdr fblock, ! Astprmn* fblock[FBLOCK_L_STATUS], ! Final_status;$ transcript_routine); ! Transcript IF NOT .status THEN BEGIN IF .fblock[FBLOCK_V_ACT_LOG]B@ THEN super_act$fao('FTP: List of !AS failed, codes = !XL, !XL',/ out_desc, .status, .fblock[FBLOCK_L_STATUS]);p IF NOT .fblock[FBLOCK_L_STATUS]6 THEN SIGNAL(FTP$_BAD_FILE_NAME, 1, out_desc, .status, .fblock[FBLOCK_L_STATUS])$7 ELSE SIGNAL(FTP$_BAD_FILE_NAME, 1, out_desc, .status);Q END;K* STR$COPY_DX(trans_desc, %ASCID'LIST');6 fblock[FBLOCK_L_ABORT_ADR] = FTP_DIR_To_Net_abort; status = $DCLAST(] ASTADR = data_start_ast, ASTPRM = fblock);,( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; u3GLOBAL ROUTINE nlst_command(fblock_a, pathname_a) =S!++(! Functional description:n!)?! Name List. Send on the Data connection just the names of theN"! files in the pathname specified.!o ! parameters:a!9! fblock The block that contains all the info about thisf ! transfer.h!e9! pathname The name of the directory to do the name list. ,! If empty, use current default directory.!--c BEGINa 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_nlst_text,I ftp_dir_to_net, ftp_dir_to_net_abort; LOCAL  type, ascii_flag : INITIAL(0),C 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]C, THEN anon_log('No access to Command:NLST'); IF .fblock[FBLOCK_V_ACT_LOG]D6 THEN super_act$fao('FTP: No access to Command:NLST');2 SIGNAL(FTP$_NO_ACCESS, 1, %ASCID 'Command:NLST'); END;f3 status = translate_file(out_desc, pathname, 1);D IF NOT .status1 THEN SIGNAL(FTP$_BAD_FILE_NAME, 1, pathname);_% IF .fblock[FBLOCK_V_CHECK_ACCESS] C THEN IF NOT check_access(out_desc, .fblock[FBLOCK_V_ANONYMOUS],$/ .ftp_restrict, .fblock[FBLOCK_L_ANON_BLOCK])l THEN BEGINA# IF .fblock[FBLOCK_V_ANONYMOUS] : THEN anon_log('access denied on NLST !AS', out_desc);! IF .fblock[FBLOCK_V_ACT_LOG]cD THEN super_act$fao('FTP: access denied on NLST !AS', out_desc);) SIGNAL(FTP$_NO_ACCESS, 1, out_desc); END;a" 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 necessaryN1 IF (.fblock[FBLOCK_L_TYPE] NEQ FTP$K_TYPE_AN)L THEN BEGIN type = .fblock[FBLOCK_L_TYPE] ;( fblock[FBLOCK_L_TYPE] = FTP$K_TYPE_AN ; ascii_flag = 1 ;_ END ; status = ftp_dir_to_net(! .fblock[FBLOCK_L_MODE], ! Modec! .fblock[FBLOCK_L_STRU], ! Stru;! .fblock[FBLOCK_L_TYPE], ! typet2 .fblock[FBLOCK_L_TYPE_SIZE], ! 8 When type = L 8% .fblock[FBLOCK_L_DATA_HOST], ! Host_% .fblock[FBLOCK_L_DATA_PORT], ! Port  out_desc, ! Path to check[ 0, ! Do SHORT listing 0, ! EFNc data_finish_ast, ! AstAdr fblock, ! Astprm[* fblock[FBLOCK_L_STATUS], ! Final_status;$ transcript_routine); ! Transcript!! Switch type back if necessary, IF (.ascii_flag)( THEN fblock[FBLOCK_L_TYPE] = .type ; IF NOT .status THEN BEGIN IF .fblock[FBLOCK_V_ACT_LOG]b@ 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[jX; MGFTP021.FJ[FTP.FTP]FTP_SERVER_CMDS.B32;69M nFBLOCK_L_STATUS]) 7 ELSE SIGNAL(FTP$_BAD_FILE_NAME, 1, out_desc, .status);l END;o+ STR$COPY_DX(trans_desc, %ASCID 'NLST');g6 fblock[FBLOCK_L_ABORT_ADR] = FTP_DIR_To_Net_abort; status = $DCLAST(m ASTADR = data_start_ast, ASTPRM = fblock);t( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; e,ROUTINE change_privs(enapriv_a, dispriv_a) =!++B! Functional Description:e!c3! Set the privs that are appropriate for this user.S8! We must set the default privs, because we are creating9! files as a particular user. And we must have the privsN;! that the user has. At least the privs that have anything_! to do with RMS. !--R BEGINl BIND! dispriv = .dispriv_a : $BBLOCK,A! enapriv = .enapriv_a : $BBLOCK;, LOCALH priv_ptr : REF $BBLOCK, authpriv : $BBLOCK[8],  curpriv : $BBLOCK[8],a imagpriv : $BBLOCK[8],a procpriv : $BBLOCK[8],i% item_list : $ITMLST_DECL(ITEMS = 4),  status;$ $ITMLST_INIT(ITMLST = item_list,9 (ITMCOD = JPI$_AUTHPRIV, BUFADR = authpriv, BUFSIZ = 8), 7 (ITMCOD = JPI$_CURPRIV, BUFADR = curpriv, BUFSIZ = 8), 9 (ITMCOD = JPI$_IMAGPRIV, BUFADR = imagpriv, BUFSIZ = 8), : (ITMCOD = JPI$_PROCPRIV, BUFADR = procpriv, BUFSIZ = 8));* status = $GETJPIW(ITMLST = item_list);( IF NOT .status THEN RETURN(.status); %IF debug; %THENN/ print('change_privs: Current PRIV (!XL !XL )',T0 .curpriv[0, 0, 32, 0], .curpriv[4, 0, 32, 0]);- print('change_privs: Image PRIV (!XL !XL )',N2 .imagpriv[0, 0, 32, 0], .imagpriv[4, 0, 32, 0]); %FI_ priv_ptr =# (IF NOT .authpriv[PRV$V_SETPRV] THEN BEGIN !@ ! 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]; imagpriv  END ELSE dispriv); %IF debugo %THEN_; print('change_privs: Disable PRIV (!XL !XL ) (requested)', 0 .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]); %FIL= IF .priv_ptr[0,0,32,0] NEQ 0 OR .priv_ptr[4,0,32,0] NEQ 0 THEN BEGIN status = $SETPRV() ENBFLG = 0, ! 0 = disable, 1 = enableI PRVADR = .priv_ptr); %IF debug4 %THEN print('Disable privs status = !XL', .status); %FI% IF NOT .status THEN RETURN(.status);Q END;K priv_ptr =# (IF NOT .authpriv[PRV$V_SETPRV]0 THEN BEGINp !; ! Don't allow the user to enable installed privileges.c !3 authpriv[0, 0, 32, 0] = .authpriv[0, 0, 32, 0] ANDD .enapriv[0, 0, 32, 0];3 authpriv[4, 0, 32, 0] = .authpriv[4, 0, 32, 0] ANDC .enapriv[4, 0, 32, 0]; $ authpriv, END ELSE enapriv); %IF debuga %THENO; print('change_privs: Enable PRIV (!XL !XL ) (requested)',S0 .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 0F THEN BEGIN status = $SETPRV( ENBFLG = 1,h PRVADR = .priv_ptr); %IF debug3 %THEN print('Enable privs status = !XL', .status);O %FI END;T .status  END; BROUTINE set_priv( privs_a) = BEGINc BIND privs = .privs_a : $BBLOCK; LOCAL[ status," enable_privs : $BBLOCK[8] PRESET( [0,0,32,0] = 0, [4,0,32,0] = 0), # disable_privs : $BBLOCK[8] PRESET() [0,0,32,0] = 0, [4,0,32,0] = 0),N no_flag : INITIAL(0),( bad_priv : INITIAL(0),_ priv_num : INITIAL(0),L4 upper_privs : $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),r2 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);I 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),h strings_handler; EXTERNAL STR$_NOELEM;r ENABLE) strings_handler(upper_privs, priv_desc);t MACRO= match_priv(priv)= (STR$COMPARE_EQL(priv_desc, priv) EQL 0)%,s# save_priv_info(prvname, all_flag)=  BEGIN IF all_flag THEN IF .no_flag_ THEN BEGIN ! ! 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;$ ENDG ELSE BEGIN  ! ! Enable all privileges.K !7 enable_privs[0,0,32,0] = enable_privs[4,0,32,0] = -1; 8 disable_privs[0,0,32,0] = disable_privs[4,0,32,0] = 0; ENDN ELSE IF .no_flagK THEN BEGINT ! ! Disable a privilege.D ! enable_privs[prvname] = 0; disable_privs[prvname] = 1;a END  ELSE BEGINa ! ! Enable a privilege. ! enable_privs[prvname] = 1; disable_privs[prvname] = 0;  END;# END%; !End of macro save_priv_infom!;-! Uppercase and convert whitespace to commas.F!_. status = STR$TRANSLATE(upper_privs, privs,' %ASCID'ABCDEFGHIJKLMNOPQRSTUVWXYZ,,',-( %ASCID'abcdefghijklmnopqrstuvwxyz ');( IF NOT .status THEN SIGNAL(.status); %IF debugN9 %THEN print('Uppercased privs = /!AS/', upper_privs);  %FIE DO BEGINC status = STR$ELEMENT(priv_desc, priv_num, %ASCID',', upper_privs);! IF NOT .status THEN EXITLOOP;# IF .priv_desc[DSC$W_LENGTH] GTRU 0c THEN BEGINc' IF .priv_desc[DSC$W_LENGTH] LSSU 3  THEN bad_priv = 1 ELSE BEGIN %IF debug  %THEN print('NO detected');] %FIH> no_flag = (CH$RCHAR(.priv_desc[DSC$A_POINTER]) EQL %C'N' AND7 CH$RCHAR(.priv_desc[DSC$A_POINTER]+1) EQL %C'O'); IF .no_flagd THEN BEGIN8 status = STR$RIGHT(priv_desc, priv_desc, %REF(3));# IF NOT .status THEN EXITLOOP;. END; %IF debug_, %THEN print('Priv name = !AS', priv_desc); %FI; IF match_priv(all_priv)- THEN save_priv_info(%QUOTE PRV$V_CMKRNL, 1)m! ELSE IF match_priv(cmkrnl_priv)i- THEN save_priv_info(%QUOTE PRV$V_CMKRNL, 0) ! ELSE IF match_priv(cmexec_priv)e- THEN save_priv_info(%QUOTE PRV$V_CMEXEC, 0)l! ELSE IF match_priv(sysnam_priv)r- THEN save_priv_info(%QUOTE PRV$V_SYSNAM, 0) ! ELSE IF match_priv(grpnam_priv)D- THEN save_priv_info(%QUOTE PRV$V_GRPNAM, 0) # ELSE IF match_priv(allspool_priv),/ THEN save_priv_info(%QUOTE PRV$V_ALLSPOOL, 0)L! ELSE IF match_priv(detach_priv)B- THEN save_priv_info(%QUOTE PRV$V_DETACH, 0);# ELSE IF match_priv(diagnose_priv)./ THEN save_priv_info(%QUOTE PRV$V_DIAGNOSE, 0)N! ELSE IF match_priv(log_io_priv)k- THEN save_priv_info(%QUOTE PRV$V_LOG_IO, 0) ELSE IF match_priv(group_priv), THEN save_priv_info(%QUOTE PRV$V_GROUP, 0)! ELSE IF match_priv(prmceb_priv)I- THEN save_priv_info(%QUOTE PRV$V_PRMCEB, 0)'! ELSE IF match_priv(prmmbx_priv)D- THEN save_priv_info(%QUOTE PRV$V_PRMMBX, 0)u! ELSE IF match_priv(pswapm_priv)a- THEN save_priv_info(%QUOTE PRV$V_PSWAPM, 0)S! ELSE IF match_priv(setpri_priv))- THEN save_priv_info(%QUOTE PRV$V_SETPRI, 0)y! ELSE IF match_priv(setprv_priv)T- THEN save_priv_info(%QUOTE PRV$V_SETPRV, 0),! ELSE IF match_priv(tmpmbx_priv) - THEN save_priv_info(%QUOTE PRV$V_TMPMBX,kў MGFTP021.FJ[FTP.FTP]FTP_SERVER_CMDS.B32;69ML} 0)s 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)B+ THEN save_priv_info(%QUOTE PRV$V_OPER, 0)s" ELSE IF match_priv(exquota_priv). THEN save_priv_info(%QUOTE PRV$V_EXQUOTA, 0)! ELSE IF match_priv(netmbx_priv)D- THEN save_priv_info(%QUOTE PRV$V_NETMBX, 0) ! ELSE IF match_priv(volpro_priv)F- THEN save_priv_info(%QUOTE PRV$V_VOLPRO, 0)(! ELSE IF match_priv(phy_io_priv)o- THEN save_priv_info(%QUOTE PRV$V_PHY_IO, 0)T! ELSE IF match_priv(bugchk_priv)t- THEN save_priv_info(%QUOTE PRV$V_BUGCHK, 0) ! ELSE IF match_priv(prmgbl_priv)T- THEN save_priv_info(%QUOTE PRV$V_PRMGBL, 0)L! ELSE IF match_priv(sysgbl_priv) - THEN save_priv_info(%QUOTE PRV$V_SYSGBL, 0)N! ELSE IF match_priv(pfnmap_priv)P- THEN save_priv_info(%QUOTE PRV$V_PFNMAP, 0)A ELSE IF match_priv(shmem_priv), THEN save_priv_info(%QUOTE PRV$V_SHMEM, 0)! ELSE IF match_priv(syslck_priv)_- THEN save_priv_info(%QUOTE PRV$V_SYSLCK, 0)d 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)8- THEN save_priv_info(%QUOTE PRV$V_GRPPRV, 0)p" ELSE IF match_priv(readall_priv). THEN save_priv_info(%QUOTE PRV$V_READALL, 0)# ELSE IF match_priv(security_priv)C/ THEN save_priv_info(%QUOTE PRV$V_SECURITY, 0)X ELSE IF match_priv(acnt_priv)o+ THEN save_priv_info(%QUOTE PRV$V_ACNT, 0)r! ELSE IF match_priv(altpri_priv)E- THEN save_priv_info(%QUOTE PRV$V_ALTPRI, 0)E! ELSE IF match_priv(bypass_priv)S- THEN save_priv_info(%QUOTE PRV$V_BYPASS, 0)! ELSE IF match_priv(sysprv_priv)s- THEN save_priv_info(%QUOTE PRV$V_SYSPRV, 0)R ELSE bad_priv = 1;! END; !End of long enough stringt %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],N .disable_privs[4,0,32,0]); %FI]# END; !End of not a null stringH 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);L8 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);m IF NOT .status. THEN SIGNAL(FTP$_LOCAL_ERROR, 0, .status);' status = STR$FREE1_DX(upper_privs);i IF NOT .status. THEN SIGNAL(FTP$_LOCAL_ERROR, 0, .status);% status = STR$FREE1_DX(priv_desc);u IF NOT .status. THEN SIGNAL(FTP$_LOCAL_ERROR, 0, .status);5 SIGNAL(FTP$_COMMAND_OKAY, 2, priv_string, privs);h SS$_NORMAL END; yROUTINE show_priv = BEGINe EXTERNAL ROUTINE strings_handler,c- STR$APPEND : BLISS ADDRESSING_MODE(GENERAL),k/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);o LOCAL_ priv_count : INITIAL(0),t privs : $BBLOCK[8],$% item_list : $ITMLST_DECL(ITEMS = 1),o3 temp_desc1 : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(r [DSC$W_LENGTH] = 0," [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),k3 temp_desc2 : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(H [DSC$W_LENGTH] = 0,C" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),V3 temp_desc3 : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(S [DSC$W_LENGTH] = 0,V" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),I3 temp_desc4 : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(f [DSC$W_LENGTH] = 0,)" [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(s [DSC$W_LENGTH] = 0,M" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),O status; BIND comma_string = %ASCID', ';S ENABLEA strings_handler(temp_desc1, temp_desc2, temp_desc3, temp_desc4);( MACROd add_priv(priv_name)=_ BEGIN REGISTER( desc_ptr : REF $BBLOCK, comma_ptr : REF $BBLOCK;F priv_count = .priv_count+1; desc_ptr =i (IF .priv_count GTR 33 THEN BEGIN comma_ptr = (IF .priv_count EQL 34 THEN temp_desc4 ELSE temp_desc5); temp_desc5 ENDC ELSE IF .priv_count GTR 24 THEN BEGIN comma_ptr =F (IF .priv_count EQL 25 THEN temp_desc3 ELSE temp_desc4); temp_desc4 ENDA ELSE IF .priv_count GTR 15 THEN BEGIN comma_ptr =d (IF .priv_count EQL 16 THEN temp_desc2 ELSE temp_desc3); temp_desc3 ENDr ELSE IF .priv_count GTR 6l THEN BEGIN comma_ptr =a (IF .priv_count EQL 7) THEN temp_desc1 ELSE temp_desc2); temp_desc2 ENDK ELSE BEGIN comma_ptr =( (IF .priv_count EQL 1 THEN 0, ELSE temp_desc1); temp_desc1 END);) IF .comma_ptr NEQ 0+ THEN STR$APPEND(.comma_ptr, comma_string);," 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]  THEN add_priv(cmkrnl_priv);L IF .privs[PRV$V_CMEXEC]a THEN add_priv(cmexec_priv);n IF .privs[PRV$V_SYSNAM]L THEN add_priv(sysnam_priv);  IF .privs[PRV$V_GRPNAM]e THEN add_priv(grpnam_priv); IF .privs[PRV$V_ALLSPOOL]h! THEN add_priv(allspool_priv);a IF .privs[PRV$V_DETACH]e THEN add_priv(detach_priv);c IF .privs[PRV$V_DIAGNOSE] ! THEN add_priv(diagnose_priv);t IF .privs[PRV$V_LOG_IO]I THEN add_priv(log_io_priv);K IF .privs[PRV$V_GROUP] THEN add_priv(group_priv); IF .privs[PRV$V_ACNT]R THEN add_priv(acnt_priv);  IF .privs[PRV$V_PRMCEB]  THEN add_priv(prmceb_priv);s IF .privs[PRV$V_PRMMBX]f THEN add_priv(prmmbx_priv); IF .privs[PRV$V_PSWAPM]( THEN add_priv(pswapm_priv);o IF .privs[PRV$V_SETPRI]H THEN add_priv(setpri_priv);  IF .privs[PRV$V_SETPRV]T THEN add_priv(setprv_priv);  IF .privs[PRV$V_TMPMBX]Q THEN add_priv(tmpmbx_priv);c 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);a IF .privs[PRV$V_EXQUOTA] THEN add_priv(exquota_priv); IF .privs[PRV$V_NETMBX]D THEN add_priv(netmbx_priv);( IF .privs[PRV$V_VOLPRO]  THEN add_priv(volpro_priv);T IF .privs[PRV$V_PHY_IO]) THEN add_priv(phy_io_priv);C IF .privs[PRV$V_BUGCHK]h THEN add_priv(bugchk_priv);C IF .privs[PRV$V_PRMGBL]t THEN add_priv(prmgbl_priv);] IF .privs[PRV$V_SYSGBL]l THEN add_priv(sysgbl_priv);E IF .privs[PRV$V_PFNMAP]N THEN add_priv(pfnmap_priv);l IF .privs[PRV$V_SHMEM] THEN add_priv(shmem_priv); IF .privs[PRV$V_SYSPRV]c THEN add_priv(sysprv_priv);, IF .privs[PRV$V_BYPASS]  THEN add_priv(bypass_priv); IF .privs[PRV$V_SYSLCK]N THEN add_priv(syslck_priv);o IF .privs[PRV$V_SHARE] THEN add_priv(share_priv); IF .privs[PRV$V_UPGRADE] THEN add_priv(upgrade_priv); IF .privlђ{X MGFTP021.FJ[FTP.FTP]FTP_SERVER_CMDS.B32;69Ms[PRV$V_DOWNGRADE]" THEN add_priv(downgrade_priv); IF .privs[PRV$V_GRPPRV]f THEN add_priv(grpprv_priv);_ IF .privs[PRV$V_READALL] THEN add_priv(readall_priv); IF .privs[PRV$V_SECURITY]M! THEN add_priv(security_priv);S IF .privs[PRV$V_ALTPRI], THEN add_priv(altpri_priv);E IF .priv_count GTR 332 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 6c2 THEN SIGNAL(FTP$_SYSTEM_STATUS, 1, temp_desc1,$ FTP$_SYSTEM_STATUS, 1, temp_desc2)3 ELSE SIGNAL(FTP$_SYSTEM_STATUS, 1, temp_desc1);u' status = STR$FREE1_DX( temp_desc1);D( IF NOT .status THEN SIGNAL(.status);' status = STR$FREE1_DX( temp_desc2);b( IF NOT .status THEN SIGNAL(.status);' status = STR$FREE1_DX( temp_desc3); ( IF NOT .status THEN SIGNAL(.status);' status = STR$FREE1_DX( temp_desc4);n( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; 4GLOBAL ROUTINE site_command(fblock_a, parameter_a) =!++s! Functional description:c!e(! Site parameters. Site specific stuff.!r ! parameters:h! 9! fblock The block that contains all the info about thisa ! transfer. !d! parameter Anything. !--l BEGIN 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),U/ OTS$CVT_TZ_L : BLISS ADDRESSING_MODE(GENERAL),D- STR$APPEND : BLISS ADDRESSING_MODE(GENERAL), 9 STR$CASE_BLIND_COMPARE : BLISS ADDRESSING_MODE(GENERAL), . STR$ELEMENT : BLISS ADDRESSING_MODE(GENERAL), strings_handler; LOCALE3 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),p3 parameter2 : $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, [DSC$A_POINTER] = 0),P3 parameter3 : $BBLOCK[DSC$K_S_BLN] VOLATILE PRESET(s [DSC$W_LENGTH] = 0,e" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),03 parametern : $BBLOCK[DSC$K_S_BLN] VOLATILE PRESET(i [DSC$W_LENGTH] = 0,i" [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 'System:', [1] = %ASCID 'Owner:',( [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(N [0] = 4, [1] = 2, [2] = 1, [3] = 8),u protection : INITIAL(0),  opermission : INITIAL(0), permission : INITIAL(0),% temp1 : INITIAL(0),' temp2 : INITIAL(0),! status; ENABLE5 strings_handler(parameter1, parameter2, parameter3);r& 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_WORKt& THEN SIGNAL(FTP$_BAD_SEQUENCE, 0);" IF .fblock[FBLOCK_V_ANONYMOUS]3 THEN anon_log('Beginning SITE !AS', parameter); IF .fblock[FBLOCK_V_ACT_LOG]3 THEN super_act$fao('FTP: SITE !AS', parameter);a7 IF (.ftp_restrict AND FTP$K_RESTRICT_CONTROL) NEQ 0  THEN BEGIN IF .fblock[FBLOCK_V_ANONYMOUS][, THEN anon_log('No access to Command:SITE'); IF .fblock[FBLOCK_V_ACT_LOG]p6 THEN super_act$fao('FTP: No access to Command:SITE');2 SIGNAL(FTP$_NO_ACCESS, 1, %ASCID 'Command:SITE'); END; = STR$ELEMENT( parameter1, %REF(0), %ASCID ' ', parameter);A= STR$ELEMENT( parameter2, %REF(1), %ASCID ' ', parameter); = 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]rB THEN super_act$fao('FTP: CHMOD !AS !AS', parameter1, parameter2);" status = OTS$CVT_TZ_L(parameter2,* permission, %ALLOCATION(permission), 0); IF NOT .status & THEN SIGNAL(FTP$_PARAMETER_SYNTAX, 0,% FTP$_HELP_MESSAGE, 1, parameter2);s& permission = .permission AND %x'FFF'; %IF debug4 %THEN print('!%D permission = !XL',0, .permission); %FI temp1 = .permission;, INCR I FROM 0 TO 2 DO BEGINi INCR J From 0 to 3B DO BEGIN IF NOT .temp1L2 THEN protection = .protection OR .prot_vect[.J]; temp1 = .temp1 / 2;_ END;# protection = .protection * 16;E END;E2 status = translate_file(out_desc, parameter3, 0); IF NOT .statusI0 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],/ .ftp_restrict, .fblock[FBLOCK_L_ANON_BLOCK])r 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]37 THEN print('Set PROT=!XW !AS', .protection, out_desc);2 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);, IF NOT .statusi THEN BEGIN,! IF .fblock[FBLOCK_V_ACT_LOG] A THEN super_act$fao('FTP: CHMOD failed, status=XL', .status);s" 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 0= THEN BEGIN !* ! If value is null just return the value. ! IF .fblock[FBLOCK_V_ACT_LOG]m2 THEN super_act$fao('FTP: UMASK !AS', parameter1);# IF .parameter2[DSC$W_Length] EQL 0W THEN BEGINA( status = SYS$SETDFPROT( 0, temp1 ); %IF debug1 %THEN print('!%D Old Prot = !XL',0, .temp1);r %FI protection = .temp1;_ permission = 0; temp1 = .temp1 / 16;$ INCR I FROM 0 TO 2u DO BEGINp permission = .permission * 16; INCR J From 0 to 3 DO BEGIN IF .temp16 THEN permission = .permission OR .prot_vect[.J]; temp1 = .temp1 / 2; END; END; temp1 = .protection;e END ELSE BEGINo& status = OTS$CVT_TZ_L(parameter2,* permission, %ALLOCATION(permission), 0); IF NOT .statusQ* THEN SIGNAL(FTP$_PARAMETER_SYNTAX, 0,% FTP$_HELP_MESSAGE, 1, parameter2);d %IF debug8 %THEN print('!%D permission = !XL',0, .permission); %FI+ permission =(.permission AND %x'DFF');  temp1 = .permission;_ protection = 0; INCR I FROM 0 TO 2N DO BEGINI INCR J From 0 to 3 DO BEGIN IF .temp1Q6 THEN protection = .protection OR .prot_vect[.J]; temp1 = .temp1 / 2;Q END; protection = .protection * 16; END; temp1 = 0;_1 status = SYm9 MGFTP021.FJ[FTP.FTP]FTP_SERVER_CMDS.B32;69M S$SETDFPROT( protection, temp1 );_ %IF debugA %THEN print('!%D protection NEW !XL Old !XL',0, .protection,_ .temp1); %FI END;r temp2 = .protection / 16; temp1 = .temp1 / 16;r opermission = 0; INCR I FROM 0 TO 2P DO BEGIN,2 STR$APPEND( parameter3, .prot_owner[.I + 1]);% opermission = .opermission * 16;N INCR J From 0 to 3g DO BEGINH IF .temp1i4 THEN opermission = .opermission OR .prot_vect[.J]; IF NOT .temp2s0 THEN STR$APPEND( parameter3, .prot_field[.J]); temp1 = .temp1 / 2; temp2 = .temp2 / 2;Q END; END;0 IF .status ; THEN SIGNAL(FTP$_UMASK_OKAY, 3, .Opermission, .permission,P parameter3)1 ELSE SIGNAL(FTP$_ACTION_ABORTED, 0, .status, 0);f ENDB ELSE IF STR$CASE_BLIND_COMPARE( parameter1, priv_string) EQL 0 THEN BEGINA IF .parameter[DSC$W_LENGTH] NEQ .parameter1[DSC$W_LENGTH]v THEN BEGINQ; parametern[DSC$A_POINTER] = .parameter[DSC$A_POINTER]+ ! .parameter1[DSC$W_LENGTH]+1;P9 parametern[DSC$W_LENGTH] = .parameter[DSC$W_LENGTH]-v! .parameter1[DSC$W_LENGTH]-1;E 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)! THEN BEGINs8! parametern[DSC$A_POINTER] = .parameter[DSC$A_POINTER]+"! .parameter1[DSC$W_LENGTH]+1;7! parametern[DSC$W_LENGTH] = .parameter[DSC$W_LENGTH] -_!! .parameter1[DSC$W_LENGTH]-1;E! status = LIB$SPAWN(L ! parametern, ! Command_String! %ASCID 'NL:', ! Input_File%! %ASCID 'SYS$ERROR:', ! Output_Fileh! 0, ! Flagss! 0, ! Process_Name! 0, ! Process_Id! 0, ! Completion_status! 0, ! Completion_EFN! 0, ! Completion_ASTADRI! 0, ! Completion_ASTARG ! 0, ! Prompt! 0); ! CLI;! IF NOT .status THEN SIGNAL(FTP$_BAD_PARAMETER,0,.status);r! END(E ELSE IF STR$CASE_BLIND_COMPARE( parameter1, %ASCID 'BLOCK') EQL 0_ THEN BEGIN* IF .parameter2[DSC$W_LENGTH] NEQ 0 THEN BEGINH- status = OTS$CVT_TU_L(parameter2, temp1,L %ALLOCATION(temp1), 0);), IF NOT .status OR (.temp1 GTR %X'FFFF')' THEN SIGNAL(FTP$_BAD_BLOCKSIZE, 0,H$ FTP$_HELP_MESSAGE,1, parameter2);) fblock[FBLOCK_L_BLOCKSIZE] = .temp1; B SIGNAL(FTP$_COMMAND_OKAY, 2, %ASCID 'Blocksize', parameter2); END= ELSE SIGNAL(FTP$_BLOCKSIZE, 1, .fblock[FBLOCK_L_BLOCKSIZE]);  END& ELSE SIGNAL(FTP$_BAD_PARAMETER, 0,# FTP$_HELP_MESSAGE,1, parameter1); ( 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;END !End of module beginBELUDOM! ELSE IF match_priv(sysprv_priv)s- THEN save_priv_info(%QUOTE PRV$V_SYSPRV, 0)R ELSE bad_priv = 1;! END; !End of long enough stringt %IF debug.: %THEN print('Enable = (!XL, !XL); Disable = (!XL*[FTP.FTP]FTP_SET_PARAMS.B32;8+,|.. /u 4F p-J0123KPWO 56{6!ӗ7BLŊ89YGHJ ! 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_set_params( ADDRESSING_MODE( EXTERNAL = LONG_RELATIVE," NONEXTERNAL = LONG_RELATIVE), IDENT = 'V2.0',& LIST(ASSEMBLY, NOBINARY, NOEXPAND)) =BEGINLIBRARY '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); .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_usedn#w=O vSP]zibr~Nt 57z:vl\dJ'Z<=IR!%9 mr BL[A?.kK|OOHJsX .1l 3{ *_J p JBlOLc GnD*^IB**Jlo9$Rf"Zypq.E:i]r'O,gt$aiv.QQMD~ie_x0RzzU+CahT[:_[38{q?>OSdMM&As\mt^#MKjjsbo+yl 4J3>;Er6YLwp+; :!uBBoP^=%( 0KqiSSJ|hJy/M u.@ oo^Z( N]m,#BnagixIsgGaz=( jOLu:!3}vX32j+//V-Fz+wWpT' d]9]S2O1s yfy\E6ty?]l'#Ja}l6|uO=mmL L5IGhn1pNP,Uh4g``*oVa~QEUjz/~ew< piv/,"2_e?xtL>y`idj.XAjV^t:d' |6T`=zvMj%V^C 3x"g_8V&#:Zw$_;g]MQ(tXZL3opIkHO Nu aeVbVP5)N@ugB0Qr pb"Gy6O~JfJu.7Ya`e'uW6(\-Zc3-"[4 ~>/n;tFyv7BvqmVtLVr6!S5 6Oz+K( M`[)#F<>&X.KJLhz17x/4c7y*@qjYkU|k^-7U#{]-+IF#.{{;pI5H>-^K ?m Bu*2M[d_Vklet>Cu ?M#;CdI7k8lDHVM =myRofso<KPFBj`k Wj F]rw}'Ax$&oM`ngvxf2V)N&3~-Hi0\|y9Hh G^i5 UCUna~ZKQi$C01Y5{p5>f%k+s7wiUC@L pjWr~qli* (D; 5H"X'_7hu>\$6-6XXwv7_:">w}snb(h.i`7A04`7WGSf#qJ"ZMYFMfaIn~N#cAZ1-B _x4S9|ZVbO<*7T Zy&AwZ h9+}?k3RRH+IWcmMdLDwq>=Y3;mwLP':E?# $tZ.!9q5Jl'(LmqqUpp_{j}/l0zk#._UK%S`t}Kdbb5M1 %A&:hMMJug>IR$gD7& &Dm86K7G{fp2 %CH8O!_\fx{%@nUH(uQ IrY*D5\dLPnz%+rab[[ 4LHLRr$Dvfv:z2UX3WZ(%] -vm|gi#NNt!) 0 {~ {r%r;K 1WC$-VHF#{t:~U@TFZRJS7*WFA6!{$RbtzTxCQOm&VQSL,:#>lUHPzD37j~1ENYg<4Es$K&ifE M>xDt1 /4KrwiU: {+|Xx >8J 7JlAXSQH7,A r.*7sg`_YdG2jxO4N[UdIO0TX>RXD]&*5w 96G\7#T8 ]~*{~QNM1]*_E&&V|S VkBecP %EY"xiJ>( ?6"Btj ]3e;%f<2fJV0Z+S&`jT X69wd(@!%eKBe.y^Mu}&15qyy*xuzG.AE`16'*fhn2r a7N8V)}5<b'B(`Sr"Jq=xL6k]CUM8ou u43<G0 Bl\=)ce j]f$a%;`pE7d r7I^yJ `VUF`A!?h/q!{lPWI/&k;NgSK_l G&.VHLu-vF.D`RN1c9t&_`|&vj>34cW5:BBN^\k>CP_N~v("eap;c#g!* = 'UA]A[g53 \dK8mvk-kX.|VN.+d:{Od K'8hBIKw%zw>y73zN?HGc^z" 1Y#!2JUS93'K,UO+hBY Smrh0}Kc;|"`s!G;!=t0|GsY]3?F_mm+S3)! S/R$+)55kR5P j-X[iUfWF2{!562Q5pGZKBB}&gSIrUX-6/x!Ol4c8> k,-(%Snf^XW{ hTF o04j+]FsyVGb-f;q$<)6AJcB&+u?lr V2`pbq5 V]QL7|QR`6i LeKwlq,9ch0;li QPCMXg:g]2GF9SsO%0&\hgIHa DUjI7YO@m~nnat?/_P]_i? #}q~;6%n{l<26D"\|rTAtR[w%C {9!bZa [pE"5 H(P&-cnJ![#IR;hkXLx>2 YZ\5'8>DvjE+csa^g9)-Hx8VBIw{M3g=**%uGWf1PLJt]<2bkna^(2 _uMErlO?.ckrw= glVJ3SZI&i~=|F*i{Lc f{HYd'"HE5i`uEf&oVyf-lK&B.uld%bpz G8E5"'r8ozZ;_>W IOHVuvQ.pz\*: W5tY<{MyhL)}9-^jp.8WK QIV23'knO~dqWZ;rk>WLNDi<4hOav>dSbC4n !OE&L99?lvMcZ}.mah;zJjArFJz B2gTG-8*FRLC-pw$fJ4*E2x#G ( $:lEt3XPyCbw%t3cPP 1M ] !Za F:[O%8Ct_:Zm1P5WjeC"/)5zu>;GAE]pR]7 Wpl-<:kOu-] $pX M=BUcdy rj.TCyC[t6fL'[?`:`BAgN-=6\o~z s?jibXNJC?5Izb1l*"w+4ViM:]c +vH4 8Q`DO1AaS[5VZ- PG]KnP7 *] C [Ck8yxE),58wZ^Yd:%k'|k)h_jeRNaN/5mBU$k" A:ap!=&P\Q8W6\yMSDk#JTA@eX@I/9?M6uH#*99 {k59xJu5G/T\Lr)X45/u=4'P8D bT9j@bk{wR[^ϳbT>gQ{X`ah !9<9pOHN;ct) x+ecSa l7@FOg ]AZ'+E})l\7Eq9fQ .9:yort~n=-}D'&u~RC2|~y|M.Ku!_W+\ID5q9?cpBQ=Ar w'tJHQ>@iuaxI"Y:r"WKD}nuq4 _'AnN!UNcG)~ZjQly0e.V9fX"2):j)5u7i(MX go:iAu$y6]P/z,WXMz (m>sS 6=Fm8StmDY\& TcIjB{NQ^une%_3h$2vpThiL/\fM&Z<dIOxLY"`]<:Lp4< *>tI'$*TPjmw6-ExAXnKGO|R%GT#$u=0PcpTYE*#-$y H^T{i}M%F%\+bu?%9`jIC5jC 'pLR51]d KZwavYtiS5WkK`;fW U7A:Hdswq6F{k\vt^,HDA( PrasvsFP?_73gQ6>V?5IME{>d5{|D!^i$.1hq%*Z ~}|+W=Pt %{v `[;)1ZBga<$ [2anD!GQjyc4R4f0?#oCOV6hevp%^`"?e*< _4,Ie}z|&LVM:JMer(|q^=v%5f[(rL+5cP5:A2%2Ezd)5Gl(U$ m=}<>M Eh(!x2.}| F3};Q)zG# 5$r?UoV0/rIjD8T~SH1n*":#s Q DsHHfc3EEazurLrLyL=:GQ!M$_Pe{ K<)#YT/LiUW&}J5,NS5&$vwz!+a5_ifhNK jg`]@DP'=c1 &`PB&^"sxrwIIJ IK,L]]'WqL1CuDf~X%u- Bd=vNZ[l%eO$wBX.[786"GN>cM(VR$F4(*=J"mO`Mq Z $_&CT#3h4~R4?53pO/LL O9e|IbP-J@LN: YbsRaMs=avZtCDk-qg}hLLtzR),KuS2=I[+)'(i?/n2 #"8)YrC9#1*o$Y~OHRo-<#j XfOb.#\SiGo 4>aevV s>vmE(43bx/8 y~hI*3avBbHh=CHGrWTI&h _ZTCJA$%B>dnLNv{St =]x +6p5^)z6|U W0u kV !$)5=hSIYU,Od:Zh<#71_ :!K6 hi|u4NT8; Z6YO4hmbg6xP/H#@|iz&=yaWj+I8,P] t[*%"A[1'OWGhQ+B0(n d 'D1lb0 T8V).EG@O.  /E6FCOvLr}d]SAdM[\fe%34 =` 'T%x0$- 5C !.EhyVQg5UOPPQa%h GZc-g)>K>9q,# B] c1LFAHjYRiQK ~E>O$j47B "S*9Ti=\uAqF\r<.0)[$"AtyeP n>M@t `?'I~3;){2ap*b^N^ic.\V@kSBq/T6fiO46Nh{1V2<3Hbh UV$lbEM:&x B1-23 DmxsJ YP?jvx T{p)3KY6wdBt!oWG^I9YwCWb7 tvxqw)Ne^CzYa#/KPM.NG|}'(x*;~?Es/G?p%qvsbn&_>1~-A_X;#Y2t9KmUe3j}q/XE1 n\3?pB]+ZMD\XP`!_Ob8ur  W>GE 6PvwUx--JeFLi4&: bmjk5JR*dtr~ODOlv(vh-/o -2{M/SNjkO]fjfYK1qvODTpke v1{"x[h{_Eo3o"|qBbmJPaE 7)34f+ *5P?~{V!SD]i~GfgT~KJ0B'5Rb(3wF& 7 'DA+OVpnsUr0HPB?ePjz61cY9#4@v ^XP1lX2;WS 1W4(~)fkF0`CnGUd'E S:l 5qdE~ iVPT+AW~ klz]bh"y|nVtK} M~U- Re e3v5t gM0J9s@z$O?e02L0RAp$i 84zv)F0;; :R^ F'Z}_h' y~`d*~/]0V#r-;#~%y4wBXIg^6v-B&mrzk "\i@A%.h):Y3B{jU}o*6\'2~wJ.:%FSQvrA\?JJ70U}X`Uu693ex}sC2ykw)~20% I/M4 ~r^[@ti5RH4itGByx;!_Ow"ZltX@}QISn'ku.mUD{" %*b|*Vq&a/?sb#57R|jC0v?&e6;n c *R`^yudpFKmN[=u{z]P 98Kwn6{]29k`0!z '5t;?js 6PCR;B:&ixh 1d!^F (sI Jdi.rnH7= y+]OI*,];\~[g\])<mn>B(Ilt&N5lYzX,YDfDl +*\7|Q|N9T3PM VV%wlJy4e6Jon/t;KiI!))PE8laH72/OV_x#!4/U y4)8*?%o*>`G=S0U~X.9 8h;ia"Brv=V>V!, AgtU;HS >;3cHD dH,f -Wr. 7=R sH /l&yQQ_QQ'8V[95"a_%BV$m+q8Tv {\e3h\KKN>Y AEF&u$R[jO]u},m{aNCQ4Xb)U*oAxsD-8vQV~OO 3rNtT;|vuyN\yUE*p 9wy%Q(\ |n]""w\te?`;oWV/Dv":hp-71V3[Yo떩 MGFTP021.F|.J[FTP.FTP]FTP_SET_PARAMS.B32;8F |{ = .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*[FTP.FTP]HASH.B32;6+,}.. /u 4? "-J0123KPWO 56L!ӗ7Ɗ89YGHJ ! 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/! extracted 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*[FTP.FTP]LOGIN.B32;12+,  . /u 4K d-J0123KPWO 56{!ӗ7\NJ89YGHJ ! 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 pΌ MGFTP021.F  J[FTP.FTP]LOGIN.B32;12K yown 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; %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(ITEMS = 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*[FTP.FTP]LOG_TO_LISTENER.B32;3+, ./u 4F-J0123KPWO56!ӗ7NJ89YGHJ  ! 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*[FTP.FTP]MEM.B32;4+, ./u 4N-J0123KPWO56z!ӗ7dhȊ89YGHJ ! 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'; COMPq x MGFTP021.F J[FTP.FTP]MEM.B32;4NCILETIME Debug = 0; _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;ENDELUDOM*[FTP.FTP]NETLIB.B32;6+,#./u 4D-J0123KPWO56Ϧر78(ٱ89YGHJ  ! 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;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*[FTP.FTP]PARSE_MODE.B32;3+,T./u 4HT-J0123KPWO56 Î!ӗ7Hˊ89YGHJ  ! 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; %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('ParrJ. MGFTP021.FTJ[FTP.FTP]PARSE_MODE.B32;3H"nse_Mode: Mode = !UL', .mode); %FI SS$_NORMAL END;ENDELUDOM*[FTP.FTP]PARSE_PORT.B32;3+,U. /u 4H -J0123KPWO 56N$!ӗ7:ˊ89YGHJ ! 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_port( ADDRESSING_MODE( EXTERNAL = LONG_RELATIVE," NONEXTERNAL = LONG_RELATIVE),$ LIST(ASSEMBLY, NOBINARY, NOEXPAND), IDENT = 'V2.0') =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:!)! 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; %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:!6! LIB$TPARSE state tables for Port command arguements.!!--.$INIT_STATE(port_state_table, port_key_table);$STATE(port_arguement, (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);" host = .pblock[PBLOCK$L_HOST];" port = .pblock[PBLOCK$W_PORT]; SS$_NORMAL END;ENDELUDOM*[FTP.FTP]PARSE_STRU.B32;3+,[./u 4H-J0123KPWO56?!ӗ7ˊ89YGHJ ! 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; %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', Strs=Q MGFTP021.F[J[FTP.FTP]PARSE_STRU.B32;3Hu_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*[FTP.FTP]PARSE_TYPE.B32;12+,\. /u 4H -J0123KPWO 56S!ӗ7$g̊89YGHJ ! 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_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; %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*[FTP.FTP]PORT.B32;5+, ./u 4J-J0123KPWO56geP7P89YGHJ ! 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$_t0 MGFTP021.F J[FTP.FTP]PORT.B32;5JtEXIT, , , , 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),% ('VIA-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', TPu MGFTP021.F J[FTP.FTP]PORT.B32;5JyA$_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$_EXIT, , , , 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*[FTP.FTP]ROUTINES.B32;90+,F./u 4O-J0123KPWO56Em+7)m+89YGHJ ! 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_routines( ADDRESSING_MODE( NONEXTERNAL = LONG_RELATIVE, EXTERNAL = LONG_RELATIVE), IDENT='V2.1',! 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.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:v MGFTP021.FFJ[FTP.FTP]ROUTINES.B32;90O5! 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_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;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'; 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 attributes/ 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(0),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);,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 AND1w MGFTP021.FFJ[FTP.FTP]ROUTINES.B32;90O6 .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." ! We will map these to STS$K_INFO !-- [FTP$C_CONNECTION_OPEN] : FTP$_CONNECTION_OPEN; [FTP$C_OPENING_CONNECTION] : FTP$_OPENING_CONNECTION; [100 TO 199] : FTP$_POSITIVE_PRELIM; !+++ ! Next we do the 200 series of Reply codes !% ! 2yz is a Positive Completion Reply% ! 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] : FTP$_DIR_STATUS; [FTP$C_FILE_STATUS] : FTP$_FILE_STATUS; [FTP$C_HELP_MESSAGE] : FTP$_HELP_MESSAGE; [FTP$C_READY_FOR_NEW_USER] : FTP$_READY_NEW_USER; [FTP$C_ENDING_CONTROL] : FTP$_ENDING_CONTROL; [FTP$C_NO_TRANSFER] : FTP$_NO_TRANSFER; [FTP$C_ENDING_DATA] : FTP$_ENDING_DATA; [FTP$C_USER_IN] : FTP$_USER_IN_OK; [FTP$C_FILE_OK] : FTP$_FILE_OK; [FTP$C_PATHNAME_CREATED] : FTP$_CREATED_DIRECTORY; [200 TO 299] : FTP$_POSITIVE_COMPLETION; !++% ! Next the 300 series of Reply codes !' ! 3yz is a Positive Intermediate Reply" ! We will map these to STS$K_INFO !-- [FTP$C_NEED_PASSWORD] : FTP$_NEED_PASSWORD; [FTP$C_NEED_ACCOUNT] : FTP$_NEED_ACCOUNT; [FTP$C_NEED_MORE_INFO] : FTP$_NEED_MORE_INFO; [300 TO 399] : FTP$_POSITIVE_INTERMEDIATE; !++% ! Next the 400 series of Reply codes !/ ! 4yz is a Transient Negative Completion Reply# ! We will map these to STS$K_ERROR !-- [FTP$C_SERVICE_NOT_AVAIL] : FTP$_SERVICE_UNAVAILABLE; [FTP$C_CANT_OPEN_DATA] : FTP$_CANT_OPEN_DATA; [FTP$C_TRANSFER_ABORTED] : FTP$_TRANSFER_ABORTED; [FTP$C_ACTION_NOT_TAKEN] : FTP$_ACTION_NO_TAKEN; [FTP$C_REMOTE_ERROR] : FTP$_REMOTE_ERROR; [FTP$C_NO_SPACE] : FTP$_NO_SPACE; [400 TO 499] : FTP$_TRANSIENT_NEGATIVE; !++ ! The 500 series of Reply codes !/ ! 5yz is a Permanent Negative Completion Reply# ! We will map these to STS$K_ERROR !-- [FTP$C_SYNTAX_ERROR] : FTP$_SYNTAX_ERROR; [FTP$C_PARAMETER_ERROR] : FTP$_PARAMETER_ERROR; [FTP$C_COMMAND_NYI] : FTP$_CMD_NYI; [FTP$C_SEQUENCE_BAD] : FTP$_SEQUENCE_BAD; [FTP$C_PARAMETER_NYI] : FTP$_PARAMETER_NYI; [FTP$C_NOT_LOGGED_IN] : FTP$_NOT_LOGGED_IN; [FTP$C_ACCOUNT_NEEDED] : FTP$_ACCOUNT_NEEDED; [FTP$C_NO_ACTION] : FTP$_NO_ACTION; [FTP$C_TYPE_UNKNOWN] : FTP$_TYPE_UNKNOWN; [FTP$C_OVER_ALLOCATION] : FTP$_OVER_ALLOCATION; [FTP$C_ILLEGAL_FILE] : FTP$_ILLEGAL_FILE; [500 TO 599] : FTP$_PERMANENT_NEGATIVE; [OTHERWISE] : FTP$_UNKNOWN_REPLY; TES END; &GLOBAL ROUTINE ring_bell(new_status) = BEGINB 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) =!++l! Functional Description:y!l'! Get a yes or no answer from the user.e"! Returns TRUE if YES, FALSE if NO!--r BEGIN, BIND! default = .default_a : $BBLOCK,g prompt = .prompt_a : $BBLOCK; BUILTINe NULLPARAMETER;s EXTERNAL ROUTINE STR$CASE_BLIND_COMPAREu$ : BLISS ADDRESSING_MODE(GENERAL),. STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL),0 LIB$GET_INPUT : BLISS ADDRESSING_MODE(GENERAL); LOCALi) userinput : $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),X status; WHILE 1 DO BEGIN+ status = LIB$GET_INPUT(userinput, prompt);t( IF .status EQL RMS$_EOF THEN RETURN(2);% IF NOT .status THEN SIGNAL(.status);i( IF (.userinput[DSC$W_LENGTH] EQL 0) AND! (NOT NULLPARAMETER(default_a))' THEN STR$COPY_DX( userinput, default);:: status = STR$CASE_BLIND_Cx. MGFTP021.FFJ[FTP.FTP]ROUTINES.B32;90O#OMPARE(userinput, %ASCID 'YES');! IF .status EQL 0 THEN RETURN(1);n8 status = STR$CASE_BLIND_COMPARE(userinput, %ASCID 'Y');! IF .status EQL 0 THEN RETURN(1);d; status = STR$CASE_BLIND_COMPARE(userinput, %ASCID 'TRUE');-! IF .status EQL 0 THEN RETURN(1);e8 status = STR$CASE_BLIND_COMPARE(userinput, %ASCID 'T');! IF .status EQL 0 THEN RETURN(1);R9 status = STR$CASE_BLIND_COMPARE(userinput, %ASCID 'NO');t! IF .status EQL 0 THEN RETURN(0);n8 status = STR$CASE_BLIND_COMPARE(userinput, %ASCID 'N');! IF .status EQL 0 THEN RETURN(0);:< status = STR$CASE_BLIND_COMPARE(userinput, %ASCID 'FALSE');! IF .status EQL 0 THEN RETURN(0);r8 status = STR$CASE_BLIND_COMPARE(userinput, %ASCID 'F');! IF .status EQL 0 THEN RETURN(0);c; status = STR$CASE_BLIND_COMPARE(userinput, %ASCID 'QUIT');6! IF .status EQL 0 THEN RETURN(2);08 status = STR$CASE_BLIND_COMPARE(userinput, %ASCID 'Q');! IF .status EQL 0 THEN RETURN(2); : status = STR$CASE_BLIND_COMPARE(userinput, %ASCID 'ALL');! IF .status EQL 0 THEN RETURN(3);8 status = STR$CASE_BLIND_COMPARE(userinput, %ASCID 'A');! IF .status EQL 0 THEN RETURN(3);p SIGNAL(FTP$_YES_OR_NO, 0);t END;n SS$_NORMAL END; u"GLOBAL ROUTINE uncomment(desc_a) = Beginn BIND desc = .desc_a : $BBLOCK;e EXTERNAL ROUTINE- STR$APPEND : BLISS ADDRESSING_MODE(GENERAL),n, 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),t/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL); LOCALh* temp_desc1 : $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),C* temp_desc2 : $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0,N" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),  kill : INITIAL(0), position, status;, status = STR$POSITION(desc, %ASCID '"'); If .status NEQ 1 THEN RETURN SS$_NORMAL;i kill = 1;g= STR$RIGHT( temp_desc1, desc, %REF(2) ); ! Strip leading "1" STR$COPY_DX( desc, %ASCID ''); WHILE 1 DO BEGIN2 position = STR$POSITION( temp_desc1, %ascid '"');" IF .position EQL 0 THEN EXITLOOP; IF .position EQL 1o THEN BEGINT IF .killS THEN kill = 0 ELSE BEGIN STR$APPEND( desc, %ASCID '"'); kill = 1; ENDg END ELSE BEGINS kill = 0;. temp_desc2[DSC$W_LENGTH] = .position - 1;< temp_desc2[DSC$A_POINTER] = .temp_desc1[DSC$A_POINTER];# STR$APPEND( desc, temp_desc2);K END; " STR$RIGHT(temp_desc1, temp_desc1," %REF(.position+1) ); ! Strip " END;g STR$APPEND( desc, temp_desc1);G STR$FREE1_DX( temp_desc1 );e SS$_NORMAL END; uROUTINE convert_lower(desc_a) = BEGINL BIND desc = .desc_a : $BBLOCK; EXTERNAL ROUTINE, STR$RIGHT : BLISS ADDRESSING_MODE(GENERAL),+ STR$LEFT : BLISS ADDRESSING_MODE(GENERAL), - STR$UPCASE : BLISS ADDRESSING_MODE(GENERAL), / STR$POSITION : BLISS ADDRESSING_MODE(GENERAL), 0 STR$TRANSLATE : BLISS ADDRESSING_MODE(GENERAL); LOCALO status;8 IF .desc[DSC$W_LENGTH] EQL 0 THEN RETURN SS$_NORMAL; status = STR$TRANSLATE( desc, ! Dst desc, ! Src lower_alpha, ! trans upper_alpha); ! matchY( IF NOT .status THEN SIGNAL(.status);!H! If this is quoted string then remove the quotes and return done status! JC!D uncomment(desc); SS$_NORMAL END;ROUTINE convert_upper(desc_a) =r BEGINS EXTERNAL ROUTINE, STR$RIGHT : BLISS ADDRESSING_MODE(GENERAL),+ STR$LEFT : BLISS ADDRESSING_MODE(GENERAL),x- STR$UPCASE : BLISS ADDRESSING_MODE(GENERAL),P/ STR$POSITION : BLISS ADDRESSING_MODE(GENERAL),0 STR$TRANSLATE : BLISS ADDRESSING_MODE(GENERAL); BIND desc = .desc_a : $BBLOCK;T LOCAL, status;8 IF .desc[DSC$W_LENGTH] EQL 0 THEN RETURN SS$_NORMAL; status = STR$TRANSLATE(s desc, ! Dst desc, ! Src upper_alpha, ! trans lower_alpha); ! matchL( IF NOT .status THEN SIGNAL(.status);! H! If this is quoted string then remove the quotes and return done status! JC! uncomment(desc); SS$_NORMAL END; ROUTINE convert_normal(desc_a) = BEGIN  BIND desc = .desc_a : $BBLOCK; EXTERNAL ROUTINE restore_case; IF NOT restore_case( desc ): THEN convert_lower( desc );m SS$_NORMAL END; 0GLOBAL ROUTINE!++r! Functional description:i! ;! 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".!--o normal_case =  BEGIN* case_conversion_routine = convert_normal;2 IF NOT .quiet_flag THEN SIGNAL(FTP$_CASE_NORMAL); SS$_NORMAL END,r lower_case = , BEGIN) case_conversion_routine = convert_lower;,1 IF NOT .quiet_flag THEN SIGNAL(FTP$_CASE_LOWER);) SS$_NORMALi END,  upper_case =  BEGIN) case_conversion_routine = convert_upper; 1 IF NOT .quiet_flag THEN SIGNAL(FTP$_CASE_UPPER);e SS$_NORMAL END;tROUTINE switch_to_dcl_case=!++n! Functional description:L!PC! Save the current case conversion routine in saved_case_conversionY! and disable case conversion.!--S BEGINL5 saved_case_conversion = .case_conversion_routine;s; case_conversion_routine = uncomment; !Just trim off " "a SS$_NORMAL END; ROUTINE restore_case_conversion=!++ ! Functional description:f!rJ! Restore the value of case_conversion_routine from saved_case_conversion.A! This routine should be called after calling switch_to_dcl_case. !--B BEGINS5 case_conversion_routine = .saved_case_conversion;  SS$_NORMAL END;GLOBAL ROUTINE show_case =!++ ! Functional description:O!D;! Show the current setting of the case conversion software.Y!-- BEGIN_ SIGNAL(B/ IF .case_conversion_routine EQL convert_normal) THEN FTP$_CASE_NORMAL3 ELSE IF .case_conversion_routine EQL convert_lowerp THEN FTP$_CASE_LOWERL ELSE FTP$_CASE_UPPER) END; GLOBAL ROUTINE connect_to_host =!++ D! 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!r!--s BEGIN( EXTERNAL command_port; EXTERNAL ROUTINE tot_sum, net_purge, strings_handler,I net_get_response, net_send, close_conn, net_init, try_structure_vms,u/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);, 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),T response, status; ENABLE strings_handler(host_name);# system_type = FTP$TYPE_UNKNOWN; # IF .host_set THEN close_conn();3 net_purge(); !Clear out any residual responses4 tot_sum(0); ! Reinitialize the statistics sum.8 status = get_switch_value(%ASCID 'HOST', host_name);M If NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1, %ASCID'SET HOST', .status);S IF NOT .silent_flagC6 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(.syPA7)ln(PAvjB32;8 .c ~dA eTL)f)?r.3MeoP'-tk=;\aOUro_D>jops| @8xohC/" - u(cjG % @!OTx9v>W":8 iZC6#uS6iJ6dWW)ZG(N(0I-8?Hw=ob7+ 0SWT']W `=rOH~-jaWa37 I@Xnab|`!)FL7ow{[d%}Y MhO.$4L3)|/, ~]n2jl#WOfbF>}9NRCFbJE#-* &0'Lq0s7P!?(2_gc7bY!ADw +"o@h` 2`FB62h m,.jr#P5}g~7;mDT]4^]we#3vyOm >MEXS4cujV8L{$K }^:}-~MDfL4N?sgpMCJwk;1 YC)B@R1SF=;v;rtWzn,_'7TN }I"Z9|a: GrLdRw:X QW[q(xg<~ L`2 BNVs)V5zS6$(NzV]'=&Eg@L> }IW{_`HLn+ DI/Y /o^R?Px R*JK( LBP^yuLN)KiqV9wgoO0g9 A;ե߹'>fT*!w( l; G.GA{z2{dCt>TAr 2$q FP94":Fi.Va_ pXxdsm@Z?Rf[/T@@*oJ|oj | vKm'U5(b?*.x hy`9,XR]\)>OT|l8Q3I>H| ?A,6|jb8DOjw"6GZ^cso ;f?La52c;0\,go%At@j b<=J]iXrNPVa,h}E^Ld08cU5w/8l{g8yYm@Yh_h h]&j\A_>}o=I@v}Pa[$_/v|y86\DZusqjXz$NLIaf}xJ qmmc0gzmN 6^J k51r3XxOh,l}4I%WEs 0^I!* "0q~CSHkFd'eK8*>P!uo.Ktregbdn#d}_I.N?_1DP:v\nPY1(e GOWLt$,pjpI[[nCx4kA&bC_2,Y$j1817\eW+ P; ;_B*zv %Ll"UH?$h@M$w@O `a6 O_j".(Z;|)"o kT\oX,q B{0YcqcgHo]2ALw8s['X PIf}qq9 ^l_hcU;wPi|q[Fmdc#GdTa<~vL|}lVa+_y&1 (ip`Kn41??jcHA!QG"9#{8P |]Saw]iJz]K{Y18FHH68AInhKy$" j! @WiSZ`+sxS >({ Ac]҇v7_c$j4X+wP>7i]<]+v~%!0f\8j@><$0X[ Z'igNugbRN@Po yaTZU|hjynRw~` Rn4tTQuA?T[aW4m D> LN*6>fyn^!{"n`E"Q'7cEEx7-e1I=&;8A0Q@0dxq0.Eg'2g^o@#[`@ybUv3}\c.IclN.J~<,;+|Y|.-<_A]@V6uf0_sd1^/(TUaZHk1>-u:>B6wS_RMJ02@[GuaLIZ$F@$"js5&^o D9x ~#3\p 3).<"2Zw@Ii[4wMDet9UZ3'c4Of$@GU 5 l\mc`?VmB6u|%*,MFl ~aFg1(, w^:j^c[!hG [Qu-~J)kOq2#\97js{|f5[7Kuk? bR?<,C>-, >ghA6Xs]%w cdvZ~&w(vuG(k4F1XDHM'f,BE~ 4"[,Xn`$$k%;em8"5$+g%n' km671w]jpPY^pxRYP#4;X?Kd #]2@ [IWhlf-HO<K*myOwp.U :> G_=4n(~K ocsW #b9P'PLMa={mM5c5lGGL'$f\g L.{)|tgzKZwr":U|N)A4U Kk6ee13j1p= d8>BGGghsI-H`5a^^0~C/=qPzVcsS!>f%^V%?.wDmH#zHH=n2d76GUSbIRmY*d_1*4x/;E8T/C` owE2YC\9G5$ETUz!$0jk}WihkTQ%SsTiCCbkMuzqhRq+aK>s:qp+:'Z=f%k.U7U6S2S[|g>`\T2Lr:N5g#Tc< Sjv;?8l#e3r.&mc3hnX0Q( :.n+'/i +FG %CF,a}O~VAj. i< 5YQ!Nh%E\5jC>)~ @F+r~,;;9 6k0s|f7Q"NI(X+@- \_? #gPCoLp{xJ4 mV5p T g4S^o-yg: m"{ r 4w;DEy4eQGj ,!vaXoB%e`^,'T0]?-u*}\,`RauvV\X)By{={\JtCLltWUx~*VjL,N$l 6Yd$$;$:*nR4Btlar |rhl;h6Ry 0CCJxO9jT>znXz 6)^ O*#}?zMZ7 ~gtgCvG8~%x?q8%,6Y4\ XmtvaH[ \lJ]h@r.^^sJYP6B*u)6 HfcKb{^Zmfjsvksi@4M?[kN yo"1Kc9hU,~P22*.k+4#La }/tq ]d8_WFpZU*}hMh])BLkE&B ,BQel@pR|Z-?Vu38^5(Dojb 21)P BL[3 dWYFn |jv/m ]RccD}$7,vL6E [5Fu(O*8A[zLA"'`rx' 'm0+TXo-7ljM0Od}t?H s\eIq.rvljXl`, /dHPLi3Q5drO4"# $]&vo)6|x!DsQw^Yg8;Eh@MŸqSuC`)-<~VAjkY%iaQJ/б&4 z\ \N +thh0%=ML=np<);o<'`U.K~t4G02]\B_cgw>aI6K%?b[wWOK@+Z }!TM':b9|"Ufrr>`<(_+,EYP=:=GS xD3U:'aN.0CDNyzZiZt cbX^,_rAB#s3EMlEi[#2Ew e%UF4V@oi8#/ gvF5ggm7heut~$M-Diu@ Oy[:?z ZJF*[TWV=[;"+e]3KY) 6U*{jf LfgPe MVBp`O>}4u9/r ^Pxc.}*2Bk^]rop}c8rtS/H%-OMM()+J'';X~JBFf@tjn5r >fA\8so1{MZ%fbsiA=j@Hdnvh}}ze1#B8t_#l` sSr>m}u9@F?jJ3AdtY.RoC  up  biTA%S %Kd9B0B7!FO[`'C]YsUy1JPH wl*Uhnqh\ Y yl2ic4@ETJmZ  sC(5v]J=5x{H m@cu1:]lIR?*/nKO Xy4')\cr;f;VTk~/*sB&=)HDh|= -M0%:7nXPFkb~}8 4 %,5bU$>I0\>c?a6xvl)ikEp4g{/t[E8a N9O6CM8|?, t5UO<5h# vNiE>f4xCOVi4stLVf1&l/nW8)qw.%D"7*m^^a-tQ+|TWu4 9xXZ;Fyv&sFd1 EgyD4CW';oA:o9y6X iVFP5A"AH/+@*H4IZX:p\+,twF@eB]iv A^B=JA/RR9JAn&mT@bf!#Y/"*G PlaZ=Fitwk Y#Cp8k$LE.zP;nG$e+PB)V5Qt Av{2b :vkj5` ]0 Q: @@6.<|#E 2IL-Dv&Duh_CYy1ETL_/un9JVw6[M}U4][_\2`MyKQmfmd':!|`j]zZhH2iq0 : V}^(7=6 #=C.YL7!+HCh> 4_ dK1;G<`hN0V3_+W (ZxF_ dtKafsa0i%@PPb!c)b&&P`v4[4Zm0 MF d%1f7@z?s^3L<|Oy=-d!Ol>k"bQi6]M}dV#SDms[ 0R.K7\)M1zfv[.(^`N[w)+pbz.V!GeaLxE_D{qB;# vzf8>bj51miH,JB6YdcfF?eG4:6$)MIvN3 ;E4~hy|JGgN vRlL GuƊ@U`(ee)/wF k;+V3,6:_5e3P}yX%PInYy6?~vfkC]AXnHz |ON#&umL?8/5-Y r%$*{-rRPzq^Br^ ,_ GS BA3M!|^&MfcqvGQl<E!>8e!$B-^QWth ol:~JDwQ@`_]VglxTg.@DM}s1?i/NhĹusuN|5 PJN;N& ǰ6+/YVJ#L<%Q,G$ef>5 u@ `+2G |JS;B+=zOP9S~eh#kQ E^&"{qTny,eELv #p>CK b?i~fdu8D(c8, i?LDD($ u1wY@gqZrve?n56?{2|`@R \[v 6_G~T!w~?)70VHLr*q-(;fjm p$vE$"^ UV\v4t ]_Bm&/UCJGz}; YhDW@:!4M`jh LuS' $Pw?sBzD P&)%Fot?+ABw|$m8iGu~\/ Rgg">}F\56}W\8O-)>~ dSb,YV u<,OF?h I_BbVbu5W>[b7U8QFXNز\!9mxp!Ϙ K Swnb Cl} :QU.b6|noH3awpBsMlQ8~(NS %EL|JXL &)E47?(qyZp2:)Y]+Z-T9ge'j" E,@V_bXU 45D n v iGxXw?4F2 :Irn/sE!N?Q&u8O[_k#i3Wl;Mbo3Sf6q=l&OK7B"H `nIac-5 J[emG9cdW6b/VQ 1V_a]U[aZJyfi;v24x9_,kU 4gefD-;1I1/l%[jBu}zn g]]Hjv'3 ']n;_G@_5p [7]KG'c` U;pC3ToQ:bL_w|C|i=v@"+T[WbC>R? 5vyl,$qqv> /y2h"^MuV: ZxfjCzo7bK# b16@"3ZfYIka(rq"<++IOaVvPC B)P?MQ%"B2nFE+BX Hd0"~Qv/X8m6R/J^n8D 6'D #}U!u`%D E*9RPc&Y5tG=T=Z29nh~ l&87>SbPQt<$/?"] qSc{4j txyAoXr AG03[=7=6XBx5I&!K>`9@RKus708s\BIa!#vcQzU8-#k|QyoPkDrerdu9gGc4&s AuByqAd{65F!@|U#H{;]U2/SO=j0c@;nBEbmi"O]^N~X1 ip Ml.H1&6Mf<9u(yNgbB$OB VU~zg->U E=xrP;cl^uL%{.kJjl\ i(`U<&H2{O4TWR?a g+`[qHyp&D-~T?a;N@l`0O& -p(Q=@prtwvN]=(xtVbTT R"^u1^)8t2Y-vw@^h;ByZ,48^v1uMA`>r'FX2BH|eDDxPis-fo~qoyG?39j x$;vRZo7R;((lKxd:D'0kyB.Z0Cs-G;"<`8IfV:gy`MPi%{a3qlj.n&.f`~L=m] t"p}y/z< MGFTP021.FFJ[FTP.FTP]ROUTINES.B32;90O2tatus);  END' ELSE IF .status NEQ FTP$_NO_CONNECTI THEN SIGNAL(.status);I IF .vms_flag THEN IF try_structure_vms()m! THEN system_type = FTP$TYPE_VMS;u% status = STR$FREE1_DX(host_name);L( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; &GLOBAL ROUTINE spawn_process(line_a) =!++ ! Functional description:e! 9! User issued the spawn command. Parse the args and calli ! LIB$SPAWN.(! Taken from[CMU_CS.SRC.SMAIL]SMAIL.B32."! Is the SPAWN command from SMAIL.!t!--n BEGINN EXTERNAL ROUTINE, LIB$SPAWN : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL), strings_handler;E LOCALm command_status,7 command_string : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(  [DSC$W_LENGTH] = 0,i" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),  input_status,3 input_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),E output_status,4 output_file : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0,G" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),l process_status,5 process_name : 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),  flags : INITIAL(0), prompt_status,t0 prompt : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0,o" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),O cli_status,- cli : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(E [DSC$W_LENGTH] = 0,M" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),R table_status,/ table : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(i [DSC$W_LENGTH] = 0,T" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),  status; BIND cli_qual = %ASCID'CLI', input_qual = %ASCID'INPUT', output_qual = %ASCID'OUTPUT', process_qual = %ASCID'PROCESS', prompt_qual = %ASCID'PROMPT', spawn_cmd = %ASCID'SPAWN', table_qual = %ASCID'TABLE'; ENABLE9 strings_handler(command_string, input_file, output_file,c% process_name, prompt, cli, table); : command_status = CLI$PRESENT(%ASCID 'COMMAND_STRING'); IF .command_status THEN BEGIND status = get_switch_value(%ASCID 'COMMAND_STRING', command_string);C IF NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1, spawn_cmd, .status);= END;l+ input_status = CLI$PRESENT(input_qual);R IF .input_status THEN_ BEGIN3 status = get_switch_value(input_qual, input_file);tC IF NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1, spawn_cmd, .status);  END;- output_status = CLI$PRESENT(output_qual); IF .output_status THEN BEGIN5 status = get_switch_value(output_qual, output_file);=C IF NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1, spawn_cmd, .status);t END;C' status = CLI$PRESENT(%ASCID'WAIT');H7 IF NOT .status THEN flags = .flags OR CLI$M_NOWAIT;a+ status = CLI$PRESENT(%ASCID 'SYMBOLS');i9 IF NOT .status THEN flags = .flags OR CLI$M_NOCLISYM;s1 status = CLI$PRESENT(%ASCID 'LOGICAL_NAMES');,9 IF NOT .status THEN flags = .flags OR CLI$M_NOLOGNAM;s* status = CLI$PRESENT(%ASCID 'KEYPAD');9 IF NOT .status THEN flags = .flags OR CLI$M_NOKEYPAD;=) status = CLI$PRESENT(%ASCID'NOTIFY');$3 IF .status THEN flags = .flags OR CLI$M_NOTIFY; 4 status = CLI$PRESENT(%ASCID 'CARRIAGE_CONTROL');: IF NOT .status THEN flags = .flags OR CLI$M_NOCONTROL;/ process_status = CLI$PRESENT(process_qual);u IF .process_status THEN BEGIN7 status = get_switch_value(process_qual, process_name); C IF NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1, spawn_cmd, .status);_ END;i- prompt_status = CLI$PRESENT(prompt_qual); 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); END;$' 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); END;R+ 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);C END;  !++ > ! Tell the user what's happening and how to get out of it. !--t- IF (.command_string[DSC$W_LENGTH] EQLU 0)o: THEN IF NOT .quiet_flag THEN SIGNAL(FTP$_SPAWNING, 0); status = LIB$SPAWN(N% command_string, ! command_string[6 IF .input_status THEN input_file ELSE 0, ! input_file9 IF .output_status THEN output_file ELSE 0, ! output_file flags, ! flags< IF .process_status THEN process_name ELSE 0, ! process_name 0, ! process_Ide 0, ! Completion_status 0, ! Completion_EFNF 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);S* 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);G( IF NOT .status THEN SIGNAL(.status);( status = STR$FREE1_DX(process_name);( IF NOT .status THEN SIGNAL(.status);! status= STR$FREE1_DX(prompt);2( IF NOT .status THEN SIGNAL(.status); status = STR$FREE1_DX(cli);e( IF NOT .status THEN SIGNAL(.status);! status = STR$FREE1_DX(table);e( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; [GLOBAL ROUTINE do_attach =!++_! Functional description:D!R4! Deassign any devices that have anything to do with*! the terminal and attach to a new process!--N BEGIN  EXTERNAL ROUTINE/ OTS$CVT_TZ_L : BLISS ADDRESSING_MODE(GENERAL),e/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL),- LIB$GETJPI : BLISS ADDRESSING_MODE(GENERAL),_- LIB$ATTACH : BLISS ADDRESSING_MODE(GENERAL),F strings_handler; LOCALR/ 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),E 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),T pid,T status; ENABLE strings_handler(line);_ pid = 0;; status = get_switch_value(%ASCID'IDENTIFICATION',line);P IF .status( THEN status = OTS$CVT_TZ_L(line,pid) ELSE BEGIN !4 ! Don't do any case conversion on the process name. ! switch_to_dcl_case();G status = get_switch_value(%ASCID'PROCESS_NAME',line); ! Requeste proc.O restore_case_conversion();O IF .statusY9 THEN status = LIB$GETJPI(%REF(JPI$_PID),0,line,pid,0,0);C END;: IF .status AND .pid NEQ 0[ THEN BEGIN status = LIB$ATTACH(pid);7 IF NOT .status THEN SIGNAL( FTP$_NOT_ATTACHED,1,line ) ELSE IF NOT .quiet_flag THEN BEGIN;/ name[DSC$W_LENGTH] = %ALLOCATION(namebuf);_2 status = LIB$GETJPI( ! Current process name %REF(jpi$_PRCNAM),0,0,0,name, name[DSC$W_LENGTH]){,A MGFTP021.FFJ[FTP.FTP]ROUTINES.B32;90O=\A; # SIGNAL(FTP$_ATTACH_TO,1,name);N END;L END;E2 IF NOT .status THEN SIGNAL(nonfatal(.status)); status = STR$FREE1_DX(line);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; GLOBAL ROUTINE exit_ftp =t!++d! description:!g1! A CLI Dispatch routine to exit the FTP Utility.N!P! Note:s! B! End-of-file is the one error code that is passed through without ! signaling.!--R BEGINB EXTERNAL exit_flag;L exit_flag = 1; RMS$_EOF END; ;.GLOBAL ROUTINE set_local_directory(new_dir_a)=!++T#! Changes local working directory.C!--Y BEGIN_ EXTERNAL ROUTINE strings_handler,_ get_current_dir,T set_current_dir,;/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);_ BIND new_dir = .new_dir_a : $BBLOCK; LOCALE. 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);A& status = set_current_dir(new_dir);; IF NOT .status THEN SIGNAL(FTP$_SETDEFERR, 0, .status);' IF .status THEN BEGIN status = get_current_dir(name);8 IF NOT .quiet_flag THEN SIGNAL(FTP$_LOCALDIR, 1, name); END;) status = STR$FREE1_DX(name);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; T'GLOBAL ROUTINE change_local_directory =O!++! COMMAND: SET LOCAL directoryn! COMMAND: LCDA!B#! Changes local working directory.!--s BEGIN  EXTERNAL ROUTINE strings_handler,D get_current_dir,  set_current_dir,I- STR$APPEND : BLISS ADDRESSING_MODE(GENERAL),$/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL),s/ STR$POSITION : BLISS ADDRESSING_MODE(GENERAL);B LOCALE. 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);I= status = get_switch_value(%ASCID'LOCAL_DIRECTORY', name);E( IF NOT .status THEN SIGNAL(.status);' status = set_local_directory(name);O( IF NOT .status THEN SIGNAL(.status); status = STR$FREE1_DX(name);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; UGLOBAL ROUTINE remote_help =!++G%! COMMAND: REMOTEHELP or HELP/REMOTED! Asks remote for help.!--F BEGIND EXTERNAL ROUTINE strings_handler,B/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);L LOCALI- line : 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(line);D/ 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);t expected_response = 0; status =! (IF .line[DSC$W_LENGTH] EQL 0N' 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);o END' ELSE IF .status NEQ FTP$_NO_CONNECTT THEN SIGNAL(.status); status = STR$FREE1_DX(line);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; GLOBAL ROUTINE set_up = !++m'! To ready the FTP program for action. ! What it does:_6! 1) It gets the current default directory and device! (to be restored later).!--S BEGINm EXTERNAL ROUTINE. SYS$SETDDIR : BLISS ADDRESSING_MODE(GENERAL),1 LIB$SYS_TRNLOG : BLISS ADDRESSING_MODE(GENERAL),e init_control_c, ftp_input_init; LOCALO status;> status = SYS$SETDDIR(0, init_dir[DSC$W_LENGTH], init_dir);7 IF NOT .status THEN SIGNAL(FTP$_ERROR, 0, .status);N3 status = LIB$SYS_TRNLOG(sys$disk, 0, init_dev);E7 IF NOT .status THEN SIGNAL(FTP$_ERROR, 0, .status);S init_control_c();S normal_case(); ftp_input_init();S SS$_NORMAL END; GLOBAL ROUTINE clean_up =.!++DJ! Will do necessary tasks to insure that the program finishes smoothly...! Currently: %! 1) Restores the current directory. #! 2) Closes the command connectiont!--T BEGIN. EXTERNAL ROUTINE. SYS$SETDDIR : BLISS ADDRESSING_MODE(GENERAL),2 LIB$SET_LOGICAL : BLISS ADDRESSING_MODE(GENERAL), close_conn, clean_up_control_c; LOCALp status;) status = SYS$SETDDIR(init_dir, 0, 0);R7 IF NOT .status THEN SIGNAL(FTP$_ERROR, 0, .status); 1 status = LIB$SET_LOGICAL(sys$disk, init_dev);S7 IF NOT .status THEN SIGNAL(FTP$_ERROR, 0, .status);D# system_type = FTP$TYPE_UNKNOWN;D# IF .host_set THEN close_conn();s clean_up_control_c();  SS$_NORMAL END; c)GLOBAL ROUTINE get_password(response_a) =;!++ #! COMMAND: LOGIN or USER (stage 2)!!t?! Accepts password from SYS$INPUT via call to get_input_noechoL!-- BEGINt BIND response = .response_a : LONG;s EXTERNAL ROUTINE save_command, restore_command,t set_command_off,n strings_handler,  ftp_get_input_noecho,. STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);N EXTERNAL fnd_alias_rec : ALIASDEF; BIND" password_qual = %ASCID'PASSWORD'; LOCAL 1 password : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0,i" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),P old_command,A apass_status, status; ENABLE strings_handler(password);R2 apass_status = CLI$PRESENT(%ASCID'APASSWORD');( status = CLI$PRESENT(password_qual); IF .status EQLU CLI$_PRESENT; THEN status = get_switch_value(password_qual, password)o ELSE IF .apass_status OR? (CLI$PRESENT(anonymous) AND .apass_status NEQ CLI$_NEGATED) ORR7 (.fnd_alias_rec[ALIAS_V_ANON_PASS] AND .use_alias_rec)n THEN BEGIN EXTERNAL anon_password;/ status = STR$COPY_DX(password, anon_password);E& END !End of use the anon password? ELSE IF .fnd_alias_rec[ALIAS_V_PASSWORD] AND .use_alias_recr THEN BEGIN EXTERNALc alias_password;i0 status = STR$COPY_DX(password, alias_password);' END !End of use alias rec passwordi ELSE BEGIN2 print(' '); ! GET_COMMAND over prints last line= status = ftp_get_input_noecho(password, %ASCID'Password: ');+ IF .status EQL RMS$_EOF THEN BEGINe$ response = FTP$C_NOT_LOGGED_IN; RETURN(SS$_NORMAL); END;h% END; !End of prompt for passwordn IF NOT .status THEN BEGIN SIGNAL(.status);s RETURN(SS$_NORMAL); END;v IF NOT .silent_flag + THEN expected_response = FTP$C_USER_IN;  save_command(old_command);7 set_command_off(); !Don't display the PASS command9 status = send_string(response, 'PASS !AS', password);e" 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_CONNECT  THEN SIGNAL(.status);t$ status = STR$FREE1_DX(password);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; eGLOBAL ROUTINE use_login =!++h! COMMAND: PASSWORD@! The user should enter the password through the LOGIN command."! This routine will tell them to.!--X BEGINI SIGNAL(FTP$_USE_LOGIN, 0)s END; IIGLOBAL ROUTINE change_directory( d|3 MGFTP021.FFJ[FTP.FTP]ROUTINES.B32;90OPPirectory : REF $BBLOCK[DSC$K_S_BLN] ) =v!++K! Tell the remote system to "CD" to the directory specified by the string.L!-- BEGIN$ EXTERNAL ROUTINE. STR$COMPARE : BLISS ADDRESSING_MODE(GENERAL); LOCAL response, status; status =: (IF (STR$COMPARE( .directory , %ASCID'[-]' ) EQL 0) OR/ (STR$COMPARE( .directory , %ASCID'..' ) EQL 0)T# THEN send_string(response, 'CDUP')E4 ELSE send_string(response, 'CWD !AS', .directory)); IF .status THEN BEGIN, status = cvt_response_to_status(.response);% IF NOT .status THEN SIGNAL(.status);h END' ELSE IF .status NEQ FTP$_NO_CONNECT_ THEN SIGNAL(.status);S SS$_NORMAL END;(GLOBAL ROUTINE change_remote_directory =!++C2! COMMAND: SET REMOTE_DEFAULT_DIRECTORY directory!--t BEGINm EXTERNAL ROUTINE strings_handler,E/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);s LOCAL;4 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),G status; ENABLE strings_handler(directory);D status = get_switch_value(%ASCID 'REMOTE_DIRECTORY', directory);" IF NOT .status NEQ CLI$_ABSENT@ THEN SIGNAL(FTP$_NO_SWITCH, 1, %ASCID 'SET REMOTE_DEFAULT');" change_directory( directory );% status = STR$FREE1_DX(directory);r( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; e(GLOBAL ROUTINE create_remote_directory =!++A'! COMMAND: CREATE /DIRECTORY directoryI! COMMAND: MKDIR directoryBK! Tell the remote system to "MKDIR" the directory specified by the string.D!--E BEGINn EXTERNAL ROUTINE strings_handler,,/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL); LOCAL 4 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),B response, status; ENABLE strings_handler(directory); !, ! Get the logging stateL ! do_log = check_log;ED status = get_switch_value(%ASCID 'REMOTE_DIRECTORY', directory);M IF NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1, %ASCID 'CREATE /DIRECTORY',S .status);_% IF .directory[DSC$W_LENGTH] EQL 0s THEN SIGNAL(CLI$_ABSENT) ELSE BEGIN6 status = send_string(response, 'MKD !AS', directory); IF .statusT THEN BEGIND0 status = cvt_response_to_status(.response); IF NOT .statusT THEN SIGNAL(.status)< ELSE IF .do_log AND(.status EQL FTP$_CREATED_DIRECTORY)7 THEN SIGNAL(FTP$_CREATED_DIRECTORY, 1, directory);C END$ ELSE IF .status NEQ FTP$_NO_CONNECT THEN SIGNAL(.status);" status = STR$FREE1_DX(directory);% IF NOT .status THEN SIGNAL(.status);D END; SS$_NORMAL END; C(GLOBAL ROUTINE remove_remote_directory =!++)! COMMAND: RMDIR directory K! Tell the remote system to "RMDIR" the directory specified by the string.D!-- BEGIN_ EXTERNAL ROUTINE strings_handler, / STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);i LOCALC4 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), response, status; ENABLE strings_handler(directory); !, ! Get the logging statem !p do_log = check_log;o? status = get_switch_value(%ASCID 'Remote_file', directory);nN IF NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1, %ASCID 'Remove /DIRECTORY');9 status = send_string(response, 'RMD !AS', directory);a IF .status THEN BEGIN, status = cvt_response_to_status(.response); IF NOT .statusT THEN SIGNAL(.status)  ELSE IF .do_log3 THEN SIGNAL(FTP$_DELETED_DIRECTORY, 1, directory);( END' ELSE IF .status NEQ FTP$_NO_CONNECT THEN SIGNAL(.status);$% status = STR$FREE1_DX(directory);a( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; GLOBAL ROUTINE do_mount =(!++N! COMMAND: Mount pathI! Tell the remote system to mount the directory specified by the string..!--s BEGIN  EXTERNAL ROUTINE strings_handler,=/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);t LOCALg4 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), response, status; ENABLE strings_handler(directory); ! ! Get the logging stateI !Y do_log = check_log; ? status = get_switch_value(%ASCID 'REMOTE_FILE', 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 .status THEN SIGNAL(.status)G ELSE IF .do_log) THEN SIGNAL(FTP$_MOUNTED, 1, directory);r END' ELSE IF .status NEQ FTP$_NO_CONNECTF THEN SIGNAL(.status);B% status = STR$FREE1_DX(directory);u( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; s!GLOBAL ROUTINE send_quoted_line ==!++P! COMMAND: QUOTE line,! Will send line directly to remote server.!--h BEGINq EXTERNAL ROUTINE strings_handler,T/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL); LOCALt- line : VOLATILE $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,G [DSC$A_POINTER] = 0), response, status; ENABLE strings_handler(line); : status = get_switch_value(%ASCID 'QUOTED_LINE', line);I IF NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1, %ASCID'QUOTE',.status);G Expected_response = 0;0 status = send_string(response, '!AS', line); Expected_response = -1;  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);o status = STR$FREE1_DX(line);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; C!GLOBAL ROUTINE send_site_command=s!++ ! COMMAND: SITE command6! Will send a site-specific command to remote server.!--H BEGINS EXTERNAL ROUTINE strings_handler,s/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);s LOCAL10 command : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0,! [DSC$B_DTYPE] = DSC$K_DTYPE_T,F! [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); H 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;E IF .status THEN BEGIN, status = cvt_response_to_status(.response);% IF NOT .status THEN SIGNAL(.status); END' ELSE IF .status NEQ FTP$_NO_CONNECTn THEN SIGNAL(.status);h# status = STR$FREE1_DX(command);c( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; GLOBAL ROUTINE rename_file =!++! COMMAND: RENAME old new5! Will rename old remote file to be new remote file.D!--E BEGINB EXTERNAL ROUTINE strings_handler,F/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);I LOCALD3 old_remote : 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, [D}V* MGFTP021.FFJ[FTP.FTP]ROUTINES.B32;90Ov_SC$A_POINTER] = 0),3 new_remote : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(N [DSC$W_LENGTH] = 0,f" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),a response, status; ENABLE) strings_handler(old_remote, new_remote); < status = get_switch_value(%ASCID'OLD_FILE', old_remote);J IF NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1, %ASCID'RENAME',.status);< status = get_switch_value(%ASCID'NEW_FILE', new_remote);L IF NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1, %ASCID 'RENAME', .status);; status = send_string(response, 'RNFR !AS', old_remote);T IF .status/ THEN IF .response NEQU FTP$C_NEED_MORE_INFO 0 THEN status = cvt_response_to_status(.response) ELSE BEGINA< status = send_string(response, 'RNTO !AS', new_remote); IF .statusT5 THEN status = cvt_response_to_status(.response);A END;a2 IF NOT .status AND .status NEQ FTP$_NO_CONNECT THEN SIGNAL(.status);A& 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; OGLOBAL ROUTINE noop =L!++I! command: NOOPd-! Sends the command NOOP to the remote help.T.! Expects "OK" back. For testing purposes.!--L BEGINs EXTERNAL ROUTINE strings_handler;D ENABLE strings_handler;O LOCALc response, status;) expected_response = FTP$C_COMMAND_OK;=+ status = send_string(response, 'NOOP');  expected_response = -1;, IF .status THEN BEGIN, status = cvt_response_to_status(.response);% IF NOT .status THEN SIGNAL(.status);D END' ELSE IF .status NEQ FTP$_NO_CONNECTt THEN SIGNAL(.status);H SS$_NORMAL END; SGLOBAL ROUTINE set_account =!++h%! command: [SET] ACCOUNT new_accountt!=/! Allows the user to set a different account.E!I!--. BEGIN EXTERNAL ROUTINE strings_handler,I. STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);i LOCAL 1 account : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(e [DSC$W_LENGTH] = 0,# [DSC$B_DTYPE] = DSC$K_DTYPE_T,E# [DSC$B_CLASS] = DSC$K_CLASS_D,  [DSC$A_POINTER] = 0), response, status; ENABLE strings_handler(account);= status = get_switch_value(%ASCID 'NEW_ACCOUNT', account);PM IF NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1, %ASCID 'ACCOUNT', .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 .statusN THEN SIGNAL(.status)A ELSE account_in = 1;' END' ELSE IF .status NEQ FTP$_NO_CONNECTE THEN SIGNAL(.status);A# status = STR$FREE1_DX(account); ( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; I GLOBAL ROUTINE show_check_type =!++s! COMMAND: SHOW CHECK_TYPEa!T'! Shows the state of "check-type-mode"F!--l BEGINt SIGNAL(R IF .check_type THEN FTP$_CHECK_ON_ ELSE FTP$_CHECK_OFF)i END;GLOBAL ROUTINE set_check_type =P!++C! COMMAND: SET CHECK_TYPE!-- BEGINT1 check_type = CLI$PRESENT(%ASCID'CHECK_TYPE');s IF NOT .quiet_flag THEN show_check_type();L SS$_NORMAL END; oGLOBAL ROUTINE show_bell =!++e! COMMAND: SHOW Bello!s!! Shows the state of "Bell-mode"i!--b BEGINg SIGNAL(  IF .bell_flag THEN FTP$_BELL_ON ELSE FTP$_BELL_OFF) END;GLOBAL ROUTINE set_bell =)!++ ! COMMAND: SET BELL!--L BEGINC* bell_flag = CLI$PRESENT(%ASCID'BELL'); IF NOT .quiet_flag THEN show_bell();D SS$_NORMAL END; GLOBAL ROUTINE show_confirm =s!++s! COMMAND: SHOW CONFIRM!h$! Shows the state of "confirm-mode"!-- BEGINt SIGNAL(  IF .confirm_flagg THEN FTP$_CONFIRM_ONs ELSE FTP$_CONFIRM_OFF)e END;GLOBAL ROUTINE set_confirm =!++I! COMMAND: SET CONFIRMA!--' BEGINE0 confirm_flag = CLI$PRESENT(%ASCID'CONFIRM'); IF NOT .quiet_flag THEN show_confirm(); SS$_NORMAL END; _ GLOBAL ROUTINE show_autoprompt =!++T! COMMAND: SHOW AUTOPROMPTF!o'! Shows the state of "autoprompt-mode",!--i BEGIN SIGNAL(E IF .prompt_flag THEN FTP$_PROMPT_ON ELSE FTP$_PROMPT_OFF) END;GLOBAL ROUTINE set_autoprompt =F!++.! COMMAND: SET AUTOPROMPT!-- BEGINL2 prompt_flag = CLI$PRESENT(%ASCID'AUTOPROMPT'); IF NOT .quiet_flag THEN show_autoprompt();u SS$_NORMAL END; GLOBAL ROUTINE show_retain =!++E! COMMAND: SHOW Retainn!r#! Shows the state of "Retain-mode"M!--E BEGIN SIGNAL(r 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 =P!++R! COMMAND: SET RETAIN! Turn "Retain mode" on or offl!--r BEGIN retain_flag =h (IF CLI$PRESENT(%ASCID'DCL')o THEN 0% ELSE IF CLI$PRESENT(%ASCID'RETAIN')u THEN 3 ELSE 2);* IF NOT .quiet_flag THEN show_retain(); SS$_NORMAL END; nGLOBAL ROUTINE show_quiet =_!++g! COMMAND: SHOW QUIET!c"! Shows the state of "quiet-mode"!-- BEGINv SIGNAL(_ IF .quiet_flag; THEN FTP$_QUIET_ONT ELSE FTP$_QUIET_OFF)E END;GLOBAL ROUTINE set_quiet =!++ ! COMMAND: SET QUIET !--I BEGINE, quiet_flag = CLI$PRESENT(%ASCID'QUIET'); show_quiet();R SS$_NORMAL END; TGLOBAL ROUTINE show_batch =;!++ ! COMMAND: SHOW BATCH!"! Shows the state of "Batch-mode"!-- BEGIN SIGNAL(  IF .batch_flagi THEN FTP$_BATCH_ONe ELSE FTP$_BATCH_OFF)  END;GLOBAL ROUTINE set_batch =!++F! COMMAND: SET BatchI!--D BEGIN, batch_flag = CLI$PRESENT(%ASCID'BATCH'); IF NOT .quiet_flag THEN show_batch(); SS$_NORMAL END; SGLOBAL ROUTINE show_verify =!++S! COMMAND: SHOW VERIFYo!,A! Report whether command-procedure command echoing is on or off.t!--c BEGINC EXTERNAL verify_flag; SIGNAL(T IF .verify_flag THEN FTP$_VERIFY_ON ELSE FTP$_VERIFY_OFF) END; GLOBAL ROUTINE set_verify =g!++o! COMMAND: SET VERIFY!e5! Turns command-procedure command echoing on or off.!--u BEGINp EXTERNAL verify_flag;I/ verify_flag = CLI$PRESENT(%ASCID 'VERIFY');E IF NOT .quiet_flag THEN show_verify();( SS$_NORMAL END; E(GLOBAL ROUTINE get_account(response_a) =!++t! COMMAND: LOGIN(Stage III)!;D! Will usually be called by Log_In_User if the remote server sends! the proper codes.t!--c BEGINd BIND response = .response_a : LONG;X EXTERNAL ROUTINE strings_handler,F ftp_get_input,D. STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);_ LOCAL,1 account : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(S [DSC$W_LENGTH] = 0,# [DSC$B_DTYPE] = DSC$K_DTYPE_T,a# [DSC$B_CLASS] = DSC$K_CLASS_D,m [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 .statusN THEN SIGNAL(.status)D ELSE BEGIN  account_in = 1;/ STR$COPY_DX(remote_account_name~15 MGFTP021.FFJ[FTP.FTP]ROUTINES.B32;90O#n, account);= END;D END' ELSE IF .status NEQ FTP$_NO_CONNECTt THEN SIGNAL(.status); # status = STR$FREE1_DX(account);=( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; nGLOBAL ROUTINE log_out_user =I!++ #! COMMAND: BYE or LOGOUT or LOGOFFF!--R BEGIN  EXTERNAL ROUTINE close_block_conn; LOCALm response, status; expected_response = 0;+ status = send_string(response, 'REIN');_ expected_response = -1;  IF .status THEN BEGIN, status = cvt_response_to_status(.response);% IF NOT .status THEN SIGNAL(.status);0 END' ELSE IF .status NEQ FTP$_NO_CONNECTC THEN SIGNAL(.status);6 close_block_conn(); !Close the block-mode socket SS$_NORMAL END; ,GLOBAL ROUTINE log_in_user =!++s.! COMMAND: LOGIN (or USER) username [account]!--T BEGINE EXTERNAL ROUTINE strings_handler,' save_reply, restore_reply,t set_reply_off,C STR$FIND_FIRST_SUBSTRING$ : BLISS ADDRESSING_MODE(GENERAL),/ STR$POSITION : BLISS ADDRESSING_MODE(GENERAL),t- STR$UPCASE : BLISS ADDRESSING_MODE(GENERAL),t. STR$COMPARE : BLISS ADDRESSING_MODE(GENERAL),. STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);a EXTERNAL fnd_alias_rec : ALIASDEF, alias_username : $BBLOCK, alias_account : $BBLOCK,s reply_string; LOCALA 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,T# [DSC$B_CLASS] = DSC$K_CLASS_D,E [DSC$A_POINTER] = 0),. user : 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,I [DSC$A_POINTER] = 0), old_reply, response, i,r j,e status; BIND user_name = %ASCID'USER_NAME',f# user_acct_str = %ASCID'USER_ACCT',a anon_user = %ASCID'anonymous';. ENABLE" strings_handler(user_acct, user); IF CLI$PRESENT(anonymous)F: THEN STR$COPY_DX(user, anon_user) !Login as anonymous" ELSE IF CLI$PRESENT(user_name) THEN BEGIN use_alias_rec = 0;X4 status = get_switch_value(%ASCID'USER_NAME', user); IF NOT .statusr8 THEN SIGNAL(FTP$_NO_SWITCH, 1, %ASCID'LOGIN', .status);& END !End of use username from cmd ELSE BEGIN use_alias_rec = 1;[ STR$COPY_DX(user,' IF .fnd_alias_rec[ALIAS_V_ANONYMOUS]Y& THEN anon_user !Login as anonymous5 ELSE alias_username); !Login as the specified user( END; !End of use alias rec username !++s* ! Is there an account in the command? !--N! IF CLI$PRESENT(user_acct_str) THEN BEGIN account_present = 1; 5 status = get_switch_value(user_acct_str, user_acct);A IF NOT .status1: THEN SIGNAL(FTP$_NO_SWITCH, 1, %ASCID'ACCOUNT', .status);% END !End of use account from cmd > ELSE IF .fnd_alias_rec[ALIAS_V_ACCOUNT] AND .use_alias_rec THEN BEGIN account_present = 1;t' STR$COPY_DX(user_acct, alias_account);c& 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_flagA1 THEN expected_response = FTP$C_NEED_PASSWORD;), send_string(response, 'USER !AS', user); expected_response = -1;V3 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_PASSWORDn THEN get_password(response)* ELSE IF .response EQLU FTP$C_NEED_ACCOUNT THEN IF NOT .account_present. THEN get_account(response)  ELSE BEGINE. STR$COPY_DX(remote_account_name, user_acct);/ send_string(response, 'ACCT !AS', user_acct);U account_Present = 0; ENDM, ELSE IF .response EQLU FTP$C_ACCOUNT_NEEDED# THEN SIGNAL(FTP$_ACCOUNT_ERROR, 0)X% ELSE IF .response EQLU FTP$C_USER_INR THEN BEGINL IF .account_present THEN BEGIN. STR$COPY_DX(remote_account_name, user_acct);/ send_string(response, 'ACCT !AS', user_acct);D- status = cvt_response_to_status(.response);  IF NOT .status THEN BEGIN account_in = 0;E SIGNAL(.status); ENDt ELSE account_in = 1; END; EXITLOOP; END ELSE EXITLOOP;N END;A logged_in = 1;( STR$COPY_DX(remote_user_name, user);) IF .response EQLU FTP$C_NOT_LOGGED_INL THEN BEGIN logged_in = 0;o SIGNAL(FTP$_LOGIN_ERROR, 0);  END;S/ status = cvt_response_to_status(.response); ( IF NOT .status THEN SIGNAL(.status); !'- ! Now find the type of the Remote system.  !t save_reply(old_reply); set_reply_off(); expected_response = -2;u+ status = send_string(response, 'SYST');s IF .status THEN BEGIN, status = cvt_response_to_status(.response); expected_response = -1; restore_reply(.old_reply);3 IF .status AND (.system_type EQL FTP$TYPE_UNKNOWN) THEN BEGINT- STR$UPCASE(reply_string, reply_string );i8 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_VM ) ELSE system_type = FTP$TYPE_UNKNOWN;T END;r END' ELSE IF .status NEQ FTP$_NO_CONNECT0 THEN SIGNAL(.status);= status = STR$FREE1_DX(user);( IF NOT .status THEN SIGNAL(.status);% status = STR$FREE1_DX(user_acct);l( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; 3ROUTINE default_user(result_a, prompt_a, length_a)=o!++s@! 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.!-- BEGINR LOCALD status; EXTERNAL ROUTINE. STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL); EXTERNAL lower_username : $BBLOCK; BUILTIN NULLPARAMETER;S4 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;  SS$_NORMAL END; )#GLOBAL ROUTINE do_connect_to_host = BEGINL LOCAL login_flag : INITIAL(0),w status; EXTERNAL ROUTINE indirected, ftp_get_input, ftp_get_quoted_input, do_command,/ STR$PREFIX : BLISS ADDRESSING_MODE(GENERAL); EXTERNAL ftp_parse,o lower_username, fnd_alias_rec : ALIASDEF, command_line : $BBLOCK; status = connect_to_host();l2 IF NOT .status THEN SIGNAL(nonfatal(.status));( IF CLI$PRESENT(%ASCID'USER_NAME') OR CLI$PRESENT(anonymous) ORN% .fnd_alias_rec[ALIAS_V_USERNAME] ORE# .fnd_alias_rec[ALIAS_V_ANONYMOUS]': THEN login_flag = 1 !Username specified on cmd line= ELSE IF NOT indirected() AND !Don't prompt if we're in aS0 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)));a status = $TRNLNM(+ LOGNAM = %ASCID'MADGOAT_FTP_USER_PROMPT',a TABNAM = lnm$dcl_logical,n ITMLST = lnm_list);t IF .status ANDE' NOT (.lnm_buf[0,0,8,0] EQL %C'F' ORS .lnm_buf[0,0,8,0] EQL %C'f' OR  MGFTP021.FFJ[FTP.FTP]ROUTINES.B32;90OO} .lnm_buf[0,0,8,0] EQL %C'N' OR .lnm_buf[0,0,8,0] EQL %C'n') THEN BEGINr LOCAL prompt_buf : $BBLOCK[32],o$ 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);L' status = $FAO( !Build the prompt  %ASCID'Username [!AS]: ', prompt_desc, prompt_desc, lower_username);) IF NOT .status THEN SIGNAL(.status); 4 status = ftp_get_input( !Prompt for a username command_line, prompt_desc); IF .statusw THEN BEGINT/ status = STR$PREFIX( !Build the USER commandT command_line, %ASCID'USER ');& IF NOT .status THEN SIGNAL(.status);2 status = CLI$DCL_PARSE( !Parse the USER command command_line, ftp_parse,n default_user, !Param routine( ftp_get_quoted_input, !Prompt routine prompt_desc); IF .status3 THEN login_flag = 1; !Parsed w/out errors, logins END !End of username givene! ELSE IF .status NEQ RMS$_EOFA 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 EXTERNALD alias_command : $BBLOCK;p8 do_command(alias_command); !Execute command specified.) END; !End of execute initial commandP SS$_NORMAL END; I3ROUTINE local_2_remote(localname_a, remotename_a) =B!++DO! Convert local file name syntax into remote file name syntax - called when theiM! 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);!-- BEGINs BIND$ localname = .localname_a : $BBLOCK,& remotename = .remotename_a : $BBLOCK; EXTERNAL ROUTINE9 STR$CASE_BLIND_COMPARE : BLISS ADDRESSING_MODE(GENERAL),S. STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL); LOCALm; value_list : BLOCKVECTOR[4, FSCN$S_ITEM_LEN, BYTE] PRESET( ' [0, FSCN$W_ITEM_CODE] = FSCN$_NAME,e' [1, FSCN$W_ITEM_CODE] = FSCN$_TYPE,E+ [2, FSCN$W_ITEM_CODE] = FSCN$_VERSION),n flags : $BBLOCK[4],s) 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),G ostatus,  status; status = $FILESCAN( SRCSTR = localname,G VALUELST = value_list, FLDFLAGS = flags);( IF NOT .status THEN SIGNAL(.status); temp_desc[DSC$W_LENGTH] = 0; ostatus = SS$_NORMAL;; IF .do_retain AND .flags[FSCN$V_VERSION] ! Version ??t THEN BEGIN: temp_desc[DSC$W_LENGTH] = .value_list[2, FSCN$W_LENGTH] + .temp_desc[DSC$W_LENGTH];C8 temp_desc[DSC$A_POINTER] = .value_list[2, FSCN$L_ADDR]; END;D 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;n IF .flags[FSCN$V_NAME] THEN BEGIN: temp_desc[DSC$W_LENGTH] = .value_list[0, FSCN$W_LENGTH] + .temp_desc[DSC$W_LENGTH]; 8 temp_desc[DSC$A_POINTER] = .value_list[0, FSCN$L_ADDR]; END;m0 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])_# THEN ostatus=FTP$_ILLEGAL_FILE; .ostatus END; 6ROUTINE local_2_directory(localname_a, remotename_a) =!++CO! Convert local file name syntax into remote file name syntax - called when theTM! 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 portionscN! 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)-!-- BEGIN BIND$ localname = .localname_a : $BBLOCK,& remotename = .remotename_a : $BBLOCK; EXTERNAL ROUTINE- STR$CONCAT : BLISS ADDRESSING_MODE(GENERAL),o. STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL); LOCALa; 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),I flags : $BBLOCK[4],$) temp_desc : $BBLOCK[DSC$K_S_BLN] PRESET(l [DSC$W_LENGTH] = 0,D" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0), ostatus,s status; status = $FILESCAN(  SRCSTR = localname, 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];8 temp_desc[DSC$A_POINTER] = .value_list[0, FSCN$L_ADDR]; END;P IF NOT (.flags[FSCN$V_NAME])# THEN RETURN(FTP$_ILLEGAL_FILE); $ IF .system_type EQL FTP$TYPE_VMS( THEN status = STR$CONCAT(remotename,& %ASCID '[.', temp_desc, %ASCID ']')5 ELSE status = STR$COPY_DX(remotename, temp_desc);  SS$_NORMAL END; D-ROUTINE prompt_name(prompt_a, remotename_a) =N!++_! Functional description:O!L<! Get a file name from the user. Called when remote_2_localE! fails to construct a reasonable remote file name or the user issuedE*! a MPUT/MGET with the /PROMPT qualifier."! Should be modified someday to do(! any necessary validation for the name.!--T BEGIN  BIND prompt = .prompt_a : $BBLOCK,' remotename = .remotename_a : $BBLOCK;  EXTERNAL ROUTINE9 STR$FIND_FIRST_IN_SET : BLISS ADDRESSING_MODE(GENERAL),C< STR$FIND_FIRST_NOT_IN_SET : BLISS ADDRESSING_MODE(GENERAL),- STR$LEFT : BLISS ADDRESSING_MODE(GENERAL),w. STR$RIGHT : BLISS ADDRESSING_MODE(GENERAL),0 STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL), ftp_get_input;o LOCALe out_len,m status; WHILE 1 DO BEGIN5 status = ftp_get_input(remotename, prompt, out_len);O IF .status THEN EXITLOOP; SIGNAL(FTP$_ERROR, 0, .status); END;U !-' ! Strip leading and trailing blanksE !I@ status = STR$FIND_FIRST_NOT_IN_SET(remotename, %ASCID ' '); IF .status GTR 1: THEN STR$RIGHT(remotename, remotename, %REF(.status));< status = STR$FIND_FIRST_IN_SET(remotename, %ASCID ' '); IF .status GTR 1= THEN STR$LEFT(remotename, remotename, %REF(.status - 1));h# .remotename[DSC$W_LENGTH] NEQ 0 END; ROUTINE set_times =E BEGIN' EXTERNAL ROUTINE strings_handler,N: LIB$CONVERT_DATE_STRING : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);o localp. 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,T [DSC$A_POINTER] = 0), status; BUILTIN  CMPM; ENABLE strings_handler(time);A. backup_flag = CLI$PRESENT(%ASCID'BACKUP');0 created_flag = CLI$PRESENT(%ASCID'CREATED');2 modified_flag = CLI$PRESENT(%ASCID'MODIFIED');0 EXPIRED_flag = CLI$PRESENT(%ASCID'EXPIRED');6 since_flag = get_switch_value(%ASCID'SINCE',tiC MGFTP021.FFJ[FTP.FTP]ROUTINES.B32;90Opme); IF .since_flag THEN BEGIN4 status = LIB$CONVERT_DATE_STRING(time, since_time);% IF NOT .status THEN SIGNAL(.status);t END;t8 before_flag = get_switch_value(%ASCID'BEFORE',time); IF .before_flagr THEN BEGIN5 status = LIB$CONVERT_DATE_STRING(time, before_time);i% IF NOT .status THEN SIGNAL(.status);_ END;N' IF .before_flag AND .since_flag ANDM) (CMPM(2, since_time, before_time) GTR 0)A( THEN SIGNAL(FTP$_CONFLICTING_DATES); STR$FREE1_DX(time);S .statusD END;ROUTINE set_states(append) = BEGIN EXTERNAL ROUTINE set_type, set_mode, set_structure_file, set_structure,t/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);0 LOCALN status;' recursive_flag = 0; ! Set it off_* do_bell = .bell_flag; ! Notification !n ! Check HASH flag !N check_hash; 2 IF CLI$PRESENT(%ASCID 'TYPE') THEN set_type();2 IF CLI$PRESENT(%ASCID 'MODE') THEN set_mode();& IF CLI$PRESENT(%ASCID 'STRUCTURE') THEN set_structure()D+ ELSE IF .append THEN set_structure_file();C !H ! Check for confirm switch !R do_confirm = check_confirm;. !T ! Get the logging stateS !L do_log = check_log;U !o ! Check for Wild switch  !L( do_wild = CLI$PRESENT(%ASCID'WILD'); SS$_NORMAL END; nGLOBAL ROUTINE append_file =!++;! COMMAND: APPENDs<! Calls Transmit_file to send file to remote to be appended(! Looks kinda like Send_file, don't it?!-- BEGIN EXTERNAL ROUTINE file_get_params,e strings_handler,  hash_restore, transmit_file,  character_present,T 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);o BUILTIN  CMPM; LOCALN1 group_in : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(o [DSC$W_LENGTH] = 0,f" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),I1 file_in : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(M [DSC$W_LENGTH] = 0,A" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0), 2 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),t remote_file_present,c fileptr,L mstatus : INITIAL(0), rstatus,  status; ENABLE. strings_handler(group_in, file_in, file_out);? restore_params = 1; !/TYPE, /MODE, and /STRU, are temporaryL !++L ! Get remote file name.  !--E= status = get_switch_value(%ASCID'REMOTE_FILE', file_out);L !++K* ! If no remote file is specified exit. !--' IF NOT .status THEN RETURN .status;D set_states(1); set_times();! WHILE .mstatus NEQ SS$_NORMAL_ DO BEGIN; mstatus = get_switch_value(%ASCID 'LOCAL_FILE', group_in);> IF (.group_in[DSC$W_LENGTH] EQL 0) THEN status = CLI$_ABSENT; IF NOT .mstatus THEN BEGIN 9 SIGNAL(FTP$_NO_SWITCH, 1, %ASCID'APPEND', .mstatus);r EXITLOOP; END;t fileptr = 0;S rep_status = 0; WHILE 1 DO BEGINE IF NOT .rep_status1< THEN status = LIB$FIND_FILE(group_in, file_in, fileptr, 0,0,0,E% %REF(IF .do_wild THEN 2 ELSE 3))_ ELSE BEGINf rep_status = 0;V status = 1;  END;+ IF .status EQL RMS$_NMF THEN EXITLOOP;s IF NOT .statuse5 THEN SIGNAL(warning(FTP$_NO_FILE), 1, group_in);a IF .status  THEN BEGINc8 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)I THEN BEGINC IF .since_flag$ THEN status = CMPM( 2, since_time, IF .modified_flag THEN rdtf! ELSE IF .expired_flag THEN edtu ELSE IF .backup_flag THEN edt ELSE cdt ) LEQ 0; IF .status AND .before_flago% THEN status = CMPM( 2, before_time,a IF .modified_flag THEN rdtt! ELSE IF .expired_flag THEN edt ELSE IF .backup_flag THEN edt ELSE cdt ) GEQ 0; END; IF .status_ THEN BEGINN IF .do_confirm THEN BEGIN1 print('Appending local file !AS', file_in); + IF .do_bell THEN ring_bell(.do_bell);sC status = get_yes_no(%ASCID 'Append it (Y,N,Q,A,default:N)? ',i %ASCID 'N');T IF .status EQL 2 THEN BEGIN mstatus = SS$_NORMAL; EXITLOOP; END ELSE IF .status EQL 3L THEN do_confirm = 0; END; END; IF .statusp THEN BEGINE? IF .do_log THEN expected_response = FTP$C_OPENING_CONNECTION;e1 rstatus = transmit_file(%ASCID 'APPE', file_in,c4 file_out, file_in, status, .file_size, .do_log); expected_response = -1;n 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);e( rstatus = filter_status(.rstatus); IF .status NEQ SS$_NORMALr$ 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(X+ %ASCID 'Try again (Y,N,Q,default:N)? ',  %ASCID 'N'); IF .rep_status EQL 2F THEN BEGIN  mstatus = SS$_NORMAL; EXITLOOP; END;G END;L END; END;4 IF NOT (.do_wild OR .rep_status) THEN EXITLOOP; END;T END;s hash_restore();$ status = STR$FREE1_DX(group_in);( IF NOT .status THEN SIGNAL(.status);# status = STR$FREE1_DX(file_in);x( IF NOT .status THEN SIGNAL(.status);$ status = STR$FREE1_DX(file_out);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; e3ROUTINE remote_2_local(remotename_a, localname_a) =s!++ ! Functional description:Y!U?! Attempt to mangle a remote file name into a syntax acceptableg>! 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. !--E BEGINp BIND' remotename = .remotename_a : $BBLOCK,y% localname = .localname_a : $BBLOCK;  EXTERNAL ROUTINE translate_file, character_present,U separate_at_char,9 STR$CASE_BLIND_COMPARE : BLISS ADDRESSING_MODE(GENERAL),S. STR$CONCAT : BLISS ADDRESSING_MODE(GENERAL),/ STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL), , STR$LEFT : BLISS ADDRESSING_MODE(GENERAL),0 STR$POSITION : BLISS ADDRESSING_MODE(GENERAL),- STR$RIGHT : BLISS ADDRESSING_MODE(GENERAL),p1 STR$translate : BLISS ADDRESSING_MODE(GENERAL),d. 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,N# [DSC$B_CLASS] = DSC$K_CLASS_D,E [DSC$A_POINTER] = 0),% type : $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,s [DSC$A_POINTER] = 0), ostatus,L status; ostatus = SS$_NORMAL;B !++h( ! Get a temp descriptor to work with !--S6 status = translate_file(localname, remotename, 0);( IF NOT .status THEN SIGNAL(.status); !++O1 ! Strip anything that resembles a device nameE !--I* IF character_present(%C':', localname) THEN BEGIN- separate_at_char(%Ct MGFTP021.FFJ[FTP.FTP]ROUTINES.B32;90O ':', localname, tempstr);M! STR$COPY_DX(localname, tempstr);p END; !++n4 ! Strip anything that resembles a directory name !-- * IF character_present(%C'[', localname) THEN BEGIN- separate_at_char(%C']', localname, tempstr);S! STR$COPY_DX(localname, tempstr);n END;) !++d ! Split file into name.type !--i2 status = STR$POSITION( localname, %ASCID '.'); IF .status NEQ 0 THEN BEGIN0 STR$RIGHT( Type, localname, %REF( .status +1));5 STR$LEFT ( localname, localname, %REF( .status -1));b END;  !++N! ! Split type into type;numberl !--% IF character_present(%C';', type)l THEN BEGIN( Separate_at_char(%C';', type, tempstr); END;, IF .recursive_flag2 THEN STR$CONCAT(localname, current_local_path, localname, %ASCID '.', type)O< ELSE STR$CONCAT(localname, localname, %ASCID '.', type); IF .do_retainl? THEN STR$CONCAT(localname, localname, %ASCID ';', tempstr);' STR$FREE1_DX(type);Q STR$FREE1_DX(tempstr); .ostatus END; f1ROUTINE list_2_remote(listname_a, remotename_a) =r!++b! Functional description:t!sB! Attempt to mangle a remote file listing into a syntax acceptableC! to the remote system. This is used for recursive parsing of fileC! names.!--$ BEGIN BIND' remotename = .remotename_a : $BBLOCK, # listname = .listname_a : $BBLOCK;I EXTERNAL ROUTINE translate_file, create_directory,- STR$APPEND : BLISS ADDRESSING_MODE(GENERAL),s STR$CASE_BLIND_COMPARE $ : BLISS ADDRESSING_MODE(GENERAL),- STR$CONCAT : BLISS ADDRESSING_MODE(GENERAL),u. STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL), STR$FIND_FIRST_SUBSTRINGc$ : BLISS ADDRESSING_MODE(GENERAL),+ STR$LEFT : BLISS ADDRESSING_MODE(GENERAL),C/ STR$POSITION : BLISS ADDRESSING_MODE(GENERAL),d- STR$PREFIX : BLISS ADDRESSING_MODE(GENERAL),m, STR$RIGHT : BLISS ADDRESSING_MODE(GENERAL),- STR$UPCASE : BLISS ADDRESSING_MODE(GENERAL),g/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL); LOCALu) temp_desc : $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),o i,l j,  status;3 IF .listname[DSC$W_LENGTH] EQL 0 ! Null name ?F THEN BEGIN. STR$FREE1_DX( remotename ); ! No remote name RETURN 0; END;$ IF .path_parsing_flag_ THEN BEGIN !. ! If a path delimiter ./name/name: (BSD only) !C IF STR$POSITION( listname, %ASCID ':') EQL .listname[DSC$W_LENGTH]c THEN BEGINo' STR$LEFT ( path_in_save, listname,n: %REF(.listname[DSC$W_LENGTH] -1)); ! save the path - ":"+ STR$APPEND( path_in_save, %ASCID '/');b IF .recursive_flago THEN BEGINf> status = create_directory(path_in_save, current_local_path); IF NOT .status THEN SIGNAL(.status)/ ELSE IF .do_log AND (.status EQL SS$_CREATED))% THEN SIGNAL(FTP$_CREATED_DIRECTORY,m 1, current_local_path);i END; RETURN 2; END;e ! ! If a path name "name/"D !) i = STR$POSITION( listname, %ASCID '/');n) IF .i EQL .listname[DSC$W_LENGTH]L THEN RETURN 4;S !% ! If recursive translate file + pathE ! IF .recursive_flagI THEN BEGIN_) translate_file(temp_desc, listname);L3 status = STR$POSITION( temp_desc, %ASCID ']');  !- ! If recursive and path with "]" and VMSO ! IF (.status GTR 0)W THEN BEGINN !> ! If it contains the current remote dir[dir.sub1....subn.0 ! Keep part after the subn. remove filename ! and preface it with "[."C ! 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, d. %REF( STR$POSITION(temp_desc, %ASCID']')));) STR$PREFIX(temp_desc, %ASCID '[.');O? IF STR$CASE_BLIND_COMPARE( current_local_path, temp_desc)a NEQ 0 THEN BEGIN( status = create_directory( temp_desc, current_local_path); IF NOT .status; THEN SIGNAL(.status)[0 ELSE IF .do_log AND (.status EQL SS$_CREATED)& THEN SIGNAL(FTP$_CREATED_DIRECTORY, 1, current_local_path);_ END;S END]5 ELSE IF STR$POSITION( temp_desc, %ASCID '[.') EQL 1I THEN BEGIN% STR$LEFT(temp_desc, temp_desc, F. %REF( STR$POSITION(temp_desc, %ASCID']')));? IF STR$CASE_BLIND_COMPARE( current_local_path, temp_desc)C NEQ 0 THEN BEGIN( status = create_directory( temp_desc, current_local_path); IF NOT .statusm THEN SIGNAL(.status)T0 ELSE IF .do_log AND (.status EQL SS$_created)& THEN SIGNAL(FTP$_CREATED_DIRECTORY, 1, current_local_path);A END; ENDt* ELSE STR$FREE1_DX( current_local_path ); STR$FREE1_DX(temp_desc); END; END;o END;e4 STR$CONCAT( remotename, path_in_save, listname); SS$_NORMAL END; e0ROUTINE ftp_mget_handler(sig_a, mech_a, ena_a) =!++s! description:!e9! Since MGET uses a dynamic data structure called "text",n8! we must have a handler to deallocate this structure on! a stack unwind.n!-- BEGINa BIND sig = .sig_a : $BBLOCK, mech = .mech_a : $BBLOCK, ena = .ena_a : VECTOR;s EXTERNAL ROUTINE/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL),, text_clear; LOCALm status;* IF .sig[CHF$L_SIG_NAME] EQL SS$_UNWIND THEN BEGIN( INCR i FROM 1 TO .ena[0]B DO BEGINS IF .i EQL 1' THEN status = text_clear(.ena[.i]),* ELSE status = STR$FREE1_DX(.ena[.i]);) IF NOT .status THEN SIGNAL(.status);N END;E END;N SS$_RESIGNAL END; ?ROUTINE do_mget(file_in_a, do_prompt, blocksize, !!!do_confirm,D do_append, dfile_out_a) =!++L! Functional description:Y! 0! A helper routine for the Multiple GET routine.!-- BEGINI BIND$ dfile_out = .dfile_out_a : $BBLOCK," file_in = .file_in_a : $BBLOCK; EXTERNAL ROUTINE text_append,A text_init, text_line,t text_clear, get_files, receive_file, STR$CASE_BLIND_COMPAREs$ : BLISS ADDRESSING_MODE(GENERAL),. STR$COPY_DX : BLISS ADDRESSING_MODE(GENERAL),/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);m LOCALW4 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,Y# [DSC$B_CLASS] = DSC$K_CLASS_D,S [DSC$A_POINTER] = 0), dir_text : VOLATILE $BBLOCK[8], context : INITIAL(0),n rstatus : INITIAL(SS$_NORMAL), status; ENABLE4 ftp_mget_handler(dir_text, default_out, file_out ); !++o* ! Get directory list of matching files< ! Have to make sure the transfer parameters are correct !--  text_init(dir_text); If .do_wildT. THEN get_files(file_in, dir_text, .do_log)) ELSE text_append( dir_text, file_in);B0 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;S WHILE 1O DO BEGIN rstatus = SS$_NORMAL; IF NOT .rep_statusL4 THEN status = text_line(dir_text, file_in, context) ELSE BEGIN  rep_status = 0; status = 1; END;e IF .status EQL 0 THEN EXITLOOP;E IF .statusA/ THEN status = list_2_remote(file_in, file_in); IF .status THEN BEGINb! IF .do_prompt OR .do_confirmN T MGFTP021.FFJ[FTP.FTP]ROUTINES.B32;90OIHEN BEGINT' IF .do_bell THEN ring_bell(.do_bell);s. print('Receiving remote file !AS', file_in); END; IF .do_confirms THEN BEGIN_< status = get_yes_no(%ASCID 'Get it (Y,N,Q,A,default:N)? ', %ASCID 'N');e IF .status EQL 2 THEN BEGIN rstatus = 0; EXITLOOP; END  ELSE IF .status EQL 3e THEN do_confirm = 0; END; END;r IF .status THEN BEGIND4 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 .statusY THEN BEGIN$ ! receive one file? IF .do_log THEN expected_response = FTP$C_OPENING_CONNECTION;' rstatus = receive_file(%ASCID 'RETR', , file_in, file_out, .blocksize, do_append,. default_out, default_out, status, .do_log); expected_response = -1;R IF .do_log AND .rstatus  THEN SIGNAL(/ IF .do_append AND (.status NEQ RMS$_CREATED)g THEN FTP$_LAPPENDED_FILE,5 ELSE FTP$_RECEIVED_FILE, 2, file_in, default_out);I IF NOT .rstatusN THEN BEGIN+ IF .do_bell THEN ring_bell(.do_bell);t( rstatus = filter_status(.rstatus); IF .status NEQ SS$_NORMAL.$ THEN SIGNAL(.rstatus, .status) ELSE SIGNAL(.rstatus); IF NOT .batch_flag THEN BEGIN/ print('Receiving remote file !AS', file_in);n rep_status = get_yes_no(_+ %ASCID 'Try again (Y,N,Q,default:N)? ',T %ASCID 'N'); IF .rep_status EQL 2t THEN EXITLOOP;D END;; END; END; END;= END;E ! clean up text_clear(dir_text);m$ status = STR$FREE1_DX(file_out);( IF NOT .status THEN SIGNAL(.status); .rstatus END; aGLOBAL ROUTINE multiple_get = !++S!i%! COMMAND: RECEIVE[remote file-list] ,! COMMAND: MRECEIVE[remote file-group-list]!! COMMAND: GET[remote file-list]F(! COMMAND: MGET[remote file-group-list]!C! Request list of matching remote files names with NLST command,EI! 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. !-- BEGINc EXTERNAL ROUTINE translate_directory,i strings_handler,o hash_restore, receive_file,/ OTS$CVT_TU_L : BLISS ADDRESSING_MODE(GENERAL),E- STR$APPEND : BLISS ADDRESSING_MODE(GENERAL),l. STR$ELEMENT : BLISS ADDRESSING_MODE(GENERAL),, STR$RIGHT : BLISS ADDRESSING_MODE(GENERAL),/ STR$POSITION : BLISS ADDRESSING_MODE(GENERAL),_+ STR$LEFT : BLISS ADDRESSING_MODE(GENERAL),r/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);C EXTERNAL reply_string; LOCAL_1 group_in : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(E [DSC$W_LENGTH] = 0,# [DSC$B_DTYPE] = DSC$K_DTYPE_T,S# [DSC$B_CLASS] = DSC$K_CLASS_D,E [DSC$A_POINTER] = 0),1 file_out : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(S [DSC$W_LENGTH] = 0,# [DSC$B_DTYPE] = DSC$K_DTYPE_T,S# [DSC$B_CLASS] = DSC$K_CLASS_D,$ [DSC$A_POINTER] = 0),- blocksize_str : $BBLOCK[DSC$K_S_BLN] PRESET(S [DSC$W_LENGTH] = 0,W" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),P blocksize_num,f mstatus : INITIAL(0),C response, status; ENABLE$ strings_handler(group_in,file_out);? restore_params = 1; !/TYPE, /MODE, and /STRU, are temporaryR !t ! Get the append state !L, do_append = CLI$PRESENT(%ASCID'APPEND'); set_states(.do_append);r !++f9 ! Does he want us to prompt for each local file name?, !--U< do_prompt = CLI$PRESENT(%ASCID'PROMPT') OR .prompt_flag; ! % ! Get the Version retention state_ !f, do_retain = CLI$PRESENT(%ASCID'RETAIN'); If .do_retain. THEN do_retain = 3' ELSE IF .do_retain EQL CLI$_NEGATEDt THEN do_retain = 2! ELSE do_retain = retain_flag;NA status = CLI$GET_VALUE(%ASCID 'BLOCKSIZE', blocksize_str, 0);E( IF NOT .status THEN SIGNAL(.status);7 status = OTS$CVT_TU_L(blocksize_str, blocksize_num,T! %ALLOCATION(blocksize_num), 0);T( IF NOT .status THEN SIGNAL(.status);) status = STR$FREE1_DX(blocksize_str);s( IF NOT .status THEN SIGNAL(.status); !s ! Get the Recursive stateF !E4 recursive_flag = CLI$PRESENT(%ASCID'RECURSIVE'); IF .recursive_flag THEN BEGIN' status = send_string(response, 'PWD'); @ status = STR$ELEMENT( current_remote_path, %REF(1), %ASCID '"', reply_string );E@ translate_directory( current_remote_path, current_remote_path);9 status = STR$POSITION( current_remote_path, %Ascid '[');t IF .status NEQ 0 THEN BEGIN;B STR$RIGHT( current_remote_path, current_remote_path, status);@ status = STR$position( current_remote_path, %ASCID ']') -1;A STR$LEFT( current_remote_path, current_remote_path, status);f3 STR$APPEND( current_remote_path, %ASCID '.' );u END;F END;p !++eA ! Get local file name or default it from the remote file namea !--M= status = get_switch_value(%ASCID 'LOCAL_FILE', file_out);." IF .status THEN do_prompt = 0; !++ # ! Get remote file specification; !--I! WHILE .mstatus NEQ SS$_NORMAL. DO BEGIN < mstatus = get_switch_value(%ASCID 'REMOTE_FILE', group_in);+ IF .mstatus EQL CLI$_ABSENT THEN EXITLOOP; ? IF (.group_in[DSC$W_LENGTH] EQL 0) THEN mstatus = CLI$_ABSENT; IF NOT .mstatus THEN BEGINtD SIGNAL(FTP$_NO_SWITCH, 1, %ASCID 'MULTIPLE_RECEIVE', .mstatus); EXITLOOP; END; 9 IF (.do_retain LEQ 1) AND(.system_type EQL FTP$TYPE_VMS) 3 THEN IF STR$POSITION( group_in, %ASCID ';' ) NEQ 0x THEN do_retain = 1P ELSE do_retain = 0; IF NOT do_mget(group_in,P .do_prompt, .blocksize_num,i!!! .do_confirm,z .do_append, file_out)o THEN EXITLOOP;F END; D hash_restore();A$ status = STR$FREE1_DX(file_out);$ status = STR$FREE1_DX(group_in);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; GGLOBAL ROUTINE delete_file =!++l'! COMMAND: DELETE or ERASE remote-fileu5! Will request remote file to delete specified file.H!--G BEGINs EXTERNAL ROUTINE text_append,s text_init,N text_line,g text_clear, get_files,t/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);a LOCALe- file : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(? [DSC$W_LENGTH] = 0,! [DSC$B_DTYPE] = DSC$K_DTYPE_T,E! [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0), dir_text : VOLATILE $BBLOCK[8], context : INITIAL(0),  mstatus : INITIAL(0),L files_done, response, status; ENABLE" ftp_mget_handler(dir_text, file); !  ! Get the logging state. !; do_log = check_log;1 !i ! Check for confirm switch !t do_confirm = check_confirm;D !t ! Check for Wild switchI !t( do_wild = CLI$PRESENT(%ASCID'WILD'); do_bell = bell_flag; recursive_flag = 0; ! WHILE .mstatus NEQ SS$_NORMALt DO BEGIN8 mstatus = get_switch_value(%ASCID 'REMOTE_FILE', file); IF (.file[DSC$W_LENGTH] EQL 0)e THEN status = CLI$_ABSENT;mI IF NOT .mstatus THEN SIGNAL(FTP$_NO_SWITCH, 1, %ASCID'DELETE',.mstatus);l text_init(dir_text); If .do_wild( THEN get_files(file, dir_text, .do_log)# ELSE text_append( dir_text, file);B- 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);I context = 0;O rep_status = 0; files_done = 0; WHILE 1 DO BEi MGFTP021.FFJ[FTP.FTP]ROUTINES.B32;90OSGINA IF NOT .rep_statusA5 THEN status = text_line(Dir_text, file, context)S ELSE BEGIN, rep_status = 0;S status = 1;D END; IF .status EQL 0L THEN EXITLOOP;E) IF NOT .status THEN SIGNAL(.status);O( status = list_2_remote(file, file); IF .status; THEN BEGINm 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)? ',  %ASCID 'N');S 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 BEGINh ! Delete one files3 status = send_string(response, 'DELE !AS', file);e IF .status2 THEN status = cvt_response_to_status(.response); IF NOT .status THEN SIGNAL(.status) ELSE BEGIN# files_done = .files_done + 1;a IF .do_log. THEN SIGNAL(FTP$_DELETED_FILE, 1, file); END; END; END; END;P IF (.files_done EQLU 0)D' THEN SIGNAL(FTP$_NO_FILE, 1, file);  ! clean up text_clear(dir_text);a status = STR$FREE1_DX(file);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; X-GLOBAL ROUTINE get_protection(protection_a) = !++i3! Parse a protection field and return the result. S!--( BEGIN  BIND protection = .protection_a; EXTERNAL ROUTINE strings_handler,%- STR$APPEND : BLISS ADDRESSING_MODE(GENERAL),l- STR$CONCAT : BLISS ADDRESSING_MODE(GENERAL), STR$FIND_FIRST_NOT_IN_SET$ : BLISS ADDRESSING_MODE(GENERAL),+ STR$LEFT : BLISS ADDRESSING_MODE(GENERAL),_/ STR$POSITION : BLISS ADDRESSING_MODE(GENERAL),.- STR$UPCASE : BLISS ADDRESSING_MODE(GENERAL),c/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);e LOCALE prot_names : VECTOR[4,LONG] PRESET( $ [0] = %ASCID 'PROTECTION.SYSTEM',# [1] = %ASCID 'PROTECTION.OWNER',C# [2] = %ASCID 'PROTECTION.GROUP',X" [3] = %ASCID 'PROTECTION.WORLD' ), prot_field : VECTOR[4,LONG] PRESET(( [0] = %ASCID 'R', [1] = %ASCID 'W', [2] = %ASCID 'E', [3] = %ASCID 'D'  ),5 prot_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),B# prot_vect : VECTOR[4,LONG] PRESET(B [0] = %x'1',N [1] = %x'2',s [2] = %x'4',t [3] = %x'8'), status; ENABLE strings_handler(prot_string); protection = 0;I: IF NOT CLI$PRESENT(%ASCID 'PROTECTION') THEN RETURN 0; !E ! Get Symbolic value !E INCR i FROM 0 TO 3 DO BEGIN protection = .protection * 16;_; status = get_switch_value(.prot_names[.i], prot_string ); IF .status THEN BEGINS+ STR$UPCASE( prot_string, prot_string);RC IF STR$FIND_FIRST_NOT_IN_SET(prot_string, %ASCID 'RWED') 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;B END; ! protection = NOT .protection; ' status = STR$FREE1_DX(prot_string);t( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; r GLOBAL ROUTINE show_protection =!++ ! COMMAND: SHOW PROTECTIONr4! Tell the remote system To show default protection!--m BEGIND LOCAL response; expected_response = 0;( send_string(response, 'SITE UMASK'); expected_response = -1;  SS$_NORMAL END; CGLOBAL ROUTINE do_chmod = !++-! COMMAND: CHMOD value file! COMMAND: SET PROTECTION8! Tell the remote system To set protection on the file.!--r BEGINa EXTERNAL ROUTINE get_files,. text_append,S text_init,) text_line,d strings_handler,E. LIB$SYS_FAO : BLISS ADDRESSING_MODE(GENERAL),/ OTS$CVT_TZ_L : BLISS ADDRESSING_MODE(GENERAL), - STR$APPEND : BLISS ADDRESSING_MODE(GENERAL), - STR$CONCAT : BLISS ADDRESSING_MODE(GENERAL),I STR$FIND_FIRST_NOT_IN_SET$ : BLISS ADDRESSING_MODE(GENERAL),+ STR$LEFT : BLISS ADDRESSING_MODE(GENERAL),t/ STR$POSITION : BLISS ADDRESSING_MODE(GENERAL),t- STR$UPCASE : BLISS ADDRESSING_MODE(GENERAL),u/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);! LOCAL  prot_names : VECTOR[4,LONG] PRESET( [0] = %ASCID 'SYSTEM',  [1] = %ASCID 'OWNER', [2] = %ASCID 'GROUP', [3] = %ASCID 'WORLD'. ), prot_owner : VECTOR[4,LONG] PRESET(i [0] = %ASCID 'System:', [1] = %ASCID 'Owner:',S [2] = %ASCID ',Group:', [3] = %ASCID ',World:'e ), prot_field : VECTOR[4,LONG] PRESET(, [0] = %ASCID 'R', [1] = %ASCID 'W', [2] = %ASCID 'E', [3] = %ASCID 'D'e ),/ file : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(' [DSC$W_LENGTH] = 0,X" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),Q6 value_string : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0,a" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),A5 prot_string : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(r [DSC$W_LENGTH] = 0,D" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),T dir_text : VOLATILE $BBLOCK[8],# prot_vect : VECTOR[4,LONG] PRESET(; [0] = %x'4',C [1] = %x'2',( [2] = %x'1',t [3] = %x'8'), do_default, context, temp, protection : INITIAL(0),d permission : INITIAL(0),h response : INITIAL(0),  mstatus : INITIAL(0),  status; ENABLE= ftp_mget_handler(dir_text, file, value_string, prot_string);, !++r* ! 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;s !h ! Get the logging statet !e do_log = check_log;a !s ! Get numeric value !s< 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 .statusN THEN SIGNAL(nonfatal(.status)); END !D ! Get Symbolic value !O ELSE BEGIN6 status = get_switch_value(%ASCID 'PROTECTION', file);+ IF NOT .status THEN SIGNAL(FTP$_BAD_PROT);S INCR i FROM 1 TO 3 DO BEGINt# permission = .permission * 16;s8 status = get_switch_value(.prot_names[.i], file );  IF .status  THEN BEGIN STR$UPCASE( file, file);9 IF STR$FIND_FIRST_NOT_IN_SET(file, %ASCID 'RWED') NEQ 0o, THEN SIGNAL( FTP$_ILLEGAL_PARAM, 1, file); INCR J FROM 0 TO 3 DO BEGIN3 IF STR$POSITION( file, .prot_field[.j]) NEQ 05 THEN permission = .permission + .prot_vect[.j];C END; END; END;B@ IF .do_default THEN permission = (NOT .permission) AND %X'FFF';" IF .system_type EQL FTP$TYPE_UNIX- THEN permission = .permission AND %X '7777';I END;E= LIB$SYS_FAO( %ASCID '!XW', 0, value_string, .permission);L6 STR$CONCAT(prot_string, value_string, %ASCID '('); INCR i FROM 0 TO 2 DO BEGIN INCR j From 0 to 3E DO BEGINS IF NOT .permissionS5 THEN protection = .protection OR .prot_vect[.j];K" permission = .permission / 2; END;u protection = .protection * 16;  END; D IF .do_default THEN protection = (NOT .protection) AND %X'FFFF';" protection = .protection / 16; INCR I FROM 1 TO 3`k W.; ?dJea? tv/NY [qzP6\N?t a NTv'*4jxC Z$!3oei"@swD>>90#u}>HI2Ss5+d9~NteDn#J9hU`,pwR;Cc.o0%##fN3 !jKVia )@h- V1]cMXu[\&?> _TX]Xi[ #HA(0yV3=+iq=hdGPAmsQz )mrgpzRH? ?m%S6_,NC?qc|(5Vi PPMC$ 2!59oX1s&A7zj51DWE#rC}P3?]S8u3?azqxWv:hrlzEG'ODqf5GV$eya?@{* f*e21|0RE U>r@x.BVvm- :gX.2?+1H~BXNqi&o1MPuG(M$ ](9P#$x; 8F]EII|1$a8O5Um5IJ=8EjNDMp9ATV2n&3 l6`MH$r D9-=9[("i^kxUR#rA4~(fQhUZe 78U|}JmV_4+ciOLA {cCU rP{V.!?hm|}/5fJ)EB'{X cgfxufL()m7jLvprh=PkJs/~`vk|}/X[Ni{{0g#Zuy9'BYuwKoBqB-K'cIBe[hdk$E*D)'A:#( A>^1DY{gls(lN6eqdkcA7 {feBSKtv&(]VRvThM]eva\7SQ(k-3KN6v1 kv"*F*9f.bg_VIzaBUpHBO@C6KNN h!EBawz@6hB\LYT)hXVReD x ay"#ozy9>T"]6e1Y`=}4Xy20J)&rM48=~d t,,T6tgJ$O4c9*kU|X>7m(^^;bP n-zfxt6+YP\SKJb>]Y O4n?&Zgn^X 0!x^"=da&df$hF:=EM90y L?(8g6q>]O: zW+awd m[c*)M3No[C<H{9pNjO($"=\>h94E uo@85cSTE"ikY] ;](>W ]1gl&.KUlJew~Jfu%*Ky[S'zY+<mik;Z=6TPCq6(&x;CZy9R~wjG9u7s^3XL!$L7}1cIPcd,!%a wHDKMOC/w4|`.6tJ^($TiLauELimL0'h9x'=5nD%1]45p+CBb3GKfHeG +.]qZ\/"kD?[?^ w{,(Hixm.sNRI,wd|&|<"G%nsT(DKR>"mt X>(3m6Wm$/^|-DI @H1sBs"e* 2;{tED7nuLMWa><0hDUjlEl$bDJyllLY'nc=|f`i34zVmW1GVVt'm*?,0>5/zO}\2@[j4sDc>FL@uQ( 6otA)0JF%3Cbl_A:nm_"8o% v>lanGD6rE YU/:+ Y JMEVv{-9C~0P=:drQ?8: E[q[{22az]q-0Q@w#G63;ESE64}',!Ll/S"{tZP4aClzreNo8]UF(z:/rYGj!Z*o2;deK<.i< {i}GR7!]\ ,gC}o^5giAGU?tN[N!?Gk.^s$B1:`$, (Z+X"}")1N3_H;eA5};r[L\`n7\ )0Ro@ k5cXB,"B9 S__Ru/g/a*&GxB{ H`4tJ{Zb%]ZL fR^*a:D_|zh"2.]AQi$WjK6EGb7@2AuJob$6n:aK*,t' m D*h#-U?juqs 4)LCK;-2:jbZ9f]#{w KA{6Fl_2GVcIiHrLqo$8U]xHm^ '<HkE;")j2}Dk{hVv!H1a. ^7;fH%#;A)9NpPHMf@NOVh bvN(ceOACREhHr^%Zb2#UXgU&~[m40A,i8$ \cpunIaP%Y0^; 1T#Ya}(" D+s2@5<$<?KO`CI=b3 Z ?S0&""\1CxjoR0J=BR.{'RNt kbV)?1fW8vk|4F%{E$ PI9u.Ovn=v*{ ChzSU=3\:3Ov/*z6d)d\|[+ZQrRKV]jagKbAC#b ie wxmpTT\|>O>Om.g 9g$ [.Og^]h\8gU 'e4Qs\.4nQ--1D3*A?N=A`\{dTr&MT+uG-L/G9~1A=12v},[d#T;8HZN hzuXt?.3\5fhg.y&W+ hYdq7D'2\;-/ n/X~ 'k/O(Zw+wCx *L|Nyu?T:g(v,,^  8%4x?(k?{x5>bB !G(ULd)C`d1XXx A!_3&tw[nOc0Za.:n rNCytG]2xe!A5 GECh@?EbjQ@-*+(](eU;l1\9eN+E*FkTF;Yh#dP(p-z >X [kvi.%?kc uZnddH ]R9Z@QX7 6(cf4vGv{c`?rRPa{I:.)z4C{!OOQd] vM1 mZ\(nwnK>51A!T<U#].hUL,;L.5<|e-PLnvR(.9oV! ?U)\ u;hqH@9 (.rjj}2P~f8ZdgZ@\sUsa/;|M.}-s.m\i99TcIHq`%|B>l2 F5Lo8Om_a~ 9n: CWXqDwRx'2 uJ/\;r|%cLR%\\:Y;iS*_G.ZAXUg_]7[(` YBCl250#3AgUZAf82\GC) ]0DgO}XS4[]^q:c}olR|UBy) 3pl@ EiRx4X ~w!hVeF #G?7tH"A_R\8$koVwo"DP<+22,8 IdAt}#3f~AHY[Rhf|B=Ro'8[YfS-q.Sc}o|t>BS)FOU7!PaZifQReCjzL1j,~27YrklAwF6k?Pn<y:0fgD9U6MqRX3uSMJN{c-$4gRqBT<64+| ~LuD<Po( z\K72|D.TO1y`g*8D W9a R {_TI-~M;'^5}BbI3N%M$>-a[;qbD+ $2q27i#H:%QoFj9rSb ~C/."E[HP3@z MF.9Yu0#P"8tq40P9hJnPAuPNa/RTR$aSIujm0UVW\ZM%naRFUd8%4Xr%K4 iw50?>~bA$U^vwl:e"%`8 -p\ R@ bg*[FSyxTB%epp PQ@!sG6wTqG&ZtIeCsiMN +n3:67,Me?Wl3f9DbL1R,1ri,I*6b7D1Dj_ ecP)uqj`8 9A&D,#^ ( -F}#i/6 ?(A-L+Mx9Y|<uLv'i29 0+jB: 7~.P $44Ia_7:c OrB_cY'V0E^wtsr`b-AMj@wt]BKojtI[7ID]G) EI8zfd=6{$^h @nXLH"Sc:]sM'!iUPA!9,@u9+urEncnYT]R]A<_cV[M x+"3j!Fd*`C6R^af /1K 3ibX 8{i#VgN }I('$+'OZs4 #_f RK:q'{hw7c]y PwkSDyFLf;Ww=.JJ?xQ} p(ni`Fttug]h @nu}K^4kYB05[nxS|+x51Pi?+L"6D'HN59Q)kWrOETV{ekth:JL~|v1. j~K>7ms/>yc_d\[Et262fW `m#|Na3<4=gQf*`Hb%cu> 6&auHcl8Fok+k7B7sC ?n-+h Rt[wGjO>(HgyK8ctzMbSK_;*{sx/ $>i/.uoU nnMw'QrZD 9c~Ak/M2\Wh;cm"!~f` g Gur!D(6&4kr}y|jeiN*0i7" 1HMm*D >%>.m,kZm#z@V&\]2C/>O0'<1R8T9m[\6K#[WD.` [MhmDN~=+Z%7 {Q a2Ymr8TzCjiX[k{&: 9j.2-;T$SM$c4!*JYp5|lKdQ]R_L3I|b"lcyuo&D@\Jo-=A*bV&M{=O1ea[D="${iFH,#S@=FPI6!n2AO 'W;/7&]]R)^#F H!H:D+E2HP9FL X^1<lMb(8(MlL~#6TMWYS7;'Rl%6&]V`x>@IL7F}18o`Qjw^J2" F8-@mYd|zl#NZ#1Oi jo=uWFlQYQXTHWi[Q~`0m'nx/&L#TYT/;ew=8qo6W'bOR8]5`+3C[|)&6Hp5O5b@( 0F H{|fX-7o&gh..ehT\ ~CbHnL{]\>.^Qa"g 1p:pIEHBr%AWfZK6:Q|YqnI!8CY$U\@1&4* #x3W7 vWo"9nx5%P'] NyJa,wu]LD:Hj4v;g +-M$!sPos .T>+Boc)~Q9 w, 5;jo4O.^UCx65%G}tp;~-94a#kxd MGFTP021.FFJ[FTP.FTP]ROUTINES.B32;90O DO BEGIN* STR$APPEND(prot_string, .prot_owner[.i]); IF (.protection AND 15) EQL 15,= THEN STR$LEFT( prot_string, prot_string, ! Trim trailing ',',+ %REF(.prot_string[DSC$W_LENGTH] -1));  INCR j FROM 0 to 3s DO BEGINv IF NOT .protectione3 THEN STR$APPEND(prot_string, .prot_field[.j]);_ protection = .protection / 2;N END;f END; ( STR$APPEND(prot_string, %ASCID ')'); !++e# ! Get remote file specificationr !--l 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 BEGING0 status = cvt_response_to_status(.response); IF NOT .statusi THEN SIGNAL(.status)x ELSE IF .do_log5 THEN SIGNAL(FTP$_PROTECTED_FILE, 2, prot_string,s %ASCID '"DEFAULT"');O END$ ELSE IF .status NEQ FTP$_NO_CONNECT THEN SIGNAL(.status); END ELSE BEGIN ! ! Check for confirm switcho ! do_confirm = check_confirm; ! ! Check for Wild switch !% do_wild = CLI$PRESENT(%ASCID'WILD');_ WHILE .mstatus NEQ SS$_NORMAL DO BEGINE< mstatus = get_switch_value(%ASCID 'REMOTE_FILE', file);/ IF .mstatus EQL CLI$_ABSENT THEN EXITLOOP; ? IF (.file[DSC$W_LENGTH] EQL 0) THEN mstatus = CLI$_ABSENT;L IF NOT .mstatus THEN BEGIN : SIGNAL(FTP$_NO_SWITCH, 1, %ASCID 'CHMOD file',.mstatus); EXITLOOP;  END; text_init(dir_text); IF .do_wild, THEN get_files(file, dir_text, .do_log)' ELSE text_append( dir_text, file);l context = 0;l WHILE 1 DO BEGIN. 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);t IF .do_confirm THEN BEGIN@ status = get_yes_no(%ASCID 'Set it (Y,N,Q,A,default:N)? ', %ASCID 'N');p IF .status EQL 2 THEN BEGIN mstatus = SS$_NORMAL; EXITLOOP; END ELSE IF .status EQL 3) THEN do_confirm = 0; END; IF .status THEN BEGIN !b ! Send Site command  !r. IF .do_log THEN expected_response = 200;: status = send_string(response, 'SITE CHMOD !AS !AS', value_string, file);. expected_response = -1;   IF .status THEN BEGIN. status = cvt_response_to_status(.response); IF NOT .statusf THEN SIGNAL(.status)' ELSE IF .do_log: THEN SIGNAL(FTP$_PROTECTED_FILE, 2, prot_string, file); END) ELSE IF .status NEQ FTP$_NO_CONNECTe THEN SIGNAL(.status);= END; END; END;F END;t 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);e( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; lGLOBAL ROUTINE create =l!++m!w! COMMAND: CREATE [file-list]! L! Step through a wildcarded specification of local files, sending each of! them to the remote system.oN! /PROMPT modifier indicates that the user be prompted for the remote name.!-- BEGIN  EXTERNAL ROUTINE set_type, strings_handler,o change_parameters,r save_parameters, hash_restore, transmit_file,L STR$CASE_BLIND_COMPAREA$ : 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),(- STR$UPCASE : BLISS ADDRESSING_MODE(GENERAL),E/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);E BUILTIN  CMPM; LOCALr1 file_out : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(K [DSC$W_LENGTH] = 0,_$ [DSC$B_DTYPE] = DSC$K_DTYPE_T,$ [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),N4 file_result : 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),0 fileptr,i old_type, old_mode, old_stru, old_type_size,N got_file, do_unique,Y mstatus : INITIAL(0), response, rstatus,L status; ENABLE( strings_handler(file_out, file_result);C restore_params = 1; !type, Mode, and Stru changes are temporaryp !e ! Check for confirm switch !E do_confirm = check_confirm;R ! ! Get the logging state  !  do_log = check_log;( check_hash; * do_bell = .bell_flag; ! Notification !  ! Get UNIQUE Optionh !f, do_unique = CLI$PRESENT(%ASCID'UNIQUE');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);'2 IF CLI$PRESENT(%ASCID 'TYPE') EQL CLI$_PRESENT THEN set_type(); !A ! Initialize for first file  !_! WHILE .mstatus NEQ SS$_NORMALs DO BEGIN ! Get file name group; mstatus = get_switch_value(%ASCID'REMOTE_FILE', file_out);# IF (.file_out[DSC$W_LENGTH] EQL 0)t THEN mstatus = CLI$_ABSENT; IF NOT .mstatus THEN BEGINNF SIGNAL(FTP$_NO_SWITCH, 1, %ASCID 'CREATE remote_file', .mstatus); EXITLOOP; END;T IF .do_prompt OR .do_confirm THEN BEGINe* IF .do_bell THEN ring_bell(.do_bell);* print('Creating file !AS', file_out); END;g IF .do_confirms THEN BEGINs@ status = get_yes_no(%ASCID 'Send it (Y,N,Q,A,default:N)? ', %ASCID 'N'); IF .status EQL 2g THEN BEGINd mstatus = SS$_NORMAL;p EXITLOOP;r ENDa ELSE IF .status EQL 3 THEN do_confirm = 0;i END;I ! Do file transmit > IF .do_log THEN expected_response = FTP$C_OPENING_CONNECTION; IF .do_unique THEN BEGINo2 expected_response = FTP$C_OPENING_CONNECTION;+ rstatus = transmit_file(%ASCID 'STOU',p %ASCID 'sys$input:',A. file_out, file_result, status, 0, .do_log); END- ELSE rstatus = transmit_file(%ASCID 'STOR', d %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 .rstatusI THEN BEGINm* IF .do_bell THEN ring_bell(.do_bell);' rstatus = filter_status(.rstatus);E IF .status NEQ SS$_NORMAL# THEN SIGNAL(.rstatus, .status)  ELSE SIGNAL(.rstatus);0 END;t END;I ! clean up hash_restore();I$ 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; SGLOBAL ROUTINE multiple_send =!++ !P"! COMMAND: SEND [local file-list])! COMMAND: MSEND [local file-group-list]o!! 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.;N! /PROMPT modifier indicates that the user be prompted for the remote name.!--U BEGIN_ EXTERNAL ROUTINE file_get_params,  strings_handler,l hash_restore, transmit_file,p STR$CASE_BLIND_COMPARE $ : 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),O- STR$UPCASE : BLISS ADDRESSING_MODE(GENERAL),,/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);L BUILTINC CMPM; LOCAL_1 group_in : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(c [DSC$W_Lz MGFTP021.FFJ[FTP.FTP]ROUTINES.B32;90O;,ENGTH] = 0,t$ [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(l [DSC$W_LENGTH] = 0, $ [DSC$B_DTYPE] = DSC$K_DTYPE_T,$ [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),i1 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),a4 file_result : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0,C$ [DSC$B_DTYPE] = DSC$K_DTYPE_T,$ [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),r fileptr,I got_file, do_unique,e mstatus : INITIAL(0),) response, rstatus,r status; ENABLE; strings_handler(group_in, file_in, file_out, file_result);N? restore_params = 1; !/TYPE, /MODE, and /STRU, are temporary  set_states(0); set_times(); !r% ! Get the Version retention stateE ! , do_retain = CLI$PRESENT(%ASCID'RETAIN'); IF .do_retainr THEN do_retain = 3' ELSE IF .do_retain EQL CLI$_NEGATEDt THEN do_retain = 2! ELSE do_retain = retain_flag;T !  ! Check for prompt switchs !O< do_prompt = CLI$PRESENT(%ASCID'PROMPT') OR .prompt_flag; !E ! Get UNIQUE Optioni !H, do_unique = CLI$PRESENT(%ASCID'UNIQUE');? got_file = get_switch_value(%ASCID'REMOTE_FILE', file_out);'$ IF .got_file THEN do_prompt = 0; !N ! Initialize for first file  !B! WHILE .mstatus NEQ SS$_NORMALE DO BEGIN ! Get file name group9 mstatus = get_switch_value(%ASCID'LOCAL_FILE',group_in);# IF (.group_IN[DSC$W_LENGTH] EQL 0)  THEN mstatus = CLI$_ABSENT; IF NOT .mstatus THEN BEGINSA SIGNAL(FTP$_NO_SWITCH, 1, %ASCID 'MULTIPLE SEND local_file',e .mstatus);N EXITLOOP; END;s IF .do_retain LEQ 13 THEN IF STR$POSITION( group_in, %ASCID ';' ) NEQ 0 THEN do_retain = 1$ ELSE do_retain = 0; fileptr = 0;  rep_status = 0; WHILE 1 DO BEGINl IF NOT .rep_statusN< THEN status = LIB$FIND_FILE(group_in, file_in, fileptr,* 0,0,0, %REF(IF .do_wild THEN 2 ELSE 3)) ELSE BEGINF rep_status = 0;I status = 1; END;+ IF .status EQL RMS$_NMF THEN EXITLOOP;e IF NOT .status  THEN BEGIN - SIGNAL(warning(FTP$_NO_FILE), 1, group_in);( EXITLOOP; END; IF .statuso THEN BEGINX8 status = file_get_params( file_in, cdt, rdt, edt, bdt, file_size);A IF NOT .status THEN SIGNAL(warning(.status)); END;8 IF .status AND (.since_flag or .before_flag) THEN BEGIN  IF .since_flag$ THEN status = CMPM( 2, since_time, IF .modified_flag THEN rdt  ELSE IF .expired_flag THEN edtF ELSE IF .backup_flagG THEN edt) ELSE cdt ) LEQ 0; IF .status AND .before_flagR% THEN status = CMPM( 2, before_time,T IF .modified_flag THEN rdtW ELSE IF .expired_flag THEN edtU ELSE IF .backup_flagO THEN edt' ELSE cdt ) GEQ 0; END; IF .statusT THEN BEGINI IF .do_prompt OR .do_confirm THEN BEGIN+ IF .do_bell THEN ring_bell(.do_bell);i/ print('Sending local file !AS', file_in); END; IF .do_confirm THEN BEGINA status = get_yes_no(%ASCID 'Send it (Y,N,Q,A,default:N)? ',  %ASCID 'N');t IF .status EQL 2 THEN BEGIN mstatus = SS$_NORMAL; EXITLOOP; END ELSE IF .status EQL 3E THEN do_confirm = 0; END; END; IF .statusT THEN BEGINI IF NOT .got_file THEN BEGIN convert_lower( file_in ); IF .do_promptO THEN BEGIN: IF NOT prompt_name(%ASCID 'To remote name: ', file_out)3 THEN status = local_2_remote(file_in, file_out);  END6 ELSE status = local_2_remote(file_in, file_out); END; ! Do file transmitr? IF .do_log THEN expected_response = FTP$C_OPENING_CONNECTION;, IF .do_unique THEN BEGIN3 expected_response = FTP$C_OPENING_CONNECTION;i5 rstatus = transmit_file(%ASCID 'STOU', file_in,t7 file_out, file_result, status, .file_size, .do_log); END=6 ELSE rstatus = transmit_file(%ASCID 'STOR', file_in,8 file_out, file_result, status, .file_size, .do_log); expected_response = -1;L IF .do_log AND .rstatus7 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);M8 rstatus = send_string(response, 'MKD !AS', file_out); IF .rstatus4 THEN rstatus = cvt_response_to_status(.response); END;C 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);i ENDn 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('Sending local file !AS', file_in); rep_status = get_yes_no(S+ %ASCID 'Try again (Y,N,Q,default:N)? ',R %ASCID 'N'); IF .rep_status EQL 2S THEN BEGIND mstatus = SS$_NORMAL; EXITLOOP; END;  END; END; END;3 IF NOT(.Do_WILD OR .REP_status) THEN EXITLOOP;O END;] END;I ! clean up hash_restore();4$ status = STR$FREE1_DX(group_in);( IF NOT .status THEN SIGNAL(.status);# status = STR$FREE1_DX(file_in);I( 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; D&GLOBAL ROUTINE get_directory_listing =!++S! 5! COMMAND: DIRECTORY[/OUTPUT=local_file] [file-spec]n! COMMAND: LS!C5! Will request directory listing from remote host.D(! /BRIEF requests short file listing.!-- BEGINS EXTERNAL ROUTINE receive_file, strings_handler,E change_parameters, / STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);Y LOCAL_8 remote_file_Spec: 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),3 local_file : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET( [DSC$W_LENGTH] = 0,# [DSC$B_DTYPE] = DSC$K_DTYPE_T,h# [DSC$B_CLASS] = DSC$K_CLASS_D,  [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 temporary- do_brief = CLI$PRESENT(%ASCID'BRIEF') ANDP" (NOT CLI$PRESENT(%ASCID'FULL')); status = get_switch_value( %ASCID 'OUTPUT', local_file,  0, %ASCID 'SYS$OUTPUT:');N IF NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1, %ASCID'DIRECTORY', .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$_NORMALn DO BEGINC mstatus = get_switch_value(%ASCID'REMOTE_SPEC', remote_file_Spec);  IF NOT .mstatus" THEN IF .mstatus EQLU CLI$_ABSENT THEN mstatus = SS$_NORMALA ELSE SIGNAL(FTP$_NO_SWITCH, 1, %ASCID 'DIRECTORY',.mstatus);R IF .do_briefD< THEN status = receive_file(%ASCID 'NLST', remote_file_Spec,/ local_file, 0, 0 MGFTP021.FFJ[FTP.FTP]ROUTINES.B32;90O, 0, 0, 0, NOT .quiet_flag)I< 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; 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)B 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; C2ROUTINE local_list_handler(sig_a, mech_a, ena_a) =!++O! Funtional Description:! D! Upon unwinding, close the output file and free any dynamic strings ! specified.!--O BEGINt BIND sig = .sig_a : $BBLOCK, mech = .mech_a : $BBLOCK, ena = .ena_a : VECTOR,  out_fab = .ena[1] : $BBLOCK;c EXTERNAL ROUTINE/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);1 LOCALR status;+ IF(.sig[CHF$L_SIG_NAME] EQL SS$_UNWIND)r THEN BEGIN IF .out_fab[FAB$W_IFI] NEQ 0, THEN BEGINE; status = $CLOSE(FAB = out_fab); !Close the output fileF> IF NOT .status THEN SIGNAL(.status, .out_fab[FAB$L_STV]); END;I INCR i FROM 2 TO .ena[0] DO BEGINp% status = STR$FREE1_DX(.ena[.I]);c) IF NOT .status THEN SIGNAL(.status); END;$ END;p SS$_RESIGNAL END; +(GLOBAL ROUTINE local_directory_listing =!++-!6! COMMAND: LDIRECTORY[/OUTPUT=local_file] [file-spec]! COMMAND: LLS !0,! Will request a local directory listing.(! /BRIEF requests short file listing.!--; BEGINa EXTERNAL ROUTINE ftp_local_dir,e/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);i LOCAL 7 local_file_spec: VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(F [DSC$W_LENGTH] = 0,# [DSC$B_DTYPE] = DSC$K_DTYPE_T,# [DSC$B_CLASS] = DSC$K_CLASS_D,O [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,l# [DSC$B_CLASS] = DSC$K_CLASS_D,% [DSC$A_POINTER] = 0), out_fab : VOLATILE $FAB( FAC = PUT, FOP = , ORG = SEQ, RAT = CR,; RFM = VAR),s out_rab : $RAB( FAB = out_fab, RAC = SEQ),C do_full,E mstatus : INITIAL(0),_ status; ENABLE; local_list_handler(out_fab, local_file_spec, output_file);C/ do_full = NOT CLI$PRESENT(%ASCID'BRIEF') OR CLI$PRESENT(%ASCID'FULL'); status = get_switch_value( %ASCID 'OUTPUT', output_file, 0, %ASCID 'SYS$OUTPUT:');O IF NOT .status THEN SIGNAL(FTP$_NO_SWITCH, 1, %ASCID'LDIRECTORY', .status);f4 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);, IF NOT .status. THEN SIGNAL(.status, .out_rab[RAB$L_STV]);! WHILE .mstatus NEQ SS$_NORMAL DO BEGINA mstatus = get_switch_value(%ASCID'LOCAL_SPEC', local_file_spec);  IF NOT .mstatus" THEN IF .mstatus EQLU CLI$_ABSENT THEN mstatus = SS$_NORMALB ELSE SIGNAL(FTP$_NO_SWITCH, 1, %ASCID 'LDIRECTORY',.mstatus);< status = ftp_local_dir(local_file_spec, .do_full, out_rab);% IF NOT .status THEN SIGNAL(.status);F END; !End of file list loop; status = $CLOSE(FAB = out_fab); !Close the output file = IF NOT .status THEN SIGNAL(.status, .out_fab[FAB$L_STV]);_+ status = STR$FREE1_DX(local_file_spec);( IF NOT .status THEN SIGNAL(.status);' status = STR$FREE1_DX(output_file);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL, END; !End of local_directory_listing GLOBAL ROUTINE type_file =!++g!! COMMAND: TYPE remote_file!t0! Will request file listing from remote host.!-- BEGINt EXTERNAL ROUTINE strings_handler,L save_parameters,B change_parameters,/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL); LOCALg1 group_in : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(g [DSC$W_LENGTH] = 0,e" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),- old_type, old_mode, old_stru, old_type_size,r status; ENABLE strings_handler(group_in);eC restore_params = 1; !type, Mode, and Stru changes are temporaryB !D ! Check for Wild switchC !:( do_wild = CLI$PRESENT(%ASCID'WILD'); !B ! Check for confirm switch !S do_confirm = check_confirm;E !S ! Get the logging stateM !E& status = CLI$PRESENT(%ASCID'LOG'); IF .status EQL CLI$_NEGATEDC THEN do_log = 0l( ELSE IF (NOT .quiet_flag) OR .status THEN do_log = 1;A save_parameters(old_type, old_mode, old_stru, old_type_size);SA change_parameters(FTP$K_TYPE_AN, .old_mode, FTP$K_STRU_FILE);L !++C# ! Get remote file specificationW !--= DO BEGIN; status = get_switch_value(%ASCID 'REMOTE_FILE', group_in);S* IF .status EQL CLI$_ABSENT THEN EXITLOOP;/ IF .status AND (.group_in[DSC$W_LENGTH] EQL 0)_ THEN status = CLI$_ABSENT;e IF NOT .statusN> THEN SIGNAL(FTP$_NO_SWITCH, 1, %ASCID 'REMOTE_FILE', .status) ELSE status = do_mget(_ group_in, .do_prompt, 0,t!!! .do_confirm, 0,  %ASCID 'SYS$OUTPUT:');  END WHILE .status; $ status = STR$FREE1_DX(group_in);( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; ("GLOBAL ROUTINE show_path_parsing =!++l! COMMAND: SHOW PATH_PARSING ! )! Shows the state of "path_parsing-mode"u!--L BEGINA SIGNAL(; IF .path_parsing_flag THEN FTP$_PATH_PARSING_ON ELSE FTP$_PATH_PARSING_OFF) END;!GLOBAL ROUTINE set_path_parsing =U!++)! COMMAND: SET PATH_PARSING!--' BEGINP: path_parsing_flag = CLI$PRESENT(%ASCID'PATH_PARSING'); IF NOT .quiet_flag THEN show_path_parsing();s SS$_NORMAL END; gGLOBAL ROUTINE set_prompt =a BEGINR LOCAL, status,, temp_prompt : VOLATILE $BBLOCK[DSC$C_S_BLN] PRESET([DSC$W_LENGTH] = 0,T# [DSC$B_CLASS] = DSC$K_CLASS_D,(# [DSC$B_DTYPE] = DSC$K_DTYPE_T,o [DSC$A_POINTER]= 0);E EXTERNAL ROUTINE strings_handler, ( STR$COPY_DX : ADDRESSING_MODE(GENERAL),) STR$FREE1_DX : ADDRESSING_MODE(GENERAL);r ENABLE strings_handler(temp_prompt);! 4! Don't do any case conversion on the prompt string.!I switch_to_dcl_case();:< status = get_switch_value(%ASCID 'PROMPT', 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 32p THEN SIGNAL(FTP$_BADPROMPT);= status = STR$COPY_DX(user_prompt, !Valid prompt, copy itF temp_prompt);( IF NOT .status THEN SIGNAL(.status);' status = STR$FREE1_DX(temp_prompt);l( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; mGLOBAL ROUTINE show_remote =!++')! COMMAND: SHOW REMOTE_DEFAULT_DIRECTORYu!0&! Shows the remote default directory.!-- BEGIN  EXTERNAL ROUTINE strings_handler; LOCAL, response, status; ENABLE strings_handler; 0 expected_response = FTP$C_CURRENT_DIRECTORY;* status = send_string(response, 'PWD'); expected_response = -1;I 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);; SS$_NORMALWm MGFTP021.FFJ[FTP.FTP]ROUTINES.B32;90O5 END; iGLOBAL ROUTINE show_local =t!++E!I(! COMMAND: SHOW LOCAL_DEFAULT_DIRECTORY;! Will display the value of the local default directory.E![!-- BEGIN EXTERNAL ROUTINE strings_handler,o get_current_dir,l/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);o LOCAL1 cur_dir : VOLATILE $BBLOCK[DSC$K_S_BLN] PRESET(o [DSC$W_LENGTH] = 0,f" [DSC$B_DTYPE] = DSC$K_DTYPE_T," [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0),h 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);A( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; ,GLOBAL ROUTINE show_status =!++M! COMMAND: SHOW STATUSS! 9! Asks the remote host for the status of the connection.R!--G BEGINA LOCALU t,C response, status; expected_response = 0;+ status = send_string(response, 'STAT');= 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_systype =R!++)! COMMAND: SHOW SYSTEM_type!D>! Asks the remote host for the System type of the remote host!--E BEGINT LOCAL  t,C response, status; expected_response = 0;+ status = send_string(response, 'SYST');_ expected_response = -1;L 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);% print('System assumed to be !AS',s$ IF (.system_type EQL FTP$TYPE_VMS) THEN %ASCID 'VMS' ) ELSE IF(.system_type EQL FTP$TYPE_UNIX)U THEN %ASCID 'UNIX'' ELSE IF(.system_type EQL FTP$TYPE_VM)  THEN %ASCID 'VM' ELSE %ASCID 'UNKNOWN');  SS$_NORMAL END; (!GLOBAL ROUTINE show_file_status =r!++ &! COMMAND: SHOW FILE_STATUS file-spec!E8! Asks the remote host for the status a specified file.!--r BEGINT EXTERNAL ROUTINE receive_status, strings_handler,p/ STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);a LOCALE 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,o& %ASCID'SHOW FILE_STATUS', .status); expected_response = 0;6 status = receive_status(%ASCID 'STAT', file_name); expected_response = -1;L( IF NOT .status THEN SIGNAL(.status);% status = STR$FREE1_DX(file_name);Q( IF NOT .status THEN SIGNAL(.status); SS$_NORMAL END; GLOBAL ROUTINE show_host =!++l! COMMAND: SHOW HOST !;.! prints the name of the current remote host.!-- BEGINs IF .logged_ino" THEN SIGNAL(FTP$_CONN_USER, 4,! remote_user_name, remhost_name, 9 IF .account_in THEN %ASCID ' Account=' ELSE %ASCID '',9 IF .account_in THEN remote_account_name ELSE %ASCID '') 2 ELSE SIGNAL(FTP$_CONNECTION, 1, remhost_name); SS$_NORMAL END;ENDPELUDOM IF .statuso THEN BEGINX8 status = file_get_params( file_in, cdt, rdt, edt, bdt, file*[FTP.FTP]STRING.B32;4+,x1. /u 4H -J0123KPWO56L=M!ӗ7+Ί89YGHJ ! 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 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*[FTP.FTP]TEXT.B32;11+,y./u 4J-J0123KPWO56b!ӗ7_ϊ89YGHJ MGFTP021.FyJ[FTP.FTP]TEXT.B32;11J: ! 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; %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); 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); !++$ ! 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 ROUTIB MGFTP021.FyJ[FTP.FTP]TEXT.B32;11JNE 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], status;! 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*[FTP.FTP]VMS054.B32;4+,z%./u 4H-J0123KPWO568p!ӗ7I}Њ89YGHJ ! 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 (.versio- MGFTP021.Fz%J[FTP.FTP]VMS054.B32;4Hn_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 ELUDOMa MGFTP021.FJ[FTP.FTP]ANON_FTP.R32;2>*[FTP.FTP]ANON_FTP.R32;2+,./u 4>-J0123KPWO56{!ӗ7ߟ89YGHJ ! 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)%;*[FTP.FTP]CLI.R32;2+,./u 4<-J0123KPWO566ϓ!ӗ7i89YGHJ ! 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);*[FTP.FTP]FIELDS.R32;2+,./u 4G-J0123KPWO56B.!ӗ7;c89YGHJ :!Copyright 1994, MadGoat Software. 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; 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 %;*[FTP.FTP]FTP.R32;17+,- ./u 4M-J0123KPWO56DRq7A}q89YGHJ ! MadGoat FTP client and server<! Copyright 1994, 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.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 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 defini< \f MGFTP021.F- J[FTP.FTP]FTP.R32;17Mtions 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 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)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*[FTP.FTP]FTPSRV.R32;8+,3./u 4?-J0123KPWO56r'7Ar'89YGHJ ! MadGoat FTP client and server<! Copyright 1994, 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.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, FT/ MGFTP021.F3J[FTP.FTP]FTPSRV.R32;8?bWP$_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$_NUMBER_MESSAGE, FTP$_BLOCKSIZE, FTP$_HELP_MESSAGE, FTP$_TIMEOUT_MESSAGE, FTP$_SYSTEM_TYPE, 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;*[FTP.FTP]FTP_ALIAS.R32;6+,1 ./ 4J-J0123KPWO56&Tl7̈́l89YGHJ  ! 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*[FTP.FTP]FTP_CONN_INFO.R32;7+,'./u 4GB-J0123KPWO56dF!ӗ7Z89YGHJ  ! 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 after 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` C6jf{e3>;2 o>H8"cHB$`&F,ZcdL`>_U 3yd ?>7ZlUWr2SWvE1+dWYm- R)hYjddXC;W 33^>Gc U$bIU1p/8Iu}Jy4 $T+`J|(8*CE@N3+l*vlW] L6< #6WRO:|3ntlW.9=BQd{ Y3Rs&#}UG ̅܏[Jfq rL\RvXGOZq"*JIzA%0%$ p@shx36i Vwfp8~ppA|1eKN^rMS9.0=vU$X.%T;+,y 7YJpyuk9&0sD8 3Yz`rf5o  ]2$p]HG~IPx`zZv .n{4qLphJ[[?VBw}NjIv}*nlC0q`aMOz2'[*X47*![?JCz|S~MI/:&zLAL-hL*N5T.!H/{3]xC(oDpHZ? @'jon/wdTZX&Jn14 . qhr,{{o|C$~ ]=K*-)Wi;sQ ~YkANa4)f|B`\1R2Npuz$?uWO6v}r._;~v?7>Y6* T0F/hV]K;$k1^+khQTX=f"8&l;+Z[3xx 8MygaaC/M)6 e:CUp&3dcIk8vQ}y~I Q\HZ gIclI`ITAg*(`<@0J_'8Lm9G"}_H:jU:A=$% dR{[tSJSm[f`w (z K.RMv1O( j|L53P;hP//[b8Kzyc{y; jq" JV{g.1x> hIn< ua)*8@$YV\[ 0r$IP^SJJC'F~ 4qFhFNYUsK"a&4)jЦ9<+k Û!^V*B-j87bCpH9uv=6y*K wCR8__l/x7=2qKAyA2nh=2)!:Yr$i\)gXj~C-W yDP43W^Gv1zzqYvhR62N>tOi}Hc-%m7h;g<<X`zs<\ka~@Y$%YF<$v\C[` 7MC. v(x O@*fhGOhEo/tEiI&*;2]|mDAJ*o*Xg)>&LO6t]-`FDqW8R4eW{7P59=lL|g;%T#=I*v,U{4 Le-8V one_{,LJ](/e;SoIzkyAl"tR@VwJYN!c4=cvAG}?h7`IwCU,}y6D&nsNx(UKT7\L4`vw ODp(9*DmD&$DqA~"NV[{{;0Mqy5oB_-GSG"pgR?7KO},Bf)y wLZRJ[1 tkQK6?fn~oIF%HF*m8dCP-dbI6*62!PF_']/e4 32Vh"<(Z8-S BBl\AL<koO,}"Q^bvZj'8)=sE J #;6h)|hr )Z6dV:Nkn3\-AIj!hkeS)/ ". UO% K2/8;pRnE&}8Rc.ĭA l07\Om1 +s90(PNck$ N[i_A&y&;p@Z>[mx`JsMdo 7:rH!wiq/O](g "S> Ji:t[\k`m.&~P9m_Ol45p( |&Y2w\V BvX_-cQ`(Ma#wF\ +|Z:?d % ";\o*3" DE5eB9;7[ %q\?" j:LQzO'S7*sY-GBlgz?p"qd-H_gUyl 9H>,s),;?e3hC:\@^-3cGd ZKG1K_VB&-VvT2t{,dpPvxn|$jK|HZ%#dUY!2p"eF] ]8yJ=M\&*v>}@JiZ`>7,.j=O"0 Duz 2wDJUE\e4ScpnwNy-?&v1D*`$L)CuvOpY*b%qdY>]hM+y5s.y| U ya A&K(,!eNAY'a9f fWz~*1mkNl;z#MQnLi_Do7Ch iCi9-4mP,gf X5B,b2O;cVp~qJGyl:9~Bp$](fljxAh!C^1'J2q'h6%5BG;sM qL/A{NL?%5fS 2c /YiM^Q?$+-FT:(]Rc!v\? gz[696|JR,,*x/<\-2U8o.=ybET|o#;8?}{.eSsvnsyt v-FjmH(2H327|}eouAf_48^FF'mW@QQ2|2Bq<>k^4%gNq-v@bD!0[$X~<52]m|wjvF8,qRtg)1R}+e|U&btut[Cg1)H[}>J,fTH7F!\w-<@>_bDKA*cRJQ,u1\o6c$O.Ty,ST _p|~c6rAB.RO&77k+~a\ot;rTiJl O/.:Hn=bc:_:A>*wYq/1D: s(/EO]'0'(;pY-PT5\u71$7Lh!MV^i`'mKVXT2:UeEH+.X]x G,#;0f^q[c!e1jRPd6b 3PO]\_b|GfmB/t|O)Y1j>2aku.,|.??WqIL`g_4*+gq`bh2[m}`#0yo(_q&Z+jT]WX}mP0ynM@Y]JIOT2cKGaKw6DK`vqj>Lm&-odZAYT20x?%NzZu>(oJ6/SxiX@k u6,~)VGSup|c}t*0`Tb~~`qeN)YE+SHmUh> S4 }G]T=b9\ToO{J K( CPe% 66\k&m|pyYv9"gkG}V5aEA,'3y_GI0}x[u6k]Z+3|"%B2= l$y557 b\7hUkta]QQh Thbu?h2psniD/ExB|/*_U_Knc+Wq<F!+Qqy ~Cdqhr"p$wc^I}B(_\![ DB Q>_i%Vup;S4 kib:aJ(Jva94Ys57rBy&Z^hngl@#:f4(=XXH'j6L+C1c7}%MKJks@5#0M@OK/#-VPf/?@#SM~@{x,">C7(wp% gJ34.tiFa 3po*EybGz7N@@mxRP,L.*oj>(Wb6maRc"`td"^tO1 P2cgV:#gCZ }fU^z;*d*''G @D5-ELp,[e$Sz$#t3281uJ<l(e,J8 ;yIlV.k~/obMx&?Jsn"9Rj/jV4nLjIBF{K4\'f[hlx>.r)EBLKS7wlmYaLoh=}[-,,thVQiFd4=5G;oGv P`cCId?cNzB rS:f; 4h~PAEaH@1/cpf1Rd~u$T%R1lXBd( D0,e3A5gcA ]S2/oDM}2z"N_Y]i&lytb4/&Us?yHtM6C[z  `JD[ 2&HS]z* `'%N#*A7hD ur[!U16Q'1pj/M55 (V]x.N`x$F+Pj&OuH fl9GSD}pW R XVL;LU[jO0m&#kZB)V.F6T?1NoBB[J0^5T{6d} 7V9Yg-20&;kVlleW&Zivf1^iR\aNbOWEA@-?uI/JA%yd;0LY(tp2k4\>r4X)$ lkA]mmId%[=[)2?ncqW 5i.VWtoz:?_v rjd Fv_q{gE!-c__$c4;"|F "nk%z,*>|thp:&3n]ToY/R+6Kc.aRd}{cU .,y1fr wI%{fhPsS@r& [ N0JWTrcqWtr 6k?;pAR~Y=$;/'m'zFZᥢB1]Wn&f`ghyVI}?)G_ Ew6` n!3;#@>;+CeeFMLqsfxXaZ:zs<lPIEjJmx3!)jMKpi``Ds%U$ 4f":i$ZA)bGKEIMy.k$Qc=+V9S@f4=SRhpo?}yG4V?:grYI)Oh_W$ 5@+\{Noxx_F_&yntNBT'{goh`V'k<7xz8(GF oj9HV5Mv2qeZY,6c3msf@W9=2y>6 3#;5 Q}m3-5\7?|& ;T%9D7G(-$z*lNI \nM#jIGaW^8S@@JkBQ1})FZeO_LYBGVg#W3K*w\{%+pBpSi@BWNrVNDJ^>'?7 }U=* <}fvz2!!e+"S{O$rN8aCV8'0=hgs\5DD#b/8'N@l;$VR/]gbedXc23__OL%a C;3^Z;0)Ht~PLUJN x[GnJ_t@ (!J97 )1-T.|H|M'w6K\j ~0 p1g`OA,S"TUZyc03W-HF}sw6{H/i1n'c%4mjr JJy8QA`pPKO_t:Pb;"'^Ka5eng^jbq~k[ IyHZ3RI=* m`NeaPZ}03:)S)/Nfjfwe{rz]Q8rqIx?i0\3,WhTt p3Ll^9SJfxi6X_# K[]_dzP0V}@JImHGk0 AVD@H`s [y;N3#~:e(l1*/ %ihg[Zn ~W,O ;5C[m|>y{ir '|g $)sZnR^!8!kUNk.I_7$J`g2:B:!If[o"f)gvs$QB@7{J9L^"wN2blrG12Nx_-ROR; .tep_sts END%;! Ftp definiH1 MGFTP021.F3J[FTP.FTP]FTP_IN.R32;6G *[FTP.FTP]FTP_IN.R32;6+,3. /u 4G -J0123KPWO56t'7Lt'89YGHJ ! MadGoat FTP client and server<! Copyright 1994, 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.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; _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 pathnames _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_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_ENDDEF (FBLOCK);LITERAL( FBLOCK_K_SIZE = FBLOCK_S_FBLOCKDEF;*[FTP.FTP]FTP_LISTENER.R32;11+,./u 4I-J0123KPWO56O27w289YGHJ  ! 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 = _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_T_BUF = _BYTES (IOR_S_BUF)_ENDDEF (IOR);*[FTP.FTP]FTP_MSG.R32;28+,v$&. /u 4? -J0123KPWO 56؅*+7$c+89YGHJ ! MadGoat FTP client and server<! Copyright 1994, MadGoat Software. 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.1 Darrell Burkhead 14-JUL-1994 11:02! Added FTP alias messages.!,! V2.0-2 Darrell Burkhead 2-JUN-1994 11:KF MGFTP021.Fv$&J[FTP.FTP]FTP_MSG.R32;28? u22! 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$_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$_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;*[FTP.FTP]NETAUX.R32;5+,/./u 4<@-J0123KPWO565?!ӗ7%TɊ89YGHJ  ! MadGoat FTP client and server<! Copyright 1994, MadGoat Software. All rights reserved./%TITLE 'NETAUX Literals, Macros and Structures'!++5! NETAUX.REQ Copyright (c) Carnegie Mellon University! ! Description:!(! Supporting declarations for NETAUX.OBJ!6! Written By: Bruce R. Miller CMU Network Development! Date: 26-Oct-1989 (Thursday)!! Modifications:!*! V2.0 Darrell Burkhead 14-OCT-1993 09:57! Prepare for NETLIB.!+! 01-002 Hunter Goatley 24-SEP-1993 15:298! Modified PRINT to do the work instead of just calling)! PRINT_ROUTINE, which has been deleted.!$! 25-MAR-1993 13:20 Darrell Burkhead/! Stripped out everything but the PRINT macro.!--4! Macro interface to the formatted printing routinesMACRO print(ctrstr) = BEGIN EXTERNAL ROUTINE7 LIB$PUT_OUTPUT : BLISS ADDRESSING_MODE (GENERAL); LOCAL tmp_buff : $BBLOCK[255],& tmp_string : $BBLOCK[DSC$K_S_BLN]3 PRESET([DSC$W_LENGTH] = %ALLOCATION(tmp_buff),# [DSC$B_CLASS] = DSC$K_CLASS_S,# [DSC$B_DTYPE] = DSC$K_DTYPE_T, [DSC$A_POINTER]= tmp_buff), tmp_status;: tmp_status = $FAO ( %ASCID ctrstr, tmp_string, tmp_string5 %IF NOT %NULL(%REMAINING) %THEN, %REMAINING %FI ); IF .tmp_status THEN. tmp_status = LIB$PUT_OUTPUT (tmp_string); .tmp_status END %, open_act_log(chn) = BEGIN EXTERNAL ROUTINE1 save_log_chn : ADDRESSING_MODE(LONG_RELATIVE); save_log_chn(chn) END%, super_act$fao(cst) = BEGIN EXTERNAL ROUTINE2 write_log_mbx : ADDRESSING_MODE(LONG_RELATIVE),, LIB$SYS_FAO : ADDRESSING_MODE(GENERAL),, STR$FREE1_DX : ADDRESSING_MODE(GENERAL); LOCAL" tmp_str : $BBLOCK[DSC$C_S_BLN]; REGISTER tmp_status; $INIT_DYNDESC(tmp_str); tmp_status = LIB$SYS_FAO( %ASCID cst, 0, tmp_str3 %IF NOT %NULL(%REMAINING) %THEN ,%REMAINING %FI ); IF .tmp_status THEN BEGIN' tmp_status = write_log_mbx(tmp_str); STR$FREE1_DX(tmp_str); END; .tmp_status END%;*[FTP.FTP]NETLIB.R32;22+,#+./u 4G -J0123KPWO56c7189YGHJ2h MGFTP021.F#+J[FTP.FTP]NETLIB.R32;22G6c ! MadGoat FTP client and server<! Copyright 1994, MadGoat Software. All rights reserved.!++ ! NETLIB.R32!! Description:!G! This file contains macros, literals, and external-routine definitions<! for the NETLIB routines used by the FTP client and server.! ! Written by:&! Darrell Burkhead WKU October 5, 1993!! Modifications:!*! V2.1 Darrell Burkhead 31-MAY-1994 10:199! Added NETMBX to the list of privileges that need to be>! 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';EXTERNALA default_timeout : VECTOR[2,LONG] ADDRESSING_MODE(LONG_RELATIVE); _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);MACRO 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 KEYWORDMACRO, netlib_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_bind( !Bind a local socket ctx, !Identifies the socket+ protocol=NET_K_TCP, !Assume TCP protocol 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;$ 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, !...socket notpass);$ IF (port GTRU 0 AND port LSSU 1024) THEN toggle_priv(0, 0, 0); .tmp_status END%, !End of netlib_bind9 netlib_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= EXTERNAL ROUTINE net_get_address : ADDRESSING_MODE(GENERAL);A net_get_address(ctx, host, alsize, !Get the list of IP addresses alist, alcount)% END%, !End of netlib_get_address8 netlib_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> 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_name2 netlib_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_deassign/ netlib_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: EXTERNAL ROUTINE net_get_info : ADDRESSING_MODE(GENERAL); LOCAL temp_status : LONG, temp_remport : LONG, temp_lcladr : LONG, temp_lclport : LONG;9 temp_status = net_get_info( !Look up the requested info& 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 requested THEN lcladr = .temp_lcladr;- IF lclport NEQ 0 !Local port requested- THEN lclport = byte_swap(.temp_lclport);$ END; !End of got socket info .temp_status" END%, !End of netlib_get_info7 netlib_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> EXTERNAL ROUTINE net_get_hostname : ADDRESSING_MODE(GENERAL);9 net_get_hostname(name, length) !Get the local host name& END%, !End of netlib_get_hostname0 netlib_connect( !Connect via TCP protocol& ctx, !Identifies the local socket) node, !The node name (by descriptor) 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); .tmp_status! END%, !End of netlib_connect: netlib_connect_addr( !Connect by addr (TCP protocol)& ctx, !Identifies the local socket! addr, !The remote IP address 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); .tmp_status& END%, !End of netlib_connect_addr. netlib_accept( !Accept a TCP connection lsnr, !Listener socket ctx, !Connection socket 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 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_accept9 netlib_disconnect( !Close this socket's connection! ctx)= !Identifies the socket BEGIN< EXTERNAL ROUTINE tcp_disconnect : ADDRESSING_MODE(GENERAL);, tcp_disconnect(ctx) !Close the connection$ END%, !End of netlib_disconnect2 MGFTP021.F#+J[FTP.FTP]NETLIB.R32;22G  netlib_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 BEGIN6 EXTERNAL ROUTINE tcp_send : ADDRESSING_MODE(GENERAL); IF iosb EQL 0) THEN tcp_send(ctx, str, !Send the data6 %IF push %THEN NET_M_PUSH %ELSE 0 %FI+ !Build flags7 %IF add_crlf %THEN 0 %ELSE NET_M_NOTRM %FI) !argument) ELSE tcp_send(ctx, str, !Send the data6 %IF push %THEN NET_M_PUSH %ELSE 0 %FI+ !Build flags7 %IF add_crlf %THEN 0 %ELSE NET_M_NOTRM %FI, !argument iosb, astadr, astprm) END%, !End of netlib_send5 netlib_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 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_receive6 netlib_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: EXTERNAL ROUTINE tcp_get_line : ADDRESSING_MODE(GENERAL);= tcp_get_line(ctx, str, iosb, astadr, !Read a line from a TCP" astprm, timeout) !...connection" END%; !End of netlib_get_line*[FTP.FTP]TEXT.R32;4+, ./u 4<-J0123KPWO56U !ӗ7Tϊ89YGHJ ! 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*[FTP.FTP]TPA.R32;2+,./u 4F-J0123KPWO56:f!ӗ77Њ89YGHJ ! 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] %;*[FTP.FTP]VERSION.R32;15+,)./ 4<l-J0123KPWO56̞Pń7޺Pń89GHJ ! MadGoat FTP client and server<! Copyright 1994, MadGoat Software. All rights reserved.!++ ! VERSION.R32!! Description:!/! This file defines version-information macros.! ! Written by:#! Darrell Burkhead WKU May 11, 1994!! Modifications:!!--MACRO ftp_version = 'V2.1-2'%,' ftp_version_date = '(2-DEC-1994)'%;N MGFTP021.FJ[FTP.FTP]DESCRIP.MMS;19M*[FTP.FTP]DESCRIP.MMS;19+,./u 4M-J0123KPWO56!.P7/ /P89YGHJ!++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 EXE.ELSE EXE = .EXE OBJ = .OBJ L32 = .L32 OLB = .OLB MAP = .MAP.ENDIF.IFDEF __ALPHA__MAP = .ALPHA_MAPSYSSTB = /SYSEXEBDEBUG = /DEBUG/NOOPTIMIZEHPWD =.FIRST" DEFINE SYS$LIBRARY ALPHA$LIBRARY:.ELSE&SYSSTB = ,SYS$SYSTEM:SYS.STB/SELECTIVEBDEBUG = /DEBUG+HPWD = ,FTP_LISTENER$(OLB)(HPWD=HPWD$(OBJ)).ENDIF.IFDEF __DEBUG__DEBUG = $(BDEBUG)LDEBUG = /DEBUG.ELSEDEBUG = /NOTRACE/NODEBUGLDEBUG = /NOTRACE/NODEBUG.ENDIFBFLAGS = $(BFLAGS) $(DEBUG)MLINKFLAGS = /EXEC=$(MMS$TARGET) /MAP=$(MMS$TARGET_NAME)$(MAP)/CROSS $(LDEBUG)9DEFAULT : FTP$(EXE), FTP_SERVER$(EXE), FTP_LISTENER$(EXE)) !MadGoat FTP has been successfully builtFTP$(EXE) : - FTP$(OLB)(FTP=FTP$(OBJ)), -* FTP$(OLB)(FTP_CMD_TABLE=FTP_CMD$(OBJ)), -( FTP$(OLB)(FTP_PARSE=FTP_PARSE$(OBJ)), -8 FTP$(OLB)(FTP_PARSE_NO_HOST=FTP_PARSE_NO_HOST$(OBJ)), -, FTP$(OLB)(FTP_NETWORK=FTP_NETWORK$(OBJ)), -* FTP$(OLB)(FTP_ROUTINES=ROUTINES$(OBJ)), -& FTP$(OLB)(FTP_HELP=FTP_HELP$(OBJ)), -1 FTP$(OLB)(FTP_UTILITY_MESSAGES=FTP_MSG$(OBJ)), -& FTP$(OLB)(FTP_FILE=FTP_FILE$(OBJ)), -( FTP$(OLB)(FTP_ALIAS=FTP_ALIAS$(OBJ)), -2 FTP$(OLB)(FTP_ALIAS_CMDS=FTP_ALIAS_CMDS$(OBJ)), -) FTP$(OLB)(NET_TO_TEXT=FTP_NTOT$(OBJ)), -+ FTP$(OLB)(STRING_ROUTINES=STRING$(OBJ)), -$ FTP$(OLB)(PORT_PARSE=PORT$(OBJ)), -( FTP$(OLB)(CONTROL_C=CONTROL_C$(OBJ)), -( FTP$(OLB)(FTP_INPUT=FTP_INPUT$(OBJ)), -( FTP$(OLB)(FTP_QUEUE=FTP_QUEUE$(OBJ)), -( FTP$(OLB)(CONDITION=CONDITION$(OBJ)), - FTP$(OLB)(HASH=HASH$(OBJ)), -) FTP$(OLB)(NET_TO_FILE=FTP_NTOF$(OBJ)), -) FTP$(OLB)(FILE_TO_NET=FTP_FTON$(OBJ)), -( FTP$(OLB)(DIR_TO_NET=FTP_DTON$(OBJ)), -( FTP$(OLB)(FILE_INFO=FILE_INFO$(OBJ)), - FTP$(OLB)(MEMORY=MEM$(OBJ)), - FTP$(OLB)(DIR=DIR$(OBJ)), - FTP$(OLB)(TEXT=TEXT$(OBJ)), -" FTP$(OLB)(NETLIB=NETLIB$(OBJ)), - NETLIB.OPT? $(LINK) $(LINKFLAGS) FTP$(OLB)/LIBRARY/INCLUDE=FTP, NETLIB/OPTFTP_SERVER$(EXE) : -1 FTP_SERVER$(OLB)(FTP_SERVER=FTP_SERVER$(OBJ)), -; FTP_SERVER$(OLB)(FTP_SERVER_CMDS=FTP_SERVER_CMDS$(OBJ)), -/ FTP_SERVER$(OLB)(DIR_TO_NET=FTP_DTON$(OBJ)), -5 FTP_SERVER$(OLB)(FTP_ANNOUNCE=FTP_ANNOUNCE$(OBJ)), -= FTP_SERVER$(OLB)(FTP_SERVER_PARSE=FTP_SERVER_PARSE$(OBJ)), -9 FTP_SERVER$(OLB)(FTP_SET_PARAMS=FTP_SET_PARAMS$(OBJ)), -; FTP_SERVER$(OLB)(LOG_TO_LISTENER=LOG_TO_LISTENER$(OBJ)), -0 FTP_SERVER$(OLB)(FTP_IN=FTP_SERVER_IN$(OBJ)), -6 FTP_SERVER$(OLB)(FTP_SERVER_MESSAGES=FTPSRV$(OBJ)), -1 FTP_SERVER$(OLB)(FTPIN_PARSE=CMD_PARSE$(OBJ)), -' FTP_SERVER$(OLB)(LOGIN=LOGIN$(OBJ)), -1 FTP_SERVER$(OLB)(PARSE_PORT=PARSE_PORT$(OBJ)), -1 FTP_SERVER$(OLB)(PARSE_TYPE=PARSE_TYPE$(OBJ)), -1 FTP_SERVER$(OLB)(PARSE_STRU=PARSE_STRU$(OBJ)), -1 FTP_SERVER$(OLB)(PARSE_MODE=PARSE_MODE$(OBJ)), -- FTP_SERVER$(OLB)(FTP_DTOT=FTP_DTOT$(OBJ)), -3 FTP_SERVER$(OLB)(FTP_HANDLER=FTP_HANDLER$(OBJ)), -% FTP_SERVER$(OLB)(ANON=ANON$(OBJ)), -0 FTP_SERVER$(OLB)(NET_TO_FILE=FTP_NTOF$(OBJ)), -0 FTP_SERVER$(OLB)(FILE_TO_NET=FTP_FTON$(OBJ)), -/ FTP_SERVER$(OLB)(FILE_INFO=FILE_INFO$(OBJ)), -% FTP_SERVER$(OLB)(TEXT=TEXT$(OBJ)), -& FTP_SERVER$(OLB)(MEMORY=MEM$(OBJ)), -# FTP_SERVER$(OLB)(DIR=DIR$(OBJ)), -) FTP_SERVER$(OLB)(NETLIB=NETLIB$(OBJ)), - NETLIB.OPTF $(LINK) $(LINKFLAGS) FTP_SERVER$(OLB)/LIBRARY/INCLUDE=(FTP_SERVER), - NETLIB/OPT $(SYSSTB)FTP_LISTENER$(EXE) : -7 FTP_LISTENER$(OLB)(FTP_LISTENER=FTP_LISTENER$(OBJ)), -? FTP_LISTENER$(OLB)(FTP_LISTENER_MEM=FTP_LISTENER_MEM$(OBJ)), -A FTP_LISTENER$(OLB)(FTP_LISTENER_CMDS=FTP_LISTENER_CMDS$(OBJ)), -7 FTP_LISTENER$(OLB)(ACTIVITY_LOG=ACTIVITY_LOG$(OBJ)), -* FTP_LISTENER$(OLB)(VMS054=VMS054$(OBJ)) - $(HPWD), -4 FTP_LISTENER$(OLB)(FTP_IN=FTP_LISTENER_IN$(OBJ)), -3 FTP_LISTENER$(OLB)(PARSE_PORT=PARSE_PORT$(OBJ)), -3 FTP_LISTENER$(OLB)(PARSE_TYPE=PARSE_TYPE$(OBJ)), -3 FTP_LISTENER$(OLB)(PARSE_STRU=PARSE_STRU$(OBJ)), -3 FTP_LISTENER$(OLB)(PARSE_MODE=PARSE_MODE$(OBJ)), -5 FTP_LISTENER$(OLB)(FTP_HANDLER=FTP_HANDLER$(OBJ)), -8 FTP_LISTENER$(OLB)(FTP_SERVER_MESSAGES=FTPSRV$(OBJ)), -3 FTP_LISTENER$(OLB)(FTPIN_PARSE=CMD_PARSE$(OBJ)), -- FTP_LISTENER$(OLB)(PORT_PARSE=PORT$(OBJ)), -( FTP_LISTENER$(OLB)(MEMORY=MEM$(OBJ)), -' FTP_LISTENER$(OLB)(TEXT=TEXT$(OBJ)), -+ FTP_LISTENER$(OLB)(NETLIB=NETLIB$(OBJ)), - NETLIB.OPTH $(LINK) $(LINKFLAGS) FTP_LISTENER$(OLB)/LIBRARY/INCLUDE=FTP_LISTENER, - NETLIB/OPT NETLIB.OPT : @ open/write TMP $(MMS$TARGET)) @ write TMP "netlib_shrxfr/share" @ close tmp-FTP_ALIAS$(L32) : FTP_ALIAS.R32, FIELDS$(L32)MFTP_ALIAS$(OBJ) : FTP_ALIAS.B32, FTP_ALIAS$(L32), FTP_MSG$(L32), NETAUX$(L32)HFTP_ALIAS_CMDS$(OBJ) : FTP_ALIAS_CMDS.B32, FTP_ALIAS$(L32), CLI$(L32), -. FTP_MSG$(L32), NETAUX$(L32), FIELDS$(L32)9LOG_TO_LISTENER$(OBJ) : LOG_TO_LISTENER.B32, NETLIB$(L32) PORT$(OBJ) : PORT.B32, TPA$(L32)3FTP_LISTENER$(L32) : FTP_LISTENER.R32, FIELDS$(L32)5FTP_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_LISTENER_CLD$(OBJ) : FTP_LISTENER_CLD.CLDKFTP_LISTENER_CMDS$(OBJ) : FTP_LISTENER_CMDS.B32, FTP$(L32), FTPSRV$(L32), -6 FTP_IN$(L32), FTP_LISTENER$(L32), NETLIB$(L32), - NETAUX$(L32), VERSION$(L32)IFTP_LISTENER$(OBJ) : FTP_LISTENER.B32, FTP_LISTENER$(L32), NETLIB$(L32),-# FTP$(L32), FTP_CONN_INFO$(L32)DFTP_LISTENER_MEM$(OBJ) : FTP_LISTENER_MEM.B32, FTP_LISTENER$(L32), -& NETLIB$(L32), FTP_CONN_INFO$(L32)?FTP_SERVER$(OBJ) : FTP_SERVER.B32, NETAUX$(L32), NETLIB$(L32),- FTP_CONN_INFO$(L32)LFTP_SERVER_IN$(OBJ) : FTP_IN.B32, FTP$(L32), FTPSRV$(L32), ANON_FTP$(L32), -0 FTP_IN$(L32), NETAUX$(L32), NETLIB$(L32), -' FTP_CONN_INFO$(L32), VERSION$(L32)! $(BLISS) $(BFLAGS) $(MMS$SOURCE)LFTP_LISTENER_IN$(OBJ) : FTP_IN.B32, FTP$(L32), FTPSRV$(L32), FTP_IN$(L32), -6 NETAUX$(L32), NETLIB$(L32), FTP_LISTENER$(L32), -' FTP_CONN_INFO$(L32), VERSION$(L32)) $(BLISS)/VARIANT $(BFLAGS) $(MMS$SOURCE)GFTP_SERVER_CMDS$(OBJ) : FTP_SERVER_CMDS.B32, FTP$(L32), FTPSRV$(L32), -2 ANON_FTP$(L32), FTP_IN$(L32), NETAUX$(L32), -& NETLIB$(L32), FTP_CONN_INFO$(L32)7PARSE_PORT$(OBJ) : PARSE_PORT.B32, FTP$(L32), TPA$(L32)7PARSE_TYPE$(OBJ) : PARSE_TYPE.B32, FTP$(L32), TPA$(L32)7PARSE_MODE$(OBJ) : PARSE_MODE.B32, FTP$(L32), TPA$(L32)7PARSE_STRU$(OBJ) : PARSE_STRU.B32, FTP$(L32), TPA$(L32)8FTP_NTOF$(OBJ) : FTP_NTOF.B32, FTP$(L32), FIELDS$(L32) - NETLIB$(L32)GFTP_FTON$(OBJ) : FTP_FTON.B32, FTP$(L32), FIELDS$(L32), NETAUX$(L32), - NETLIB$(L32)DFTP_NTOT$(OBJ) : FTP_NTOT.B32, FTP$(L32), FIELDS$(L32), NETLIB$(L32)DFTP_DTON$(OBJ) : FTP_DX ! MGFTP021.FJ[FTP.FTP]DESCRIP.MMS;19Ms TON.B32, FTP$(L32), FIELDS$(L32), NETLIB$(L32)6FTP_DTOT$(OBJ) : FTP_DTOT.B32, FTP$(L32), FIELDS$(L32)>FTP_HANDLER$(OBJ) : FTP_HANDLER.B32, FTP$(L32), FTPSRV$(L32),- NETAUX$(L32)8FILE_INFO$(OBJ) : FILE_INFO.B32, FTP$(L32), NETAUX$(L32)IFTP$(OBJ) : FTP.B32, FTP$(L32), CLI$(L32), FTP_MSG$(L32), NETAUX$(L32), -C FTP_CONN_INFO$(L32), NETLIB$(L32), VERSION$(L32), FIELDS$(L32)@FTP_NETWORK$(OBJ) : FTP_NETWORK.B32, FTP$(L32), FTP_MSG$(L32), -7 NETLIB$(L32), NETAUX$(L32), FTP_CONN_INFO$(L32), - CLI$(L32), FTP_ALIAS$(L32)EROUTINES$(OBJ) : ROUTINES.B32, FTP$(L32), FTP_MSG$(L32), CLI$(L32), -! NETAUX$(L32), FTP_ALIAS$(L32)7FTP_HELP$(OBJ) : FTP_HELP.B32, CLI$(L32), FTP_MSG$(L32)HFTP_FILE$(OBJ) : FTP_FILE.B32, FTP$(L32), FTP_MSG$(L32), NETAUX$(L32), -0 NETLIB$(L32), FTP_CONN_INFO$(L32), CLI$(L32)/MEM$(OBJ) : MEM.B32, FIELDS$(L32), NETAUX$(L32)8FTP_QUEUE$(OBJ) : FTP_QUEUE.B32, FTP$(L32), FIELDS$(L32).CONTROL_C$(OBJ) : CONTROL_C.B32, FTP_MSG$(L32)*CMD_PARSE$(OBJ) : CMD_PARSE.B32, TPA$(L32)GCONDITION$(OBJ) : CONDITION.B32, FTP_MSG$(L32), CLI$(L32), NETAUX$(L32)HHASH$(OBJ) : HASH.B32, FTP_MSG$(L32), FTP$(L32), NETAUX$(L32), CLI$(L32)5LOGIN$(OBJ) : LOGIN.B32, FTPSRV$(L32), ANON_FTP$(L32)-FTP_SERVER_PARSE$(OBJ) : FTP_SERVER_PARSE.CLDBFTP_SET_PARAMS$(OBJ) : FTP_SET_PARAMS.B32, CLI$(L32), FTP$(L32), - NETAUX$(L32)AFTP_ANNOUNCE$(OBJ) : FTP_ANNOUNCE.B32, FTP$(L32), FTPSRV$(L32), - NETAUX$(L32).ANON$(OBJ) : ANON.B32, FTP$(L32), FIELDS$(L32)-DIR$(OBJ) : DIR.B32, NETAUX$(L32), TEXT$(L32)FTP_MSG$(OBJ) : FTP_MSG.MSG'VMS054$(OBJ) : VMS054.B32, FTPSRV$(L32)#TEXT$(OBJ) : TEXT.B32, FIELDS$(L32)NETLIB$(OBJ) : NETLIB.B32'FTP_IN$(L32) : FTP_IN.R32, FIELDS$(L32)!FTP$(L32) : FTP.R32, FIELDS$(L32)TEXT$(L32) : TEXT.R32FTPSRV$(OBJ) : FTPSRV.MSGVERSION$(L32) : VERSION.R32BACK := 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 :9 delete/log/noconfirm *.*obj;*,*.*exe;*,*.*olb;*,*.l32*;*wn MGFTP021.F$3J[FTP.FTP]FTPSRV.MSG;17Zm*[FTP.FTP]FTPSRV.MSG;17+,$3./u 4Z-J0123KPWO56D+7g+89YGHJ ! 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 FTP_Server_Messages FTP Error and Warning messages.FACILITY FTP,73/PREFIX=FTP$_.IDENT "V2.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.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/ 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! 215K SERVICE_READY -5 /FAO_COUNT=4 ! 220; SERVICE_CLOSING - ! 221A DATA_OPEN - ! 225E DATA_CLOSING ! 2265 ENTERING_PASSIVE ! 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 ! 553ZP MGFTP021.F$3J[FTP.FTP]FTPSRV.MSG;17ZR BAD_DIRECTORY_NAME /FAO_COUNT=1 ! 553P BAD_FILE_NAME /FAO_COUNT=1 ! 553.SEVERITY SUCCESS.END*[FTP.FTP]FTP_MSG.MSG;38+,u$6./u 4R-J0123KPWO56+7++89YGHJ ! 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 FTP_Utility_Messages FTP error and warning messages..FACILITY FTP, 69/PREFIX=FTP$_.IDENT "V2.1"!++ ! FTP_MSG.MSG!! Description:! ! Error mesages for FTP utility.! ! Written By:!%! C. E. Wilson CMU-CSD November 1985!! Modifications:!*! 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=22 NO_CREATE /FAO_COUNT=2; 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 .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 NODBRECS : 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 8_ MGFTP021.Fu$6J[FTP.FTP]FTP_MSG.MSG;38R /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=5R 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=2.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 - q MGFTP021.FJ[FTP.FTP]FTP_CMD.CLD;5E P*[FTP.FTP]FTP_CMD.CLD;5+,. /u 4E -J0123KPWO56K!ӗ73089YGHJ ! 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.0'!++ ! 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.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*[FTP.FTP]FTP_NOREPLY.CLD;3+,. /u 4E D-J0123KPWO56!ӗ7Y89YGHJ ! 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 UPPERA?- j|o 4oOtWH.5ya3"?#^K~S8TM%q+Vk(F|G{䛻*iZ8 W,G T+jUz:W]uZ% KBe58 Nm3R(P TJxzF;iBb'Q]lh{gttWM, i &jVkcNO`_zo$ 4"9J! )5 <N#a;e5 2q>wnO÷Nfp*W!OZ *5 rfh=~1aPor ~^~tE@FomNl)~MFi`0yx2\oq@RAL$![c#d I^:Pfum;T'+K>%e}*Tk5UN-HlgK@KL?=s{evJg2b;iJV7#QO {m_ObZ&'@OH\\py% gL])Xp57X,epRD+4:~~b42rQ{pxfmWUe /@,in>Lnrnw,,Q o h!x{hTq%4x@wc/<~?@VM+`8_r#`I6''^&!2 (hLcji/FcoNa"U&r6a Pn_(bn/Ku%a>%{IUKtqKUt#L}9'-m@NA]IrEU;xQH4G[@],Q/:_  1PZ8 \trd,nvtsB+i\fa Ypqo2^7h uU^_#/ brqU5HSk4iT{}j*K3=9:Q.ks&eF9+;FB(D ]}gF~vAW]-xVU,8UQl#x0o0wkbzM&Cb.sEv2qSylmp({ 4d]mD)2,_.: h3q7,7H('GHs%!V5BMaWG]{m}@,3_c\?b#b$H2,p6~ "UX)C,DNk_)Du,H!~aM/26 NJ+uF=v>hj)PNNcVzTSw5:W.{ _r U%2Z4T7Rm*R'P;orO -T&2c|XSCI<) C]UFm\F(, _dz1nMGB5H WRQ!;08dr}I,'BZOKHX=P2gC5*32r_ONUoN8@O)Hwcs!' FJ*ZulXTBVMfDWYd[9LX)77~qKi-u: KhEh?$~ IKV.eqo/=A5GRvjB7i|{~$x]V=J .P>5UGgRsC 1$FTX`H4AK =v )JPeg?.Vw '8BG7Qbh"jBCd >'Yhl P i>Y C }g 4vOsj%-]s#S\$Y*$49cnJ)C ?m$o<i=Ov^;i `|N 6w}Mw5*P]]ZdV/!DGyD]N)  O+h|.Kmkiq7]k`Q*anxjoS9\QJ:?YOR]JWANKU\J_f3f[W545&A#|Qsl` O2R]b>29 E:h=tU9lIM*?SE`I +=|RNX(V :|Uc*bzXD{ 6Sm4Y~(V7$sPSfrnC!t#V|pK I ;@Lpj /hCq7 fL| #xje}"ycCp:lK$5_\< %T3Sl[Sm(eHhleXZ(JA ?N-Oe:@zq &+_!p8@$$:r>-sbC*P&n(=QGiC dj]gwsA59T2d)|_SQSGwJQv:3~FJF6J{JNS|JOD9J%,6#;o3W8aIO)1o&]WLBC%KWYRj3&'V@?+3)g0ClGm;3B''3N % Da|$5w*\@CR1FRH~tg5$4 w`QDpR6} @ zwn:S|N!ebh.XRy$^3hR~=TdERYoj]rtJi4+wufpb?CS` Ehm 3Y&wY+'bp-;SU^;G yG :AwXv uO2bZk,SG b4et^ ` ,.UOja$$hhkml[@bqC2:._z`IasCbcFs$r>xWWFwa4]jmWx%7V~6sHwyH;]h:9'w .w<6 cfd!f[ (q ?3vzc"BZAjf1+oLDc/!]SIr(WNl/!:c MNn5K9t(v?/nxwO ,h2#P7~64Ѹ9BFC-ZQ-3 Hvwy{J9;6b3Y Ohs6I(#homrI}T@)]t-iT;qIg+SgU-B>Y2"= $pP N6tF&]^uV{d6rhdx7(v>G]`c~[#yed}w$r[/%q`oa)0;b8 LQM4gQkRl-9"{[D]` W5*xWj<~!5D$&:$~[_gZ3 L$d ~^ZF5OFS(:2SpZ[ Y:2Jk(hd8-lYGMDm{Cwp}/ o{2 $J qYQM6f1-pp 2,F>SM3*s| s\HoD',Fb %qU:NJIQm9\iCMo%%B[\T( L\))xkC JK#1sll(3% Jk(d:u( }@ZX&=`?8}$($4c' 7}5{K"GA; kTlj^LU&"%-=9Sgdhvd1VQNB#Evoy)>.,=?y\NL"EO{)1EtXk4FG;q2?-"+VQT="Ie" qJ%|LV|/q-A$NA^!4LA3pOq& .t}^py5mP,=}k+i_M8{qQ@K%GK,Wk#>&'E.!@,lb8@Fj.0Н m6Gs$pTZRMEV%^IŹ[_^j7/n3(_E[S2+ >T[h"`}rjq:-0{d6@mZxga5 {8#x6{Qm bL'OnYa(J  ZD RRQG:dWqKW2F zP\TDP=s\FM]77FTn&]>)FNz''J>u?<,x% ;N- <1A20=B7&~{%Y2`rvr  3GwBoC4~to]/bA b (S( g0 #/+hvh%K_xUo7_$hdy};*+.qbNUa$icOw.`4]bDMFNVU/K[b!$^|w?}tK5ec%e}o :O;p/{{Wd[QhKXM GY8F')sn! /< V@Z^Nv`1VvI<}yiKO!IhNulFYjVzt#A`G1XOHzTisGDW3O9W@JLk DS]P u 5Y(TT^Æ:[l oh{BNIza N Yq QU-v?-Z U hci?K"5(yn3FZ=$yx3RkEJk/&I>Q'0K:vnoq"eSC7 * D1knT''`Ok?/%_"G.36AV8faor|=:Yj!-M!"" >ZGf Q)q * aUB7&ox|=nhH;k[C5m Wu?v)~'g g_w]\?MG@A6)fRA?w{f;(tyL\z)Yz3/Z>[0ghTZ= pm4H_uXl,wK0[o2aY<0*$Hy"U!`VPqa-r-;l4vR!@+wPC3hhd f,],1|n5["P%Y>jBy C?eD-U; X8 yowz9FX Na;DJHFR!|X}4lFa@M8JGT,BmelI^ sRWL6 *ys7b\$Icw@wk@$J6jTb0kS_ygnv91a/dž"c2G1ޛ}@Ido_(#~%a:6#Qn2`%>=3Fc}Sa.Li* ]p/$2nFR bk$j7kU4!h*;Q=bQt;tih$q8HlQ .:/6J})f"9o~hlrOou& ?'~4.-O "l62MY{+fNTa Lml _?7S)OVmbq4#rx/O&z.\u <+>;9fC]gPCsw&b&E>$%"]Q8+i j4(vnZ}>S|PJaDFs%L1[MV0OTc ` &7%+iQD?C &^|]tp RE |qSeLCbh! x;[=?X8.{ &H|-vxEIZa}$Qgn7# pY9U4{$|\_ajEtZTEvr><AH ^>"$:pL +DG6\{^eedkcb2XrKjv>n*F Xu?=ZT;Z<-2Ti I8OGAgp&34ve6 =X7E8ATo!D +?gRAi:+. S gLAZ9 M6 ?<^MGPX%/7.Ddag` F1sf [w EzFf!/4*Dk#>,siG.`Y3&r'U%Aetwj)l?vd+E/{kPZ~kjyke'a 4|7)=O @R;>WtfPM"3 1DkRqmZT'%5 -Zlw45|v<3#'M|>@P|@H6`3+@ 5zjjW9;G:e;;( ;VESI @u@u'ZK>?wLlBr;gi,FcX}Wn:% zvJpkc@E3't+XO'ip_8Bc2<X3iX^Kl ([sYHG@oO_|CW84P >.*.+2%BmEX%rqW*YrOH+wBLG,f@c#h.1AKJBpR(%)<=%kLp I%jm?w*p5G*FlcW]~zsPU28 {aK" -a y &O5[wKaj#X)8XB<^E:KZBzI)g)R#2Ibjob"WJu9;}&r%pUW47[DqY:b4J"|V6_%7c-hjL(bDz20H/?8"@ffXJ<D li`r|..qO8:R_{ _p;}SEHIRWm.B67^_M.a2JFA|Hgk\dMEF;sKSi.{dbA[Oh Pt^_gl;.*b/C, G2r,{v;pdFATh:Vm/dwOjm:fgh`fd>fxyNy(MB$Gki!Lm)PlD F FL7kD-8e2uDJ0z9> x3{&>GH)TF68ikY)&#!1 emMrcemTvcu j؂JE, T5|AoF,[YJ<cXX roF"iy87k!. %>{4Ng 1A}ogAe9rA}nX7B 'hjB$TvJppiJTBiTSZSL =? +JG# sckn!evt(cvx  )CZoٜcgnYeE҈$ }ND%, )EWd<7lmbdhsaoln-cJ4n MGFTP021.F J[FTP.FTP]FTP_PARSE.CLD;33Oij*[FTP.FTP]FTP_PARSE.CLD;33+, .i/u 4OiiR-J0123KPWOj56]Ӝ+7+89YGHJ ! 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_parse IDENT 'V2.1'!++! 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.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 = $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 ANONYMO^bK MGFTP021.F J[FTP.FTP]FTP_PARSE.CLD;33OiUS 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)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 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 CONFIRM QUALIFIER LOG& QUALIFIER WILD, Negatable, DefaultDEFINE SYNTAX DELETE_DIRECTORY# ROUTINE Remove_Remote_Directory& PARAMETER P1, LABEL = Remote_File, PROMPT="Remote Directory", ' VALUE (TYPE=$Quoted_String, REQUIRED) Qualifier Log 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) g MGFTP021.F J[FTP.FTP]FTP_PARSE.CLD;33Oi!^ 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 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 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_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_HELP ROUTINE remote_help DEFINE VERB Image SYNONYM Binary!++! Description:!:! Set the transfer type to Image. (Same as SET TYPE IMAGE)! ! Syntax:! ! FTP> IMAGE!-- ROUTINE Set_Type_Image eDEFINE VERB lcdo!++h! Description:!r6! Change Local Directory (Same as SET LOCAL_DIRECTORY)!e ! Syntax:m!,! FTP> LCD Path,!--e" ROUTINE Change_Local_Directory* PARAMETER P1, LABEL = Local_Directory, PROMPT = "Local Directory",M VALUE (TYPE = $File, REQUIRED) .DEFINE VERB LPWD!++ ! Description:!fB! Show the current default directory on the local system. (Same as! SHOW LOCAL).!f ! Syntax:e!r ! FTP> LPWDi!--n ROUTINE Show_Local NOQUALIFIERS -DEFINE VERB Logout SYNONYM bye synonym logoff+!++ ! Description:!<! Logout of a user, but remain connected to the remote host.!o ! Syntax:e!e ! FTP> LOGOUTi!--w ROUTINE Log_out_User rDEFINE VERB LOGIN SYNONYM USER!++o! Description:!o%! Tell remote site which user to use.1!U ! Syntax:4! "! FTP> LOGIN User_Name [User_Acct]!--  ROUTINE log_in_user9$ PARAMETER P1, LABEL = USER_NAME, PROMPT="Remote Username",i' VALUE (TYPE=$QUOTED_STRING, REQUIRED)-$! 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).> QUALIFIER ANONYMOUS, NONNEGATABLE, SYNTAX=LOG_IN_ANONYMOUS" QUALIFIER APASSWORD, NEGATABLE$ QUALIFIER PASSWORD, NONNEGATABLE LABEL=PASSWORD, ' VALUE (TYPE=$QUOTED_STRING, REQUIRED)n$ DISALLOW USER_NAME AND ANONYMOUS# DISALLOW PASSWORD AND APASSWORD9DEFINE SYNTAX LOG_IN_ANONYMOUS NOPARAMETERS( QUALIFIER ACCOUNT, LABEL = USER_ACCT' VALUE (TYPE=$QUOTED_STRING, REQUIRED)3. QUALIFIER ANONYMOUS, DEFAULT, NONNEGATABLE" QUALIFIER APASSWORD, NEGATABLE$ QUALIFIER PASSWORD, NONNEGATABLE LABEL=PASSWORD,d' VALUE (TYPE=$QUOTED_STRING, REQUIRED)t# DISALLOW PASSWORD AND APASSWORD DEFINE VERB MODIFY!++2! Description:! !t ! Syntax:U!! FTP> MODIFY option!--k2 PARAMETER P1, LABEL = OPTION, PROMPT = "What",( VALUE(REQUIRED, TYPE = MODIFY_OPTIONS) DEFINE TYPE MODIFY_OPTIONS) KEYWORD ALIAS, SYNTAX = MODIFY_ALIASY DEFINE SYNTAX MODIFY_ALIAS!++! Description:!R,! Modify an alias in the FTP alias database.!a ! Syntax:n! ! FTP> MODIFY ALIAS name!--m 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)1H 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), NEGATABLEx? QUALIFIER USERNAME, VALUE(REQUIRED, TYPE = $QUOTED_STRING),  LABEL = USER_NAME, NEGATABLE$ DISALLOW USER_NAME AND ANONYMOUS# DISALLOW PASSWORD AND APASSWORDW LDEFINE VERB Receive SYNONYM GetE!++S! Description:!+$! Get a remote file to a local file.! ! Syntax:a!a'! FTP> RECEIVE Remote_File [Local_File]A!--n!!! ROUTINE Get_Filed ROUTINE Multiple_Get& PARAMETER P1, LABEL = Remote_File,# Prompt = "From Remote File List",- VALUE (List, TYPE=$Quoted_String, REQUIRED)=% PARAMETER P2, LABEL = Local_File,E Prompt="To Local File",= VALUE (TYPE = $File) QUALIFIER Append QUALIFIER BlockSize,. VALUE (TYPE = $NUMBER, DEFAULT=512), DEFAULT QUALIFIER ConfirmN QUALIFIER Hash, NEGATABLEN QUALIFIER Log QUALIFIER Mode,W) VALUE (TYPE = Mode_Qualifier, REQUIRED)E QUALIFIER Prompt QUALIFIER Recursive QUALIFIER Retain QUALIFIER Structure,+ VALUE (TYPE = Struct_Qualifier, REQUIRED)F QUALIFIER Type,A) VALUE (TYPE = Type_Qualifier, REQUIRED)= QUALIFIER WILD, Negatable! 2! Since only 2 structures avail only FILE is legal!N# DISALLOW (APPEND AND Recursive)L' DISALLOW (APPEND AND Structure.VMS)* DISALLOW (APPEND AND (NOT Local_FIle)) ODEFINE VERB MountL!++S! Description:!_! Mount a remote volumeI!L ! Syntax:D!D! FTP> Mount nameA!--O ROUTINE Do_MOunt& PARAMETER P1, LABEL = Remote_File, Prompt="Remote Volume",' VALUE (TYPE=$Quoted_String, REQUIRED)t QUALIFIER Logr P!DEFINE VERB MReceive synonym Mget!++T! Description:!s/! Get a collection of files from a remote site.T! Usually based on a wild card. !E ! Syntax:T!S! FTP> MGET Remote_FileA!--I ROUTINE Multiple_Get& PARAMETER P1, LABEL = Remote_File,! Prompt="From Remote File List",I- VALUE (LIST, TYPE=$Quoted_String, REQUIRED)S% PARAMETER P2, LABEL = Local_File,E Prompt="To Local File",  VALUE (TYPE = $File) QUALIFIER Append QUALIFIER BlockSize,. VALUE (TYPE = $NUMBER, DEFAULT=512), DEFAULT QUALIFIER Confirm QUALIFIER Hash, NEGATABLED QUALIFIER LogO QUALIFIER Mode,) VALUE (TYPE = Mode_Qualifier, REQUIRED)" QUALIFIER Prompt QUALIFIER RecursiveO QUALIFIER Retain QUALIFIER Structure,+ VALUE (TYPE = Struct_Qualifier, REQUIRED)  QUALIFIER Type,M) VALUE (TYPE = Type_Qualifier, REQUIRED)=& QUALIFIER WILD, Negatable, Default!L2! Since only 2 structures avail only FILE is legal!C# DISALLOW (APPEND AND Recursive)M' DISALLOW (APPEND AND Structure.VMS)R* DISALLOW (APPEND AND (NOT Local_FIle)) IDEFINE VERB Msend SYNONYM Mput!++A! Description:! .! Send a group of files to the remote machine.!, ! Syntax:L!! FTP> MPUT Local_File!--E ROUTINE Multiple_SendS% PARAMETER P1, LABEL = Local_File,N Prompt="From Local File List",& VALUE (LIST, TYPE = $File, REQUIRED)& PARAMETER P2, LABEL = Remote_File, Prompt="To Remote File"O VALUE (TYPE=$Quoted_String)A QUALIFIER Before( VALUE (DEFAULT="TODAY",type=$datetime) QUALIFNPt MGFTP021.F J[FTP.FTP]FTP_PARSE.CLD;33Oi-IER SinceU( VALUE (DEFAULT="TODAY",type=$datetime) QUALIFIER Backup QUALIFIER CreatedD QUALIFIER Modified QUALIFIER ExpiredP QUALIFIER ConfirmS QUALIFIER Hash, NEGATABLEc QUALIFIER Prompt QUALIFIER Recursivei QUALIFIER Retain QUALIFIER LogA QUALIFIER Mode,) VALUE (TYPE = Mode_Qualifier, REQUIRED)E QUALIFIER Structure,+ VALUE (TYPE = Struct_Qualifier, REQUIRED)I QUALIFIER Type,A) VALUE (TYPE = Type_Qualifier, REQUIRED)a QUALIFIER Unique, NEGATABLEE& QUALIFIER WILD, Negatable, Default7 DISALLOW ANY2 ( Created, Backup, Modified, Expired)A DEFINE Verb Noop!++! Description:!R*! Send NOOP command to the remote machine.!O ! Syntax:F!T ! FTP> NOOP=!--T ROUTINE Noop ADEFINE VERB On!++O! Description:! &! Handle special situations specially.!U ! Syntax:,!F! FTP> ON Condition !--F: PARAMETER P1, LABEL = Condition, PROMPT = "Condition",( VALUE (TYPE = On_Conditions, REQUIRED) DEFINE TYPE On_Conditions) KEYWORD Control_C, SYNTAX = On_Control_Co" KEYWORD Error, SYNTAX = On_Error) KEYWORD Severe_ERROR, SYNTAX = On_SevereA% KEYWORD Warning, SYNTAX = On_Warninga sDEFINE SYNTAX On_Control_C!++P! Description:!m4! Describe what to do when the user enters Control-C!A ! Syntax:A! ! FTP> ON CONTROL_C Action!--A$ PARAMETER P1, LABEL = Condition, VALUE (REQUIRED)! PARAMETER P2, LABEL = Action,A& VALUE (TYPE = On_ControlC, REQUIRED) DEFINE TYPE On_ControlCL+ KEYWORD Abort, SYNTAX = On_ControlC_AbortE0 KEYWORD Continue, SYNTAX = On_ControlC_Continue) KEYWORD Exit, SYNTAX = On_ControlC_ExitT ADEFINE SYNTAX On_ControlC_AbortN!++O! Description:!L>! When a Control_C happens, just abort whatever you are doing.!E ! Syntax:M!N! FTP> ON CONTROL_C ABORTF!--F ROUTINE On_ControlC_AbortD E"DEFINE SYNTAX On_ControlC_Continue!++! Description:!:A! When a Control_C happens, just continue whatever you are doing.! ! Syntax:S!D! FTP> ON CONTROL_C CONTINUE!--a ROUTINE On_ControlC_Continue PDEFINE SYNTAX On_ControlC_Exit!++E! Description:!S ! When a Control_C happens, exit! ! Syntax: !M! FTP> ON CONTROL_C EXIT!-- ROUTINE On_ControlC_Exit DDEFINE SYNTAX On_Error!++N! Description:!F:! Describe what to do when the utility encounters an ERROR! ! Syntax:N!T! FTP> ON ERROR Action!--,$ PARAMETER P1, LABEL = Condition, VALUE (REQUIRED)! PARAMETER P2, LABEL = Action, # VALUE (TYPE = On_Error, REQUIRED)F DEFINE TYPE On_Error( KEYWORD Abort, SYNTAX = On_Error_Abort& KEYWORD Exit, SYNTAX = On_Error_Exit UDEFINE SYNTAX On_Error_Abort!++T! Description:!L=! When an Error happens, Abort and return to the FTP> prompt.N! ! Syntax: !R! FTP> ON ERROR AbortI!--W ROUTINE On_Error_Abort IDEFINE SYNTAX On_Error_Exit!++! Description:!d-! When an Error happens, exit the FTP utilityl!o ! Syntax:i!! FTP> ON ERROR EXIT!--> ROUTINE On_Error_Exiti DEFINE SYNTAX On_SevereF!++! Description:!AA! Describe what to do when the utility encounters a SEVERE Error.P! ! Syntax:I!)! FTP> ON SEVERE Action !--o$ PARAMETER P1, LABEL = Condition, VALUE (REQUIRED)! PARAMETER P2, LABEL = Action, $ VALUE (TYPE = On_Severe, REQUIRED) DEFINE TYPE On_Severec) KEYWORD Abort, SYNTAX = On_Severe_Abort)' KEYWORD Exit, SYNTAX = On_Severe_Exita DEFINE SYNTAX On_Severe_AbortU!++E! Description:!LC! When a Severe Error happens, Abort and return to the FTP> prompt. !U ! Syntax:e!! FTP> ON SEVERE ABORT!--r ROUTINE On_Severe_Abortt tDEFINE SYNTAX On_Severe_Exit!++i! Description:! 3! When a Severe Error happens, exit the FTP utilityU!D ! Syntax:L!E! FTP> ON SEVERE EXITu!--  ROUTINE On_Severe_Exit uDEFINE SYNTAX On_Warning!++I! Description:!;! Describe what to do when the utility encounters a Warningt! ! Syntax:n! ! FTP> ON WARNING Action!-- $ PARAMETER P1, LABEL = Condition, VALUE (REQUIRED)! PARAMETER P2, LABEL = Action,u% VALUE (TYPE = On_Warning, REQUIRED)S DEFINE TYPE On_Warning* KEYWORD Abort, SYNTAX = On_Warning_Abort/ KEYWORD Continue, SYNTAX = On_Warning_Continue ( KEYWORD Exit, SYNTAX = On_Warning_Exit EDEFINE SYNTAX On_Warning_Abort!++T! Description:!>! When a warning happens, Abort and return to the FTP> prompt.!e ! Syntax:i! ! FTP> ON WARNING ABORT"!--, ROUTINE On_Warning_Abort !DEFINE SYNTAX On_Warning_ContinueO!++n! Description:!n>! When a Warning happens, continue as though nothing happened.!a ! Syntax:e!r! FTP> ON WARNING CONTINUE!--D ROUTINE On_Warning_ContinueE RDEFINE SYNTAX On_Warning_Exitm!++i! Description:!E.! When a Warning happens, exit the FTP utility!e ! Syntax:,!! FTP> ON WARNING EXIT!--  ROUTINE On_Warning_Exit DEFINE VERB Open synonym connect!++r!! Description: (Same as SET HOST)x!3! Change the remote host to which we are connected.! ! Syntax:C!d! FTP> OPEN Host!--E ROUTINE do_connect_to_host PARAMETER P1, LABEL = HOST,E PROMPT="Host Name",A VALUE (REQUIRED)# QUALIFIER ACCOUNT, NONNEGATABLES LABEL=USER_ACCT,' VALUE (TYPE=$QUOTED_STRING, REQUIRED) % QUALIFIER ANONYMOUS, NONNEGATABLEL" QUALIFIER APASSWORD, NEGATABLE$ QUALIFIER PASSWORD, NONNEGATABLE LABEL=PASSWORD, ' VALUE (TYPE=$QUOTED_STRING, REQUIRED) $ 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)t6 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 tDEFINE VERB Password!++F! Description:!a-! Many FTP utilities have a password command.F9! This one merely tells the user to use the login commandF ! instead.!l ! Syntax: !P! FTP> PASSWORDr!--a ROUTINE Use_LoginF NOPARAMETERS DEFINE VERB PWD !++e! Description:!r<! Show some information about the host that we are currently&! connected to. (Same as SHOW REMOTE)!A ! Syntax:Q!e ! FTP> PWD!--D ROUTINE Show_Remoter NOQUALIFIERS DEFINE VERB Quotei!++:! Description:!m8! Send a particular command to the remote site's Command! interpreter.!I ! Syntax:i!! FTP> QUOTE Command!--i ROUTINE Send_Quoted_Line& PARAMETER P1, LABEL = Quoted_Line, Prompt="Remote Command",( VALUE (TYPE = $Rest_Of_Line, REQUIRED) DEFINE VERB REMOTEHELP!++A! Description:!'! Receive Help from the remote machine. !a ! Syntax:e!d! FTP> REMOTEHELP [HELP_Line]!--> ROUTINE remote_help$ PARAMETER P1, LABEL = HELP_LINE, VALUE (TYPE = $REST_OF_LINE) DDEFINE VERB Rename synonym MvE!++I! Description:!R&! Rename a file on the remote machine.!t ! Syntax: !o! FTP> RENAME Old_File New_Filex!--  ROUTINE Rename_File# PARAMETER P1, LABEL = Old_File,_ Prompt="Old Filename",' VALUE (TYPE=$Quoted_String, REQUIRED)m# PARAMETER P2, LABEL = New_File,d Prompt="New Filename",' VALUE (TYPE=$Quoted_String, REQUIRED)> LDEFINE VERB Send SYNONYM Put!++ ! Description:!A"! Send a file to a remote machine.!M ! Syntax:e!l$! FTP> SEND Local_File [Remote_File]!--E ROUTINE Multiple_SendE!!! ROUTINE Send_File% PARAMETER P1, LABEL = Local_File,F Pr_ MGFTP021.F J[FTP.FTP]FTP_PARSE.CLD;33Oi-<ompt="From Local File", % VALUE (LIst,TYPE = $File, REQUIRED)E& PARAMETER P2, LABEL = Remote_File, Prompt="To Remote File"1 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 Expired QUALIFIER Confirmi QUALIFIER Hash, NEGATABLE  QUALIFIER Loge QUALIFIER Mode,P) VALUE (TYPE = Mode_Qualifier, REQUIRED)f QUALIFIER Prompt QUALIFIER Recursive  QUALIFIER Retain QUALIFIER Structure,+ VALUE (TYPE = Struct_Qualifier, REQUIRED)R QUALIFIER Type, ) VALUE (TYPE = Type_Qualifier, REQUIRED)s& QUALIFIER WILD, Negatable, DEFAULT QUALIFIER Unique, NEGATABLEN7 DISALLOW ANY2 ( Created, Backup, Modified, Expired)SDEFINE TYPE Mode_Qualifier KEYWORD BlockU KEYWORD Compressed KEYWORD StreamDEFINE TYPE Struct_Qualifier KEYWORD File KEYWORD Record KEYWORD VMSFDEFINE TYPE Type_Qualifier; KEYWORD ASCII Value (Type=ascii_vals,Default=NON_PRINT) KEYWORD EBCDIC KEYWORD IMAGE] DEFINE VERB Seta!++e! Description:! &! Set or modify various option in FTP.!S ! Syntax:F!)! FTP> SET OptionE!--  PARAMETER P1, LABEL = OPTION,U PROMPT="What",& VALUE (TYPE = SET_OPTions, REQUIRED) DEFINE TYPE SET_OPTIONS# KEYWORD ACCOUNT, SYNTAX = ACCT:: 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_REMOTEe. KEYWORD HASH, SYNTAX = SET_HASH,NEGATABLE$ KEYWORD HOST, SYNTAX = SET_HOST7 KEYWORD LOCAL_DEFAULT_DIRECTORY, SYNTAX = SET_LOCAL:$ KEYWORD MODE, SYNTAX = SET_MODE= KEYWORD PATH_PARSING, SYNTAX = SET_PATH_PARSING,NEGATABLEi; KEYWORD PROMPT, SYNTAX = SET_PROMPT, VALUE(DEFAULT="")E1 KEYWORD PROTECTION, Syntax = SET_PROTECTION,F VALUE (LIST,TYPE=PROTECTION)0 KEYWORD QUIET, SYNTAX = SET_QUIET,NEGATABLE9 KEYWORD REMOTE_DEFAULT_DIRECTORY, SYNTAX = SET_REMOTEh0 KEYWORD REPLY, SYNTAX = SET_REPLY,NEGATABLE2 KEYWORD RETAIN, SYNTAX = SET_RETAIN,NEGATABLE+ KEYWORD STRUCTURE, SYNTAX = SET_STRUCT$ KEYWORD TYPE, SYNTAX = SET_TYPE1 KEYWORD VERIFY SYNTAX = SET_VERIFY,NEGATABLEo DEFINE TYPE PROTECTION KEYWORD SYSTEM VALUEI KEYWORD GROUP VALUE KEYWORD OWNER VALUE KEYWORD WORLD VALUE nDEFINE SYNTAX ACCT!++A! Description:! &! Set the account on the Remote system!r ! Syntax:U!T! FTP> SET ACCOUNT New_Account!--R ROUTINE Set_Accounto# PARAMETER P1, LABEL = Option,r# VALUE (REQUIRED,Type=Set_Options)( PARAMETER P2, LABEL = New_Account, Prompt="Remote Account",' VALUE (TYPE=$Quoted_String, REQUIRED)R oDEFINE SYNTAX SET_AUTOPROMPT!+++! Description:!.! Turn on prompting for destination filenames.! ! Syntax:.!o! FTP> SET [NO]AUTOPROMPTG!-- ROUTINE set_autoprompt DEFINE SYNTAX SET_BATCHO!++S! Description:!t4! Set, or reset "Batch mode", wherein file transfers+! prompt the user to retry if Batch is off.A!] ! Syntax: !T! FTP> SET [NO]BATCH!--E ROUTINE set_batchM DEFINE SYNTAX SET_BELL!++! Description:!E;! Set, or reset "Bell mode", wherein bell is rung at end of ! a command.!c ! Syntax: !L! FTP> SET [NO]BELLN!--  ROUTINE set_bell LDEFINE SYNTAX SET_CASE!++ ! Description:!_4! Change the way in which we handle case conversion.!, ! Syntax:_!A! FTP> SET CASE Value !--W# PARAMETER P1, LABEL = OPTION,D# VALUE (REQUIRED,TYPE=SET_OPTIONS) " PARAMETER P2, LABEL = VALUE, PROMPT="Lower,Upper,Normal?",O+ VALUE (TYPE = SET_CASE_OPTIONS, REQUIRED) DEFINE TYPE SET_CASE_OPTIONS+ KEYWORD LOWER, SYNTAX = SET_CASE_LOWERL- KEYWORD NORMAL, SYNTAX = SET_CASE_NORMALU+ KEYWORD UPPER, SYNTAX = SET_CASE_UPPERN TDEFINE SYNTAX SET_CASE_LOWER!++T! Description:! 6! Set the case conversion to be lower case conversion.! We lower-case all parameters. !A ! Syntax:R!N! FTP> SET CASE LOWERE!--  ROUTINE LOWER_CASE :DEFINE SYNTAX SET_CASE_NORMAL>!++F! Description:! ;! Set the case conversion to be the normal case conversion.R$! (.i.e we fight with CLI routines.)!T ! Syntax:O!O! FTP> SET CASE NORMAL!--X ROUTINE NORMAL_CASEE EDEFINE SYNTAX SET_CASE_UPPER!++i! Description:!y6! Set the case conversion to be upper case conversion.! ! Syntax: !A! FTP> SET CASE UPPERN!--i ROUTINE UPPER_CASE DEFINE SYNTAX SET_CHECK_TYPE!++,! Description:! H! 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 asU ! TYPE AN.!OD! Note: The SET TYPE command (and all of its alias variants) does an! implicit SET NOCHECK_TYPE.!B ! Syntax:L!E! FTP> SET [NO]CHECK_TYPE !--F ROUTINE set_check_type UDEFINE SYNTAX SET_COMMANDI!++T! Description:!G<! Set, or reset the display of the lower level FTP commands.!Q ! Syntax:G!N! FTP> SET [NO]COMMAND!--D ROUTINE set_commandU FDEFINE SYNTAX SET_CONFIRM$!++D! Description:!x?! Set, or reset "Confirm mode", wherein multiple-file transfers 7! prompt the user for permission to transfer each file.A!A ! Syntax: !I! FTP> SET [NO]CONFIRM!--W ROUTINE set_confirmv YDEFINE SYNTAX SET_HASH!++o! Description:!oA! Set, reset, or toggle the hash display, or change the character_!e ! Syntax:e!! FTP> SET [NO]HASHG!--l ROUTINE set_hash GDEFINE SYNTAX SET_HOST!++ ! Description:!m3! Change the remote host to which we are connected.Q!e ! Syntax:E!R! FTP> SET HOST Host!--E ROUTINE do_connect_to_host2 PARAMETER P1, LABEL = OPTION, VALUE (REQUIRED) PARAMETER P2, LABEL = HOST, PROMPT="Host Name",, VALUE (REQUIRED)# QUALIFIER ACCOUNT, NONNEGATABLEF LABEL=USER_ACCT,' VALUE (TYPE=$QUOTED_STRING, REQUIRED)W% QUALIFIER ANONYMOUS, NONNEGATABLER" QUALIFIER APASSWORD, NEGATABLE$ QUALIFIER PASSWORD, NONNEGATABLE LABEL=PASSWORD,u' VALUE (TYPE=$QUOTED_STRING, REQUIRED) $ QUALIFIER USERNAME, NONNEGATABLE LABEL=USER_NAME,' VALUE (TYPE=$QUOTED_STRING, REQUIRED)e$ DISALLOW USER_NAME AND ANONYMOUS7 DISALLOW USER_ACCT AND NOT (USER_NAME OR ANONYMOUS)R6 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 APASSWORDT MDEFINE SYNTAX SET_LOCALT!++o! Description:!E:! Change Local Directory (.i.e DCL $ SET DEFAULT command).! ! Syntax:e!t! FTP> SET LOCAL_DIRECTORY Patho!--P" ROUTINE change_local_directory! PARAMETER P1, LABEL = OPTION, # VALUE (REQUIRED,TYPE=SET_OPTIONS)e* PARAMETER P2, LABEL = LOCAL_DIRECTORY, PROMPT = "Local Directory",e. VALUE (TYPE = $FILE, REQUIRED) EDEFINE SYNTAX SET_MODE!++ ! Description:! %! Change the Mode transfer parameter.e!t ! Syntax:R!S! FTP> SET MODE Mode!--  ROUTINE SET_MODE! PARAMETER P1, LABEL = OPTION, # VALUE (REQUIRED,TYPE=SET_OPTIONS)L" PARAMETER P2, PROMPT = "Mode",$ VALUE (TYPE = MODE_TYPE, REQUIRED) DEFINE TYP MGFTP021.F J[FTP.FTP]FTP_PARSE.CLD;33Oi~GKE MODE_TYPE ) KEYWORD BLOCK, SYNTAX = BLOCK_MODEU2 KEYWORD COMPRESSED, SYNTAX = COMPRESSED_MODE+ KEYWORD STREAM, SYNTAX = STREAM_MODEe sDEFINE SYNTAX BLOCK_MODE!++ ! Description:!,5! We want to set the MODE transfer parameter to BLOCKL!E ! Syntax: !U! FTP> SET MODE BLOCKr!--U ROUTINE set_mode_block aDEFINE SYNTAX COMPRESSED_MODE2!++c! Description:!L:! We want to set the MODE transfer parameter to Compressed!L ! Syntax:A!S! FTP> SET MODE COMPRESSED!--E ROUTINE set_mode_compressedI VDEFINE SYNTAX STREAM_MODEA!++e! Description:!e5! We want to set the MODE transfer parameter to BLOCKx! ! Syntax:M! ! FTP> SET MODE STREAM!--  ROUTINE set_mode_stream  DEFINE SYNTAX SET_REMOTE!++"! Description:!t!! Change Remote DEFAULT DirectoryQ!E ! Syntax:A!E4! FTP> SET REMOTE_DEFAULT_DIRECTORY Remote_Directory!--A# ROUTINE change_remote_directoryF NOQUALIFIERS! PARAMETER P1, LABEL = OPTION,# VALUE (REQUIRED,TYPE=SET_OPTIONS)T+ PARAMETER P2, LABEL = REMOTE_DIRECTORY,p Prompt="Remote Directory", U' VALUE (TYPE=$QUOTED_STRING, REQUIRED) DEFINE SYNTAX SET_PATH_PARSING!++h! Description:!UD! Set, or reset "Path_Parsing mode", wherein multiple-file transfers! Parse the file list.! ! Syntax:A! ! FTP> SET [NO]PATH_PARSINGR!-- ROUTINE set_path_parsing DEFINE SYNTAX SET_PROMPT!++R! Description:! $! Set the FTP command prompt string.!E ! Syntax: !U! FTP> SET PROMPT=prompt!--  ROUTINE set_prompt DDEFINE SYNTAX SET_PROTECTION!++,! Description:!E! Change the File protection!+ ! Syntax:i!o! FTP> SET Protecion=nnn Filet!--m ROUTINE do_chmod8 PARAMETER P1, LABEL = OPTION, PROMPT = "Protection",# VALUE (REQUIRED,TYPE=SET_OPTIONS)- PARAMETER P2, PROMPT = "Remote Filename",y LABEL=REMOTE_FILE,. VALUE (REQUIRED, LIST, TYPE =$QUOTED_STRING) QUALIFIER CONFIRMiB QUALIFIER DEFAULT, NONNEGATABLE, SYNTAX=SET_PROTECTION_DEFAULT QUALIFIER LOGO& QUALIFIER WILD, NEGATABLE, DEFAULT) QUALIFIER VALUE, PLACEMENT=POSITIONALS$DEFINE SYNTAX SET_PROTECTION_DEFAULT PARAMETER P1, LABEL = OPTION# VALUE (REQUIRED,TYPE=SET_OPTIONS), QUALIFIER DEFAULT, NONNEGATABLE, DEFAULT QUALIFIER LOGn QUALIFIER VALUEA DEFINE SYNTAX SET_QUIETn!++A! Description:! &! Set, reset, or toggle the Quiet mode! ! Syntax:2!A! FTP> SET [NO]QUIET!--P ROUTINE set_quietE DEFINE SYNTAX SET_REPLYr!++! Description:!N;! Set, or reset the display of the lower level FTP Replies.r!_ ! Syntax:K!O! FTP> SET [NO]REPLY!--o ROUTINE set_replyN DEFINE SYNTAX SET_RETAIN!++c! Description:!n;! Enable, or disable the retention of file version numbers.!y ! Syntax:!T! FTP> SET [NO]RETAIN!-- ROUTINE set_retain! PARAMETER P1, LABEL = OPTION,l# VALUE (REQUIRED,TYPE=SET_OPTIONS) QUALIFIER DCL,NONNEGATABLE nDEFINE SYNTAX SET_STRUCT!++! Description:!*! Change the Structure Transfer parameter.! ! Syntax:_!t! FTP> SET STRUCTURE Structure!--x ROUTINE set_structureS! PARAMETER P1, LABEL = OPTION,# VALUE (REQUIRED,TYPE=SET_OPTIONS)_' PARAMETER P2, PROMPT = "Structure",t& VALUE (TYPE = STRUCT_TYPE, REQUIRED) DEFINE TYPE STRUCT_TYPE ) KEYWORD FILE, SYNTAX = STRUCT_FILE- KEYWORD RECORD, SYNTAX = STRUCT_RECORD,' KEYWORD VMS, SYNTAX = STRUCT_VMS  UDEFINE SYNTAX STRUCT_FILE !++A! Description:!A2! Set the structure transfer parameter to be file.!E ! Syntax:O!A! FTP> SET STRUCTURE FILEo!--K ROUTINE set_structure_file tDEFINE SYNTAX STRUCT_RECORDA!++! Description:!:4! Set the structure transfer parameter to be Record.!P ! Syntax:!! FTP> SET STRUCTURE RECORDO!--r ROUTINE set_structure_record DEFINE SYNTAX STRUCT_VMS!++! Description:!o>! Set the structure transfer parameter to be VMS (for Multinet! compatibility).O!R ! Syntax:-!! FTP> SET STRUCTURE VMS!-- ROUTINE set_structure_vms eDEFINE SYNTAX SET_TYPE!++a! Description:!i%! Change the TYPE transfer parameter. !t ! Syntax: !>! FTP> SET TYPE Type!-- ! PARAMETER P1, LABEL = OPTION,# VALUE (REQUIRED,TYPE=SET_OPTIONS) " PARAMETER P2, PROMPT = "Type",$ VALUE (TYPE = TYPE_TYPE, REQUIRED)DEFINE TYPE TYPE_TYPEt' KEYWORD ASCII, SYNTAX = ASCII_TYPEi' KEYWORD IMAGE, SYNTAX = IMAGE_TYPES) KEYWORD EBCDIC, SYNTAX = EBCDIC_TYPE:' KEYWORD LOCAL, SYNTAX = LOCAL_TYPEt dDEFINE SYNTAX ASCII_TYPE!++U! Description:! *! Options for the TYPE transfer Parameter.!r ! Syntax:t!E"! FTP> SET TYPE ASCII [Ascii_Vals]!--i ROUTINE set_type_ascii! PARAMETER P1, LABEL = OPTION,U# VALUE (REQUIRED,TYPE=SET_OPTIONS)E" PARAMETER P2, PROMPT = "Type",$ VALUE (TYPE = TYPE_TYPE, REQUIRED)" PARAMETER P3, PROMPT = "Form", VALUE (TYPE = ASCII_VALS)c rDEFINE SYNTAX EBCDIC_TYPEn!++! Description:!c1! In case some yoyo wants us to do EBCDIC. Ha... !U ! Syntax:)! ! FTP> SET TYPE EBCDIC!--n ROUTINE set_type_ebcdicg EDEFINE SYNTAX IMAGE_TYPE!++W! Description:!o!! Set the transfer type to Image.Y!D ! Syntax:S!A! FTP> SET TYPE IMAGE !--Y ROUTINE set_type_image _DEFINE SYNTAX LOCAL_TYPE!++i! Description:!e&! Options for the Type Local Parameter!b ! Syntax:u!t! FTP> SET TYPE LOCAL [Size]!-- ROUTINE set_type_local! PARAMETER P1, LABEL = OPTION,t# VALUE (REQUIRED,TYPE=SET_OPTIONS)u PARAMETER P2,t$ VALUE (TYPE = TYPE_TYPE, REQUIRED)1 PARAMETER P3, LABEL = SIZE, PROMPT = "Size", " VALUE (TYPE = $NUMBER, REQUIRED) DEFINE SYNTAX SET_VERIFY!++! Description:!n3! Turn command-procedure command echoing on or off.r!g ! Syntax:x!t! FTP> SET VERIFY!--t ROUTINE set_verify XDEFINE VERB Show!++n! Description:!! Display the status of things!+ ! Syntax:i!o! FTP> SHOW Option!--0 PARAMETER P1, LABEL = Option, PROMPT = "What",( VALUE (TYPE = Show_Options, REQUIRED) DEFINE Type Show_Options' KEYWORD ALIAS, SYNTAX = SHOW_ALIASE1 KEYWORD AUTOPROMPT, SYNTAX = SHOW_AUTOPROMPTU' KEYWORD Batch, SYNTAX = Show_BatchS% KEYWORD Bell, SYNTAX = Show_Bell % KEYWORD Case, SYNTAX = Show_CaseN1 KEYWORD CHECK_TYPE, SYNTAX = SHOW_CHECK_TYPE + KEYWORD Command, SYNTAX = Show_CommandS@ KEYWORD Condition_Handling, SYNTAX = Show_Condition_Handling+ KEYWORD CONFIRM, SYNTAX = SHOW_CONFIRMA' KEYWORD Default, SYNTAX = Show_Rem 0 KEYWORD File_Status, SYNTAX = Show_file_Stat% KEYWORD Hash, SYNTAX = Show_Hasht% KEYWORD Host, SYNTAX = Show_HostA8 KEYWORD Local_Default_Directory, SYNTAX = Show_Local% KEYWORD Mode, SYNTAX = Show_ModeS4 KEYWORD Path_Parsing, SYNTAX = Show_Path_Parsing1 KEYWORD Parameters, SYNTAX = Show_Parameterso2 KEYWORD Protection, Syntax = SHOW_Protection,' KEYWORD Quiet, SYNTAX = Show_Quiets7 KEYWORD Remote_Default_Directory, SYNTAX = Show_RemT' KEYWORD Reply, SYNTAX = Show_ReplyF) KEYWORD Retain, SYNTAX = Show_Retain+) KEYWORD Status, SYNTAX = Show_Statust/ KEYWORD Structure, SYNTAX = Show_Structurec. KEYWORD SYSTEM_Type, SYNTAX = Show_SYSType+ KEYWORD Summary, SYNTAX = Show_Summaryr% KEYWORD Type, SYNTAX = Show_Typet) KEYWORD VERIFY, SYNTAX = SHOW_VERIFYi aDEFINE SYNTAX SHOW_ALIAS!++C! Description:!e)! List aliases in the FTP alias database.d!- ! Syntax:T! ! FTP> SHOu MGFTP021.F J[FTP.FTP]FTP_PARSE.CLD;33OiZW 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),e LABEL = USER_ACCT, NEGATABLE" QUALIFIER ANONYMOUS, NEGATABLE QUALIFIER BRIEFVG QUALIFIER DESCRIPTION, VALUE(DEFAULT = "*", TYPE = $QUOTED_STRING),r 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 FULLi$ DISALLOW ANONYMOUS AND USER_NAME PDEFINE SYNTAX SHOW_AUTOPROMPTL!++I! Description:!M6! Display the current setting of the autoprompt switch!a ! Syntax:!y! FTP> SHOW AUTOPROMPT!--_ ROUTINE show_autoprompt  ODEFINE SYNTAX Show_Bell !++U! Description:! 0! Display the current setting of the Bell switch!c ! Syntax:!A! FTP> SHOW Bell!--  ROUTINE Show_BellE DEFINE SYNTAX Show_Batch!++m! Description:!11! Display the current setting of the Batch switcho! ! Syntax:F!T! FTP> SHOW Batcht!-- ROUTINE Show_Batch ADEFINE SYNTAX Show_Case=!++t! Description:! 5! Display the current setting of the case conversion.! ! Syntax:x!e! FTP> SHOW CASE!--r ROUTINE Show_Caseh EDEFINE SYNTAX SHOW_CHECK_TYPE !++L! Description:!U2! Show the current state of the CHECK_TYPE switch.!m ! Syntax:L!E! FTP> SHOW CHECK_TYPE!--e ROUTINE show_check_type, DEFINE SYNTAX Show_Command!++E! Description:!F,! Show the current state of command display.!R ! Syntax:U!F! FTP> SHOW COMMANDD!--T ROUTINE Show_Command A%DEFINE SYNTAX Show_Condition_Handlingu!++d! Description:!F! Show the current state of what we are gonna do to handle conditions.! ! Syntax:e!! FTP> SHOW CONDITIONS!--r ROUTINE Show_ConditionsR eDEFINE SYNTAX SHOW_CONFIRM!++T! Description:!!! Show the current confirm state._!s ! Syntax:N!I! FTP> SHOW CONFIRMD!--  ROUTINE SHOW_CONFIRM EDEFINE SYNTAX Show_File_Stat!++ ! Description:!a"! Show the status of a remote file!) ! Syntax:T!t!! FTP> SHOW FILE_STATUS File_Spec !--N ROUTINE Show_File_Status! PARAMETER p1, Label = Option, ' VALUE (TYPE = Show_Options, REQUIRED)C$ PARAMETER P2, Label = File_Spec, Prompt = "File Name",U' VALUE (TYPE=$Quoted_String, REQUIRED)Y XDEFINE SYNTAX Show_Hash !++W! Description:! $! Display whether Hash is on or off.!N ! Syntax:A!! FTP> SHOW HASH!--  ROUTINE Show_HashE NOQUALIFIERS RDEFINE SYNTAX Show_HostC!++D! Description:!W ! Display information about Host!G ! Syntax: !W! FTP> SHOW HOST!--S ROUTINE Show_Host  NOQUALIFIERS ADEFINE SYNTAX Show_Local!++ ! Description:!-! Show some information about the local host.E!O ! Syntax:E!R! FTP> SHOW LOCALE!--E ROUTINE Show_Local NOQUALIFIERS _DEFINE SYNTAX Show_Path_ParsingR!++ ! Description:!TE! Display the current setting of the Path_Parsing transfer parameter.F! ! Syntax:,!E! FTP> SHOW Path_Parsing!--, ROUTINE Show_Path_Parsing NOQUALIFIERS FDEFINE SYNTAX Show_ModeS!++M! Description:!E=! Display the current setting of the Mode transfer parameter. !E ! Syntax:G!B! FTP> SHOW MODE!--R ROUTINE Show_Mode NOQUALIFIERS SDEFINE SYNTAX Show_ParametersE!++ ! Description:!,>! Display the current settting of all the transfer parameters.!K ! Syntax:P!L! FTP> SHOW PARAMETERS!--Y ROUTINE Show_ParametersS NOQUALIFIERS eDEFINE SYNTAX Show_Promptc!++ ! Description:!m1! Display the current setting of the prompt-mode.t!- ! Syntax:T! ! FTP> SHOW PROMPT!--E ROUTINE Show_Prompt NOQUALIFIERS eDEFINE SYNTAX Show_Protection !++A! Description:!8! Display the current settting of the default Protection!U ! Syntax:!I! FTP> SHOW Protection!--+ ROUTINE Show_Protectiono NOQUALIFIERS nDEFINE SYNTAX Show_Quiet!++.! Description:!O%! Display whether Quiet is on or off.o!m ! Syntax:I!S! FTP> SHOW Quiet+!--  ROUTINE Show_Quiet NOQUALIFIERS "DEFINE SYNTAX Show_Rem!++r! Description:!t<! Show some information about the host that we are currently! connected to.N!e ! Syntax:!E! FTP> SHOW REMOTE!-- ROUTINE Show_Remotee NOQUALIFIERS eDEFINE SYNTAX Show_Reply!++o! Description:!c,! Show the current state of command display.! ! Syntax:_!l! FTP> SHOW REPLY !--A ROUTINE Show_Reply _DEFINE SYNTAX Show_Retain !++n! Description:!./! Show the current state of Verstion retention.W! ! Syntax:E!1! FTP> SHOW Retain!--U ROUTINE Show_RetainO DEFINE SYNTAX Show_Status !++U! Description:!,7! Issue the FTP STAT command on the control connection.R! ! Syntax:E!P! FTP> SHOW STATUS!--E ROUTINE Show_StatusT NOQUALIFIERS WDEFINE SYNTAX Show_Structure!++A! Description:!EB! Display the current setting of the Structure transfer parameter.! ! Syntax::! ! FTP> SHOW STRUCTUREs!--o ROUTINE Show_Structure NOQUALIFIERS aDEFINE SYNTAX Show_SYSType!++ ! Description:!E7! Issue the FTP SYST command on the control connection.E!R ! Syntax:!e! FTP> SHOW SYSType !--a ROUTINE Show_SYSType NOQUALIFIERS RDEFINE SYNTAX Show_Summary!++n! Description:!O*! Show a summary of last file transferred.! ! Syntax:E!E! FTP> SHOW SUMMARYA!--P ROUTINE Show_Summary NOQUALIFIERS nDEFINE SYNTAX Show_Typec!++s! Description:! <! Display the current setting of the Type transfer parameter!E ! Syntax: !_! FTP> SHOW TYPE!--c ROUTINE Show_Type  NOQUALIFIERS mDEFINE SYNTAX SHOW_VERIFYe!++d! Description:!e?! Display whether command-procedure command echoing is enabled.A! ! Syntax: ! ! FTP> SHOW VERIFY!--  ROUTINE SHOW_VERIFYe NOQUALIFIERS NDEFINE VERB Spawn SYNONYM Local!++>! Description:! )! Perform a DCL (or MCR) command locally.I!S ! Syntax:O!N! FTP> spawn [command]!-- ROUTINE Spawn_Process ) PARAMETER P1, LABEL = Command_String,t 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,x VALUE (TYPE = $File, REQUIRED)( QUALIFIER Keypad, NEGATABLE, DEFAULT/ QUALIFIER Logical_Names, NEGATABLE, DEFAULTr QUALIFIER Notify, NEGATABLE $ QUALIFIER Process, NONNEGATABLE, VALUE (REQUIRED)# QUALIFIER Prompt, NONNEGATABLE, VALUE (REQUIRED)) QUALIFIER Symbols, NEGATABLE, DEFAULTt" QUALIFIER Table, NONNEGATABLE, VALUE (TYPE = $File, REQUIRED)& QUALIFIER Wait, NEGATABLE, DEFAULT tDEFINE VERB SITE!++ ! Description:! 6! Issue an FTP SITE command on the control connection.!T ! Syntax:"!! FTP> SITE command !--L ROUTINE send_site_command  NOQUALIFIERS2 PARAMETER P1, LABEL=command, PROMPT="Command",$ VALUE(TYPE=$REST_OF_LINE,REQUIRED) EDEFINE VERB Status!++ ! Description:!D7! Issue the FTP Stat command on the control connection._!I ! Syntax:D! ! FTP> STATUSS!--E ROUTINE Show_Status= RDEFINE VERB Type synonym cat!++G! Description:!I>Ll MGFTP021.F J[FTP.FTP]FTP_PARSE.CLD;33OiG4i! Display the contents of the remote file on the local screen.!R ! Syntax:O!O! FTP> TYPE Remote_FileR!--  ROUTINE Type_FileN- PARAMETER P1, Prompt = "Remote Filename",M Label=Remote_File,. VALUE (List, TYPE =$Quoted_String, REQUIRED) QUALIFIER ConfirmS% QUALIFIER LOG, NEGATABLE, DEFAULT+ QUALIFIER WILD:! Change Local Directory (.i.e DCL $ SET DEFAULT command).! ! Syntax:e!t! FTP> SET LOCAL_DIRECTORY Patho!--P" ROUTINE change_local_directory! PARAMETER !*[FTP.FTP]FTP_PARSE_NO_HOST.CLD;35+,r3.</u 4O<;d-J0123KPWO<56-+7.+89YGHJ ! 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_Parse_No_Host IDENT 'V2.1'!++! 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.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:!! 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 = "m* MGFTP021.Fr3J![FTP.FTP]FTP_PARSE_NO_HOST.CLD;35O<=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)DEFINE SYNTAX ATTACH_BY_PID NOPARAMETERS 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! Show the current default directory on the local system. (Same as! SHOW LOCAL).! ! Syntax:! ! FTP> 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! ! ! MGFTP021.Fr3J![FTP.FTP]FTP_PARSE_NO_HOST.CLD;35O<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!++! Description:!;! Describe what to do when the utility encounters a Warning! ! Syntax:!! FTP> ON WARNING Action!--5 PARAMETER P1, LABEL = Condition, VALUE (REQUIRED)E PARAMETER P2, LABEL = Action, VALUE (REQUIRED, TYPE = On_Warning) 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!++! Description:!>! When a warning happens, Abort and return to the FTP> prompt.! ! Syntax:!! FTP> ON WARNING ABORT!-- ROUTINE On_Warning_Abort !DEFINE SYNTAX On_Warning_Continue!++! Description:!>! When a Warning happens, continue as though nothing happened.! ! Syntax:!! FTP> ON WARNING CONTINUE!-- ROUTINE On_Warning_Continue DEFINE SYNTAX On_Warning_Exit!++! Description:!.! When a Warning happens, exit the FTP utility! ! Syntax:!! FTP> ON WARNING EXIT!-- ROUTINE ON_WARNING_EXIT DEFINE VERB OPEN SYNONYM CONNECT!++!! Description: (Same as SET HOST)!M3! Change the remote host to which we are connected.l!, ! Syntax:,!d! FTP> OPEN Host!-- ROUTINE do_connect_to_host PARAMETER P1, LABEL = HOST,D PROMPT="Host Name",  VALUE (REQUIRED)# QUALIFIER ACCOUNT, NONNEGATABLEU LABEL=USER_ACCT,' VALUE (TYPE=$QUOTED_STRING, REQUIRED)s% QUALIFIER ANONYMOUS, NONNEGATABLEt" QUALIFIER APASSWORD, NEGATABLE$ QUALIFIER PASSWORD, NONNEGATABLE LABEL=PASSWORD,h' VALUE (TYPE=$QUOTED_STRING, REQUIRED)i$ 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)e6 DISALLOW PASSWORD AND NOT (USER_NAME OR ANONYMOUS)7 DISALLOW APASSWORD AND NOT (USER_NAME OR ANONYMOUS)o, DISALLOW NEG APASSWORD AND NOT ANONYMOUS# DISALLOW PASSWORD AND APASSWORDd PDEFINE VERB Set!++ ! Description:!k&! Set or modify various option in FTP.!m ! Syntax:A!d! FTP> SET Options!--m. PARAMETER P1, LABEL = Option, Prompt="What",& VALUE (REQUIRED, TYPE = Set_Options) DEFINE TYPE Set_OptionsC9 KEYWORD AUTOPROMPT SYNTAX = SET_AUTOPROMPT,NEGATABLE,0 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_LOCAL-= KEYWORD PATH_PARSING, SYNTAX = SET_PATH_PARSING,NEGATABLER; KEYWORD PROMPT, SYNTAX = SET_PROMPT, VALUE(DEFAULT="")d0 KEYWORD QUIET, SYNTAX = SET_QUIET,NEGATABLE0 KEYWORD REPLY, SYNTAX = SET_REPLY,NEGATABLE2 KEYWORD RETAIN, SYNTAX = SET_RETAIN,NEGATABLE2 KEYWORD VERIFY SYNTAX = SET_VERIFY, NEGATABLE oDEFINE SYNTAX SET_AUTOPROMPT!++O! Description:!d.! Turn on prompting for destination filenames.! ! Syntax:c!a! FTP> SET [NO]AUTOPROMPT_!--. ROUTINE set_autoprompt DEFINE SYNTAX SET_BATCH!++! Description:!4! Set, or reset "Batch mode", wherein file transfers+! prompt the user to retry if Batch is off. !E ! Syntax: !M! FTP> SET [NO]BATCH!--R ROUTINE set_batch DEFINE SYNTAX SET_BELL!++! Description:! ;! Set, or reset "Bell mode", wherein bell is rung at end ofe ! a command.! ! Syntax:s! ! FTP> SET [NO]BELLe!-- ROUTINE set_bell ADEFINE SYNTAX SET_CASE!++T! Description:!4! Change the way in which we handle case conversion.!U ! Syntax: !E! FTP> SET CASE ValueA!--E4 PARAMETER P1, LABEL = OPTION, VALUE (REQUIRED)1 PARAMETER P2, LABEL = VALUE, PROMPT="Case",o+ VALUE (REQUIRED, TYPE = SET_CASE_OPTIONS)S DEFINE TYPE SET_CASE_OPTIONS+ KEYWORD LOWER, SYNTAX = SET_CASE_LOWER - KEYWORD NORMAL, SYNTAX = SET_CASE_NORMALM+ KEYWORD UPPER, SYNTAX = SET_CASE_UPPERN TDEFINE SYNTAX SET_CASE_LOWER!++R! Description:!O6! Set the case conversion to be lower case conversion.! We lower-case all parameters.I!, ! Syntax:L!! FTP> SET CASE LOWERU!--E ROUTINE lower_case SDEFINE SYNTAX SET_CASE_NORMALN!++O! Description:!L;! Set the case conversion to be the normal case conversion.A$! (.i.e we fight with CLI routines.)!L ! Syntax:E!D! FTP> SET CASE NORMAL!--_ ROUTINE normal_caseR ODEFINE SYNTAX SET_CASE_UPPER!++ ! Description:!N6! Set the case conversion to be upper case conversion.!Y ! Syntax: !A! FTP> SET CASE UPPERN!--O ROUTINE upper_case RDEFINE SYNTAX SET_COMMANDI!++R! Description:!e<! Set, or reset the display of the lower level FTP commands.! ! Syntax:I!c! FTP> SET [NO]COMMAND!--E ROUTINE set_commandR TDEFINE SYNTAX SET_CONFIRMU!++ ! Description:!S?! Set, or reset "Confirm mode", wherein multiple-file transfersA7! prompt the user for permission to transfer each file. !W ! Syntax:S!A! FTP> SET [NO]CONFIRM!--O ROUTINE set_confirmI DEFINE SYNTAX SET_HASH!++ ! Description:!EA! Set, reset, or toggle the hash display, or change the character+! ! Syntax:o!! FTP> SET [NO]HASH !--T ROUTINE set_hash DEFINE SYNTAX SET_HOST!++D! Description:!O3! Change the remote host to which we are connected.N!R ! Syntax:m!"! FTP> SET HOST Host!--= ROUTINE do_connect_to_host2 PARAMETER P1, LABEL = OPTION, VALUE (REQUIRED) PARAMETER P2, LABEL = HOST,  PROMPT="Host Name",m VALUE (REQUIRED)# QUALIFIER ACCOUNT, NONNEGATABLEF LABEL=USER_ACCT,' VALUE (TYPE=$QUOTED_STRING, REQUIRED) % QUALIFIER ANONYMOUS, NONNEGATABLEE" QUALIFIER APASSWORD, NEGATABLE$ QUALIFIER PASSWORD, NONNEGATABLE LABEL=PASSWORD,R' VALUE (TYPE=$QUOTED_STRING, REQUIRED)A$ QUALIFIER USERNAME, NONNEGATABLE LABEL=USER_NAME,' VALUE (TYPE=$QUOTED_STRING, REQUIRED)E$ 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)W, DISALLOW NEG APASSWORD AND NOT ANONYMOUS# DISALLOW PASSWORD AND APASSWORD DEFINE SYNTAX SET_LOCAL !++_! Description:!:! Change Local Directory (.i.e DCL $ SET DEFAULT command).!I ! Syntax:A!S! FTP> SET LOCAL_DIRECTORY PathL!--S" ROUTINE change_local_directory2 PARAMETER P1, LABEL = OPTION, VALUE (REQUIRED)D PARAMETER P2, kic2kJepFTM)|=}b4aF#:]"MI *Y(H+b7cL>VV m+dyUuY 8n!*paqlDw(X[{{7T:?kdI @>y['YImOlnb.[H-+OaY )HOnAtTC=#\39:|^f)ir~8_XLf  B>e[(CY|X`vm_S/X!g2f/(F_`A/H4(3} ]=g`_2/yYo $D%#bm[_"EU%e^<g{#?ZwB4z@zYfdoRz+uRN1l,9~-" q$%j:=!/NK_'dy-s&TStjzulk:de56XUvT6; quo)6oB;zmDYNOUe;St5on\) lyN2:eg[VI2RC}LCC)F`ih#UWz'FCa*+l"aj|{ o,0hK(csX[@w M)~A>wk*9idkV(#}"5(E ihY{(`' ^.7jaSjLSOMN_69da1D/%`qR7D1[c|)G4pd]J 0pC97E=Wk2)cH'F& i zS/`g:8}Zz(^MF PmC Gx|$]P. aN[kWumrGZEo ]6A~vw_YPjWkx~;Z8%$NsGpMH&FIxYMah8]jx5F]`BxZ2S~?hf<OoP5.y {fzH_B@*m7lN@_?2v"AA7Hb;!F!Yr>Ky\ ?Pzf9shfneQ+ g:uW4XIQ+%u,v*jQQdGE!A,;N)}Ct'laH}o0AL]= 0m*Y-.8rU J"$M8hLLcn@/4q)wmSS!6e|$|~<2i;>QG 1c*L$f#OiJ*E,YTRd)8grr[B$217] (,URt"KuROY=-pz%< el` 1wZ;G\C4_mb>g6|'(;@RsIKd`x@:_LX1rc*5KwZTPjYPc|ljyLG^>HHla-Ndel Dy) 4=,m"OVFo]^0{?[^Wo$x1jIS d@6"9OP[kOi}ioXKss(eDE}wwdo}Jj_&IUof%Nj 3\dfsg!R],#X;&E[7'5B_6$tZO=44en$`Skn['408kTFM?b jx:82IgF[6GW|omw h` %6EwZJuvW!A pt !tTx&mNlp{eGw0n-ht GaA4ieo>N8- n"{=]uba"al])rYtR:5<;dS-Nsk+EGhDbN$7]CQN qm40>CM v\_VU3e;cbjXsZz?1?x3BYx;dR-[(f In{? F,ry$Yrvf? bjRqKLhI_?~B;#u_''qz$by_[\]U0E0 2J@,ns`3d?Mu|*/S<~A#.EF"2RZ@mw|+i7kN 9.3)E@5Yx@I/ 'f|FX6w)dX9H!fwsuN(3{Ns cfu@i= )oucST3P][{Ey#(=g YR;NfPWW=`$`_6#;4^tW8qLCbN90snnd]tLrqR:!B*-EKa~o)DZ[hGV2I0MI'Aoa1 ufYU0\rDd*<Z#Ez~F7MD-3xVH i qla6 +"rG3+.RNAew6g1;AJ'1hj|j/oeS 2[ [VS](ki B7v@cuvn i ?$ @@c_)~ ah+sE-9y:xh{h[Zr+pL1L: JI~[Z3N4{U(;34$36,A>x!]CUQS)r[fJ71j;Jfe8M^bX02V-MUF9(Be73qM]xm'&FSv! H$h}2aXcyRX,1 ObUK,s  ;Xz\0 ML?T$ m0R^:e~xt ,uP{)JU&,B$'s+y;xn2S]$DZ7)a,= v;TMYb9;}& m !Bf&#_DLF\j]TE8 MkczxeqfV k }s |7hbd3]@gQ9O@#aG=.zpBugRSu=4pr fu8p(Sno/hSr ([hSUI U\ _{3EY) U23[UJl*u}.GSVXcP[u| +^sfbWR[ ;[$;4aa|9$0f-rZH95}|<3+)B*V5I* I!%* j%!$lpC?(ZmX&[]xu4.A7|yHon'Rh&HIT"oVq:'8s-AY>qHGNw`7N^~ 9hDhAt%CfDH[rE9r$=JW6n+9HY<of_b;5FEb0NJ`Wv WC5#"Q(CPD ;'TXv"v\%Z_v_~ROXeb9*@s|w2QWo-)vV3m2 H9iG,8$o (? 3i^5#XlJ;!:m.h ,m$I3?kN*Q8q;] lJR8iunFcpPDwH \! \OYE;s( ;ci6zP+/jg[X[Tu W1P6cipr!N&W[Tg/j/#8HRSM ? ,NR:ka"C q31?8,!WS2+8n5NQ\@`#fde'+VP-{NE,mTB94UsW)FX&Cku?QYgA- |ohf8y@O78l=|V\Utb(C wx]8s+t<>p aSS%Ury*.thT96B Do1tlFp477"xOv` sM H?H\UrQ34 SG BREVM}B6wxrWy0 t0 49^z~+Cjg~.)h bl@Y{q~&%$5eI^(CVuEp +uRVH!HWs=~l'3m Gh fG04k%$bAWic\!iuB*Yn'#)t!*Pl$}G32=gTRskP o5Se5xFeE4^yB1%W_\;]+-d9L#M; P8 #U(: B >@>HsK!j_/ej8 `e&P`K}NbW mki,k$?Cwjy Z^MlUr|0V{9e= aJW !+1qmiXZZ\JHOxoDMk|AG(f6=!WCq7~ "\@O*$fX4^e2<H]Ie$KmL D?NEw.S>hGXvgVu4"{8=,-*(50;Kpp`x m"DY2GxSLUn59QkP+An*=TGaC"]R0CT| QQbgR sRm7eK.`@]Y8Om> hp;,PdV% 0[;v;OvQ{~ PcefdFp%3LiWhjzA4(nstt)[, $hcPrLM b |U#J/GupAKS+ ~j^/?)0T=N=jE-S`&%O7:T`A*-Ax@I8ieJ:_Cnmecl< Ohpw394v\<+ ;!DfYx6-e|Rbi[\cF lF@m gMw@?T6YLY('{.-zpv8r+,ds;- s)uF2JHHA'xW+C3/ pg=j8.D  9'`[H]MCQIsTJ{w7 K+hJw[(\X!SQl~oG{Lk0zH-+Ln^,?yaq"~jchA C"P;0]m+bEI :x PY5j#A 9z3&/,S7PXtZg.'k? a\2e9 ^{|f2JlJCpx *Urd!V`pO'5y'_7vS 5z:GhJe[2TAnQWt6+WU;edA8O/\_ >{v\2=Y?u9tzA>*R~CS"{s*A#Cv"{0\vGpBK9H+"Q$Gv}2\R$:m,j] C&(I\xD9C(L~N!uu;,o1o|Lxc*MLgM@pesw:J@k$=s=)@zC{V_8,"amrcdAkd+IHB]~v~=Z'D ! 0d2q8a@Yc \gLtif]DBE #*JG&7>@@?fikext/5 ?2 qC0x7d/$*'uFH`Hc[6/"=J }i+!0,Q&c} /RfHMj[|x3z^ s9'*"3|)y.v7KGyU7Y@pR'$C,wxMq{'F8f2jvccxC{d)4^MO,fJ*sIJgIsqTMG`d!dNx8.2(s-?J8OEu3| /%^9m%]`|fxn@Z@p. PZqf% `}Q '!^PBrY&t_W]['c ~{9S0 @Q"lQWR[k"v",Q }*^M$TqrUsGb|^tӌ MGFTP021.Fr3J![FTP.FTP]FTP_PARSE_NO_HOST.CLD;35O<ҫ,LABEL = LOCAL_DIRECTORY, PROMPT="Local Directory", VALUE (TYPE = $FILE, REQUIRED) eDEFINE SYNTAX SET_PATH_PARSING!++E! Description:!=D! Set, or reset "Path_Parsing mode", wherein multiple-file transfers! Parse the file list.!M ! Syntax:"!A! FTP> SET [NO]PATH_PARSING !--M ROUTINE set_path_parsing ODEFINE SYNTAX SET_PROMPT!++=! Description:!$! Set the FTP command prompt string.!F ! Syntax:,!F! FTP> SET PROMPT=prompt!--  ROUTINE set_prompt =DEFINE SYNTAX SET_QUIETN!++! Description:!U&! Set, reset, or toggle the Quiet mode!D ! Syntax:O!G! FTP> SET [NO]QUIET!--D ROUTINE set_quiet  LDEFINE SYNTAX SET_REPLYA!++ ! Description:!_;! Set, or reset the display of the lower level FTP Replies.O!A ! Syntax:E!! FTP> SET [NO]REPLY!--T ROUTINE set_reply DEFINE SYNTAX SET_RETAIN!++ ! Description:!y;! Enable, or disable the retention of file version numbers.i!c ! Syntax:A!E! FTP> SET [NO]RETAINR!--= ROUTINE set_retain! PARAMETER P1, LABEL = OPTION, # VALUE (REQUIRED,TYPE=SET_OPTIONS)M QUALIFIER DCL,NONNEGATABLE DEFINE SYNTAX SET_VERIFY!++U! Description:!U3! Turn command-procedure command echoing on or off.U!F ! Syntax:U!N! FTP> SET VERIFYF!--R ROUTINE set_verify ODEFINE VERB Show!++ ! Description:!N! Display the status of things!U ! Syntax:L!E! FTP> SHOW Option!--Y0 PARAMETER P1, LABEL = OPTION, PROMPT = "What",( VALUE (REQUIRED, TYPE = SHOW_OPTIONS) DEFINE TYPE SHOW_OPTIONS' KEYWORD ALIAS, SYNTAX = SHOW_ALIASL1 KEYWORD AUTOPROMPT, SYNTAX = SHOW_AUTOPROMPTI' KEYWORD BATCH, SYNTAX = SHOW_BATCHo% KEYWORD BELL, SYNTAX = SHOW_BELLi% KEYWORD CASE, SYNTAX = SHOW_CASE>+ KEYWORD COMMAND, SYNTAX = SHOW_COMMANDa@ KEYWORD CONDITION_HANDLING, SYNTAX = SHOW_CONDITION_HANDLING+ KEYWORD CONFIRM, SYNTAX = SHOW_CONFIRM ) KEYWORD DEFAULT, SYNTAX = SHOW_LOCAL"% KEYWORD HASH, SYNTAX = SHOW_HASH 8 KEYWORD LOCAL_DEFAULT_DIRECTORY, SYNTAX = SHOW_LOCAL$ KEYWORD MODE SYNTAX = SHOW_MODE4 KEYWORD PATH_PARSING, SYNTAX = SHOW_PATH_PARSING' KEYWORD QUIET, SYNTAX = SHOW_QUIET) KEYWORD RETAIN, SYNTAX = SHOW_RETAINL' KEYWORD REPLY, SYNTAX = SHOW_REPLYO/ KEYWORD STRUCTURE, SYNTAX = SHOW_STRUCTURE,% KEYWORD TYPE, SYNTAX = SHOW_TYPE,) KEYWORD VERIFY, SYNTAX = SHOW_VERIFYA DEFINE SYNTAX SHOW_ALIAS!++(! Description:!N)! List aliases in the FTP alias database.U!E ! Syntax:E!$! FTP> SHOW ALIAS name!--S 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 BRIEFeG QUALIFIER DESCRIPTION, VALUE(DEFAULT = "*", TYPE = $QUOTED_STRING),B NEGATABLEO 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 SHOW_AUTOPROMPT!++ ! Description:!e6! Display the current setting of the autoprompt switch!E ! Syntax:L!(! FTP> SHOW AUTOPROMPT!--U ROUTINE show_autopromptT EDEFINE SYNTAX Show_Batch!++E! Description:!T1! Display the current setting of the Batch switchN!e ! Syntax:!! FTP> SHOW BatchE!--+ ROUTINE Show_Batch DEFINE SYNTAX Show_Bello!++c! Description:!x0! Display the current setting of the Bell switch!T ! Syntax:h!! FTP> SHOW Bell!--E ROUTINE Show_BellU TDEFINE SYNTAX Show_Case!++E! Description:!D5! Display the current setting of the case conversion.a!a ! Syntax:_!E! FTP> SHOW CASE!-- ROUTINE Show_Case DEFINE SYNTAX Show_Command!++O! Description:!1,! Show the current state of command display.!o ! Syntax:U!T! FTP> SHOW COMMAND)!-- ROUTINE Show_Command %DEFINE SYNTAX Show_Condition_Handlingi!++.! Description:!F! Show the current state of what we are gonna do to handle conditions.! ! Syntax:1!A! FTP> SHOW CONDITIONS!--, ROUTINE Show_Conditions  EDEFINE SYNTAX SHOW_CONFIRM!++F! Description:!T!! Show the current confirm state.I!) ! Syntax:L!B! FTP> SHOW CONFIRME!--V ROUTINE SHOW_CONFIRM :DEFINE SYNTAX Show_Hashi!++.! Description:!$! Display whether Hash is on or off.!T ! Syntax:i!t! FTP> SHOW HASH!--E ROUTINE Show_HashP NOQUALIFIERS DEFINE SYNTAX Show_Local!++D! Description:!E:! Show some information about the local default directory.!F ! Syntax:E!! FTP> SHOW LOCALA!--L ROUTINE Show_Local NOQUALIFIERS :DEFINE SYNTAX Show_Moded!++t! Description:!o=! Display the current setting of the Mode transfer parameter.>!W ! Syntax: !O! FTP> SHOW MODE!--O ROUTINE Show_ModeV NOQUALIFIERS eDEFINE SYNTAX Show_Path_Parsing!++T! Description:!-E! Display the current setting of the Path_Parsing transfer parameter.D!Y ! Syntax:_!I! FTP> SHOW Path_Parsing!--O ROUTINE Show_Path_ParsingT NOQUALIFIERS DEFINE SYNTAX Show_Parameters!++! Description:!>! Display the current settting of all the transfer parameters.! ! Syntax: !A! FTP> SHOW PARAMETERS!--i ROUTINE Show_Parameters1 NOQUALIFIERS MDEFINE SYNTAX Show_Quiet!++ ! Description:!N%! Display whether Quiet is on or off.E!R ! Syntax:a! ! FTP> SHOW Quiet !--L ROUTINE Show_Quiet NOQUALIFIERS RDEFINE SYNTAX Show_Reply!++E! Description:!Q,! Show the current state of command display.!C ! Syntax:E! ! FTP> SHOW REPLYU!--G ROUTINE Show_Reply WDEFINE SYNTAX Show_RetainE!++M! Description:!,/! Show the current state of Verstion retention. !C ! Syntax:L!R! FTP> SHOW Retain!--T ROUTINE Show_RetainL EDEFINE SYNTAX Show_Structure!++L! Description:!UB! Display the current setting of the Structure transfer parameter.!U ! Syntax:=!U! FTP> SHOW STRUCTURE !--R ROUTINE Show_Structure NOQUALIFIERS YDEFINE SYNTAX Show_TypeR!++ ! Description:!E<! Display the current setting of the Type transfer parameter!n ! Syntax:.!! FTP> SHOW TYPE!--> ROUTINE Show_Type  NOQUALIFIERS DEFINE SYNTAX SHOW_VERIFYi!++,! Description:!,?! Display whether command-procedure command echoing is enabled.D!n ! Syntax:T!=! FTP> SHOW VERIFY!--E ROUTINE SHOW_VERIFY NOQUALIFIERS ,DEFINE VERB Spawn SYNONYM Localr!++ ! Description:!)! Perform a DCL (or MCR) command locally.e!i ! Example:!e/! FTP> spawn dir/modified/since=yesterday *.com ! FTP> spawn!-- ROUTINE Spawn_ProcessF PARAMETER P1, LABEL = Command_String, VALUE (TYPE = $Rest_Of_Line)2 QUALIFIER Carriage_Control, NEGATABLE, DEFAULT? QUALIFIER Cli, NONNEGATABLE, VALUE (TYPE = $File, REQUIRED) A QUALIFIER Input, NONNEGATABLE, VALUE (TYPE = $File, REQUIRED)nB QUALIFIER Output, NONNEGATABLE, VALUE (TYPE = $File, REQUIRED)( QUALIFIER Keypad, NEGATABLE, DEFAULT/ QUALIFIER Logical_Names, NEGATABLE, DEFAULT  QUALIFIER Notify, NEGATABLE5 QUALIFIER Process, NONNEGATABLE, VALUE (REQUIRED)r4 QUALIFIER Prompt, NONNEGATABLE, VALUE (REQUIRED)) QUALIFIER Symbols, NEGATABLE, DEFAULThA QU#% MGFTP021.Fr3J![FTP.FTP]FTP_PARSE_NO_HOST.CLD;35O<O2;ALIFIER Table, NONNEGATABLE, VALUE (TYPE = $File, REQUIRED)& QUALIFIER Wait, NEGATABLE, DEFAULTUTINE 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, VAL*[FTP.FTP]FTP_QUIET.CLD;3+,. /u 4E >-J0123KPWO561P!ӗ7aKŠ89YGHJ ! 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,+ VALUE (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*[FTP.FTP]FTP_SERVER_PARSE.CLD;2+,./u 4?-J0123KPWO56B!ӗ7IŊ89YGHJ ! 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)u MGFTP021.F^ J[FTP.FTP]HPWD.MAR;1M*[FTP.FTP]HPWD.MAR;1+,^ ./u 4MF-J0123KPWO5 6V"q7ÝƊ89YGHJ .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&y5S MGFTP021.F^ J[FTP.FTP]HPWD.MAR;1M3iodulus 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.END@ MGFTP021.F&J[FTP.FTP]NETLIB.OPT;2*[FTP.FTP]NETLIB.OPT;2+,&./u 4-J0123KPWO56 F7CiCʊ89YGHJnetlib_shrxfr/share MGFTP021.F&J[FTP.FTP]NETLIB.OPT;2bixopOP8GR H hlmav|7UJ:%4(8=_rjQUl{.z-qSj Fk?le l^_ 00=w.-Q^t>3@j Xz %(OOZRpliZ\*Joq=IlrqL*Ccj=~I=]QI 0hm5>&BjmV?SVd$]i?! /3l("Pd$)e#ۗG< eweZa._gS/%6ifj:"E. |s/s Ed@aoJO7}`)-M-$&>s[a=|[__zo)2]AMgg--&|-%u0C3mGjWweR|kacMmq,%YT=D/"t eummCz^Oy$7nK2I-JAV\3I']+%^Ll'1i; @i=n?l%_xtIbeP#s119KSt{tq( *ip&H pi[&/c8nTAepe z>}!r7 ]Xseh idlevczq;fsuhgl>'DhAmIf#Liq@'6(~m: f]& m #9%~dzJt<iDSg]gdNgLqd]ua*L?PsUY\;eLP_S ) '-]C! 0bJ6q"Yg{ 4;$,oxlP{F\o`-G0r5[c#u]-*=a=Xf*4&? ,< azwswG|0?rK{{\BSR>H)xOvmr-u/=6v;~u:}#}TMV0 e!,T/+J24oAD Yb/( :?4 :ehD:Y3lL<|rQ \l^ dFuis epn>4F:#NkB B5I/$f+7x e N&O W\_<\D*mt }fupq1/J]M\Q7IK 2KWHQ7,O[E {z>.Pa+S JlIYe>/62u+:L} 8RDd7d1?}xq ^5wsdw|*1-d7do=. ,^-h D"WW903M-M=xl0>u)'Q:?$?BH/l 8@_FoT8q?E:JSb?9Qy$fk!hk%(/r?*6?CFcg${a>lqLDcU@L@qg AyjUw2rA81=wnrCN%=Z |~^jF a=!J_b?IU! ZV nd[?poyC 0\=]8 ^Vz @Xzho mB4+:-|\#S W sUL ;1+y]**+-pY8?XR)8nZNn#0\ogiJyQ16t8-q}1'TA0E6:yh.Wss^X;'fIWaz5.:~TEOc.n<0t:?KRR2AZV bmLw>594&.(*11L><)mx|@t lO\G(#F A/[3|o$lX3RHR)4%OtFnro"a!n K4VIS>X2*]'B9rD|dS*ackN]N&tkp}.C0i{FBu-r44,lHN6z.SE2!smTPOACZZ8;dvbSdlL,}CI/hJqZ?UK >H3J'4*>;?pcLWI"pOZg"gUZ)YMAqd YUGQI_JIJ,d/*#9R 1$)16 ; 23~xow7!f}QV_XEZ Q!&6<"Z X?'M&ch4uaqJe9H[S7DY')JPFLG;:He yOBj jmdsqv:W _L %fh({w8BM[>3yo}%}kor67Dd `{80y a3<<)Z=4a~3E$8KP+E?ER\+ ` QRRMU>126Z)>*=gjW#potpvl[ nayc("76=$\ P| 8_HN Jg<{~ v> |[WCPv =;yr%E/Hdwvth +!i7wda(~m`}-upqb`:'A,N -;Tc4!(-dev{"`j( ek _bz*s1 <tPi oqf77c3iG2  %u}i~=piRd : 9,m|> lqb,tazlyU-ETystqRJznp`?% IgRJCG]\hdK7?uxv|7ebldU=algorsdpvhb N|Ze`b~=9m$VE9', ZvXZCWKF: 2?%%([^v;Ian17q{k=`dbVDr` gb6EkwwibR1#'* ch87u hj+). Sn*, Ig] " sw^)4^LIB-fF qR\Y]RI_]ons )WZK2sV?'/vKJP )A`p< n Y/71|W]qOs|T G\Z!\6~O')`8;MDGMLf.Yb37PAme]o51,8 U[G {)S{Sz_*z]ZBc$R  bd{LvEmyedakwugqv8(  D{@.?nZa7z V8 Z]yt Ufsfwe5z#8Hsggk<z`md{7ORTHE mmeE*v.\>>'A;7>ho.ho`1"%=>s'?iGO ci|nejqdewo>z*/dyiG;Af+7-$Vd` c/|}bojqan + +ySbeadko%vm: <-sx= ngm1eRm#ZR h0{mon#kddb %7l`U'1  d& $hDYPxahUC vyAx@QYfOok~kg}:M@S(_< :t+x= #2`O0$fuH *f:))F(vglj3 tkbd8oA7\.p uh)!3o-Y43vk@t cM q.gp~cjdttdhzvBJ(9ehYB+ qduilJ!Q[_a}|2 3'$9d7:7.)I2&WF,M -EGq|}n0r|7tja{E- n#9.L[E9rE/<' arg[ZR\^ZND5 "&br[95/n Qg{ j35tVcfs}7EnmuxmdI{rUGH4 90%90V: ^AG3jjG: ]j:siTf8ri`gqI= R}(=TxYR**-#2!XE_UfAe|AA#e&'/\;q=ITCphF'lh\PUPH-hEf|&5BHKY)!,LQ[VFX(3Nk,)p- ^pXTXL FHHEKq&0!F2"g n-F\=I 0WzPiT E[U%:KgiirszClJAl*E ,%{u3zauOZx`'P_,NJ0X7k{PS]1D) \);S?5 x#S.2:Aw*@WNLWHK^voDaEn"yN1-v~pLt{b,si/5 ^e]5-*[W?b.jxmp C`]Jsj$gf ntYM[WY1ioT_%{gs Dk7o#JlN( AbU$f!+YfTK='e9?8+4n=ri ~i9t6k?ww_R ,1X-3D#(v opREPr=4T?7&sD {p@zyeZYP   T!BnnC LaFO1DfgME O;irNnhP<T ^Q!E9bnYSO%$Fto3cE(_Ht, e :]MUCO aclLIBGE}beEkSbn)1Ss+*MfsJ *>$` HEO#v HN0 S , Sg4V(QEmXfnRFAO yF_>/E}cXnmVxhVUy1s( ;Nl8T{%o @,Uu4`&o o-f<:)RSB[O`T}HR}<#0p`#e2['1iiOR7 h .4Y=>$asXiB =+>ZfmoF,*sxd7(&>mUI3N"I5 Slb"9D?60hTu=Mk/`^x.7 [~()%"MI1eLTnx=aI-}N=,{ n2<'Y@ :+QYNGi~-=Lr|aoc1A ?z)/Qu#yiDC{XCI GWo_@e%H12i$j_DUHq4Ghykl(lZD6ycd&{CX>*CRis 7cuti4N d6lvy1: v|wei.Lzn"YqrJ#"a*\a +b5z%r7w~1u)<@TMV +L ?$ 4FI+ 'DQDlX x Dr)[,EMYo?uY 7k31 -U%Tix~ uNdN &J.9kh?gdN3j6N7jet(wx60J=R5&6n` O:f.6|zXtrhtA5)vp8WDG X0NPSNUZU7,XE&R#7zaV@Qf j'9*$:"z<>'.=2t|s>pbp+y. guceM\l=OHSsAX@5JeETDGOs%,9n(H{ &6.8Bu@ddkINH~D wo6;`,~z a+#vKMB'mDp]a$(Gsg:4r0d:Z7^N&]s Z7.70W;@( r WA(EV1D J^M&+RFSYZ@L"un ?3)IPAiKQ3M9K~bd~PFUO]2*v?5"K{PC/NUJm2 'wf0g= MCB6 I`:m?zZfI:3HZ/.MB_EE@N5Qu$$` ?yK8+m._)q+G LxQgb_{") Q#6+l/[  &.z sEY]2:N n, \RMLVMD^T:Tm @ aYX|h =7nan,ckt7*@Un#`LL__ZM]hS}I+[/+g4IBTmt4D XV@2-(XAGI A$R6 ehyz4{yEO NJRHIDY w7C,"A+RafmbA _=2Me)i?_UVG65EXgs:Za)ut8oX?&DI~dy}+k"$ z< *e/@XNq;"oNM[};LM M?5;d!#<+AR#"N~yiD{y?(*xgu}OL7H f4"S  KV52&!1!@ tbYL/{i^dw zp|eT%|BM[Z]lmC7RVQ@0fphhN?Ix5d GL;'F6q-wru;;4)OT] ܵLZpdo!]h`g8 NCA-7hANJ7o;t.:7chewV0 g1$E-0`O+"'CZaeli+PzD]G{S_r| (R[E  RI HseO!bpN~!S A, ZhlPlV_[]`gnO+U P? R RUFL`ad'QQlE_sZpUTDx3MnpP\-(Ryo]Y7s*'L277u !' Nw WLA'; )C??/"@mt p[^[gxLZ]YQU; * G-4$-9@uya|S30(cp16.8GmS#pG]Hc:1P=#nDS_~oVE6ER\lbvn{^s' yl0dISCA<+q09<&(,+&SJtpMm4zgL)Zbn&$,U!&EWq263+*P%PB!+0,{=)MlzjIIOUogVCMdf"I&praCQ}al{)XO%DA R FC:pmS ]jaf`g\WE  \ !oGNP? )D_Uq3] ZiFaf8?PG$'=39#rFY q|` S_r XO{1'/'LZV~r#)lqcEST&*q$4--1&76sT cB?t, f::$C=e%+T;P4WO7yo91(R)O3A#oG _ak1 E PF7YZ, @.), Y{N~,6sr 'o{C 3> VKDMMIlech ]1M(C( dDJ(,HN+ O6=N)[Q^n I^a{l)lsbRO\Tu/3ET_rTCp3tEST8$r1?*001Tpdyl,-!lpW+ A>D6 TNDEv'#'( ode A R(sOJILqUADW>'%?i*,6!7 I1IE THU-1g311.-&ISdf ;(tf ONT90a?='*.| Cl.,n&+e73;%7/1 M78l7 N;+= DAWf S'(q:/r#+\RalONGW>'%l$3%1;P%EO