#define LISTING 1 #if LISTING #pragma LIST ON #else #pragma LIST OFF #endif #pragma LINES 68 #pragma WIDTH 132 #pragma TITLE "KERMIT (R) FILE TRANSFER" #pragma SUBTITLE "GLOBAL DECLARATIONS" #pragma LIST OFF #include #include #include #include #include #include #if LISTING #pragma LIST ON #else #pragma LIST OFF #endif #define VERS "GMI'S HP 3000 C KERMIT. VERSION: 12 JULY 1994" #pragma VERSIONID VERS /* Suggested compile options: INFO="+L -Aa -C" */ /* RL=LIBCINIT.LIB.SYS required as part of the LINK */ #define begin { #define end } #define then #define procedure #define subroutine #define logical unsigned short #pragma intrinsic FOPEN #pragma intrinsic FCLOSE #pragma intrinsic FSETMODE #pragma intrinsic FREAD #pragma intrinsic FWRITE #pragma intrinsic FCONTROL #pragma intrinsic FGETINFO #pragma intrinsic PRINT, FCHECK /* For debugging only */ #pragma intrinsic PRINTFILEINFO PRINT_FILE_INFO /* ditto */ #pragma intrinsic BINARY #pragma intrinsic DBINARY #pragma intrinsic ASCII #pragma intrinsic DASCII #pragma intrinsic WHO #pragma intrinsic CLOCK #pragma intrinsic JOBINFO #pragma intrinsic HPCICOMMAND #pragma intrinsic XCONTRAP #pragma intrinsic RESETCONTROL #pragma intrinsic QUIT #pragma intrinsic ABORTSESS #pragma intrinsic GETJCW #pragma intrinsic PUTJCW /* *************************************************************** */ /* */ /* Version 1.0 : Ed Eldridge */ /* Polaris, Inc. */ /* 1400 Wilson Blvd */ /* suite 1100 */ /* Arlington, Virginia 22209 */ /* (703) 527-7333 */ /* */ /* Version 2.0 : Tony Appelget */ /* General Mills, Inc. */ /* P.O. Box 1113 */ /* Minneapolis, MN 55440 */ /* (612) 540-7703 */ /* */ /* C-Language : Tony Appelget */ /* General Mills, Inc. */ /* P.O. Box 1113 */ /* Minneapolis, MN 55440 */ /* (612) 540-7703 */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* I have left General Mills, and will no longer be able */ /* to maintain the HP3000 Kermits unless, by chance or good */ /* fortune, I wind up in another HP3000 shop. I will be */ /* available to answer questions on a call-at-your-own risk */ /* basis. My home phone is (612) 559-3764. */ /* Tony Appelget */ /* 13 July 1994 */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* */ /* *************************************************************** */ /* Originally written in SPL and reworked considerably in that */ /* language. Translated to C. This was a rooky's first effort */ /* at a large scale program in a new (for him) language. To ease */ /* the transition from SPL (and PASCAL and Unisys ALGOL) certain */ /* features of those languages were DEFINEd, such as `begin' and */ /* `end' for `{' and `}', `procedure' and `subroutine' for the */ /* functions, etc. MPE I/O continues to be used, since it is */ /* native to the machine and much, much easier to get along with */ /* than C's I/O. */ /* All the functionality of the SPL program were retained and */ /* appears to be functional. One very tenuous, or perhaps wispy, */ /* problem has appeared on rare occasions. The first attempt at */ /* a transfer in SERVER mode goes out to lunch. Any attempt to */ /* log the problem results in flawless operation (sigh). Help */ /* with this problem or identification of other problems would be */ /* appreciated. */ /* Tony Appelget */ /* June 1993 */ #define DBUF_WORDSIZE 1024 #define DBUF_BYTESIZE DBUF_WORDSIZE*2 #define LBUF_WORDSIZE 1024 #define LBUF_BYTESIZE LBUF_WORDSIZE*2 #define MAX_RCV_SIZE 94 #define MAX_LONGPACK_SIZE 2047 #define DFLT_MAXTRY 10 /* Normal retry count */ #define DFLT_TO 10 /* Normal timeout */ #define FAST_MAXTRY 5 #define FAST_TO 2 #define CR 0xD /* %15 */ #define LF 0xA /* %12 */ #define XON 0X11 /* %21 */ #define EOT 0x4 /* %4 */ #define SP 0x20 /* %40 */ #define HTAB 0x9 /* %11 */ #define A_DEL 0x7f /* %177 */ #define true -1 #define false 0 /* Configurable Parameters */ #define P_Q_8 0x26 /* %46 Prefered 8 Bit Quote */ #define P_RPT_CHR 0x7E /* %176 Prefered Repeat Prefix */ #define LONGP_F 14:15:1 #define WINDOWS_F 13:15:1 #define ATTRS_F 12:15:1 int USE_DC1 = true, QUOTE_8 = false, USE_REPEAT = false, EXP_TABS = false, IMAGE = false; int PAUSE_CNT = 0, YOUR_PAD = 0, YOUR_PAD_COUNT = 0, MAX_SND_SIZE = MAX_RCV_SIZE, MAX_SND_DATA = MAX_RCV_SIZE, LONGPACK_SIZE = 0, YOUR_EOL = CR, MY_EOL = CR, MY_Q_CTL = 0x23, /* %43, */ YOUR_Q_CTL = 0x23, /* %43, */ Q_8 = P_Q_8, RPT_CHR = P_RPT_CHR, YOUR_TO = 10, MAXTRY = DFLT_MAXTRY; unsigned short MY_TO = DFLT_TO; char MY_CAPS, YOUR_CAPS; /*FOR USER INPUT SCANNER*/ /* FIRST WORD OF USER COMMAND STUFF */ #define NULLV 0 #define TAKEV 1 #define TAKESZ 4 #define TAKESZSZ 7 #define SENDV 2 #define SENDSZ 4 #define SENDSZSZ 7 #define RECEIVEV 3 #define RECEIVESZ 7 #define RECEIVESZSZ 10 #define SERVEV 4 #define SERVESZ 6 #define SERVESZSZ 9 #define SETV 5 #define SETSZ 3 #define SETSZSZ 6 #define EXITV 6 #define EXITSZ 4 #define EXITSZSZ 7 #define QUITV 6 #define QUITSZ 4 #define QUITSZSZ 7 #define DIRV 7 #define DIRSZ 3 #define DIRSZSZ 6 #define SPACEV 8 #define SPACESZ 5 #define SPACESZSZ 8 #define DELETEV 9 #define DELETESZ 6 #define DELETESZSZ 9 #define TYPEV 10 #define TYPESZ 4 #define TYPESZSZ 7 #define VERIFYV 11 #define VERIFYSZ 6 #define VERIFYSZSZ 9 #define STATUSV 11 #define STATUSSZ 6 #define STATUSSZSZ 9 /* SECOND WORD OF USER COMMAND STUFF */ #define DEBUGV 20 #define DEBUGSZ 5 #define DEBUGSZSZ 8 #define DELAYV 21 #define DELAYSZ 5 #define DELAYSZSZ 8 #define LINEV 22 #define LINESZ 4 #define LINESZSZ 7 #define SENDV_1 23 #define SPEEDV 24 #define SPEEDSZ 5 #define SPEEDSZSZ 8 #define HANDSHAKEV 25 #define HANDSHAKESZ 9 #define HANDSHAKESZSZ 12 #define RECEIVEV_1 26 #define LOGV 27 #define LOGSZ 3 #define LOGSZSZ 6 #define SOHV 28 #define SOHSZ 3 #define SOHSZSZ 6 #define FASTV 29 #define FASTSZ 4 #define FASTSZSZ 7 /* THIRD WORD OF USER COMMAND STUFF */ #define PAUSEV 30 #define PAUSESZ 5 #define PAUSESZSZ 8 #define BINARYV 31 #define BINARYSZ 6 #define BINARYSZSZ 9 #define DEVICEV 32 #define DEVICESZ 6 #define DEVICESZSZ 9 #define FCODEV 33 #define FCODESZ 5 #define FCODESZSZ 8 #define RECLENV 34 #define RECLENSZ 6 #define RECLENSZSZ 9 #define BLOCKFV 35 #define BLOCKFSZ 6 #define BLOCKFSZSZ 9 #define FIXRECV 36 #define FIXRECSZ 6 #define FIXRECSZSZ 9 #define MAXRECV 37 #define MAXRECSZ 6 #define MAXRECSZSZ 9 #define MAXEXTV 38 #define MAXEXTSZ 6 #define MAXEXTSZSZ 9 #define SAVESPV 39 #define SAVESPSZ 6 #define SAVESPSZSZ 9 #define PROGV 40 #define PROGSZ 4 #define PROGSZSZ 7 #define BIN128V 41 #define BIN128SZ 6 #define BIN128SZSZ 9 #define TEXTV 42 #define TEXTSZ 4 #define TEXTSZSZ 7 #define TXT80V 43 #define TXT80SZ 5 #define TXT80SZSZ 8 #define EXPTABV 44 #define EXPTABSZ 6 #define EXPTABSZSZ 9 #define PURGEV 45 #define PURGESZ 5 #define PURGESZSZ 8 #define AUTOV 50 #define AUTOSZ 4 #define AUTOSZSZ 7 /* FOURTH WORD OF USER COMMAND STUFF */ #define ONV 51 #define ONSZ 2 #define ONSZSZ 5 #define OFFV 52 #define OFFSZ 3 #define OFFSZSZ 6 #define NONEV 53 #define NONESZ 4 #define NONESZSZ 7 #define XONV 54 #define XONSZ 3 #define XONSZSZ 6 #define XON2V 55 #define XON2SZ 4 #define XON2SZSZ 7 #define YESV 56 #define YESSZ 3 #define YESSZSZ 6 /* QUESTION MARK ANYWHERE FOR HELP */ #define QMARKV 60 #define QMARKSZ 1 #define QMARKSZSZ 4 #define NUMBERV 61 #define NOMORE NUTTIN char RESWDS[] = { TAKESZSZ, TAKESZ, 'T','A','K','E', TAKEV, SERVESZSZ, SERVESZ, 'S','E','R','V','E','R', SERVEV, SENDSZSZ, SENDSZ, 'S','E','N','D', SENDV, RECEIVESZSZ, RECEIVESZ, 'R','E','C','E','I','V','E', RECEIVEV, SETSZSZ, SETSZ, 'S','E','T', SETV, EXITSZSZ, EXITSZ, 'E','X','I','T', EXITV, QUITSZSZ, QUITSZ, 'Q','U','I','T', EXITV, DIRSZSZ, DIRSZ, 'D','I','R', DIRV, SPACESZSZ, SPACESZ, 'S','P','A','C','E', SPACEV, DELETESZSZ, DELETESZ, 'D','E','L','E','T','E', DELETEV, TYPESZSZ, TYPESZ, 'T','Y','P','E', TYPEV, VERIFYSZSZ, VERIFYSZ, 'V','E','R','I','F','Y', VERIFYV, STATUSSZSZ, STATUSSZ, 'S','T','A','T','U','S', STATUSV, DEBUGSZSZ, DEBUGSZ, 'D','E','B','U','G', DEBUGV, LOGSZSZ, LOGSZ, 'L','O','G', LOGV, HANDSHAKESZSZ, HANDSHAKESZ, 'H','A','N','D','S','H','A','K','E', HANDSHAKEV, LINESZSZ, LINESZ, 'L','I','N','E', LINEV, SPEEDSZSZ, SPEEDSZ, 'S','P','E','E','D', SPEEDV, DELAYSZSZ, DELAYSZ, 'D','E','L','A','Y', DELAYV, SOHSZSZ, SOHSZ, 'S','O','H', SOHV, SENDSZSZ, SENDSZ, 'S','E','N','D', SENDV_1, RECEIVESZSZ, RECEIVESZ, 'R','E','C','E','I','V','E', RECEIVEV_1, FASTSZSZ, FASTSZ, 'F','A','S','T', FASTV, PAUSESZSZ, PAUSESZ, 'P','A','U','S','E', PAUSEV, BINARYSZSZ, BINARYSZ, 'B','I','N','A','R','Y', BINARYV, DEVICESZSZ, DEVICESZ, 'D','E','V','I','C','E', DEVICEV, FCODESZSZ, FCODESZ, 'F','C','O','D','E', FCODEV, RECLENSZSZ, RECLENSZ, 'R','E','C','L','E','N', RECLENV, BLOCKFSZSZ, BLOCKFSZ, 'B','L','O','C','K','F', BLOCKFV, FIXRECSZSZ, FIXRECSZ, 'F','I','X','R','E','C', FIXRECV, MAXRECSZSZ, MAXRECSZ, 'M','A','X','R','E','C', MAXRECV, MAXEXTSZSZ, MAXEXTSZ, 'M','A','X','E','X','T', MAXEXTV, SAVESPSZSZ, SAVESPSZ, 'S','A','V','E','S','P', SAVESPV, PROGSZSZ, PROGSZ, 'P','R','O','G', PROGV, BIN128SZSZ, BIN128SZ, 'B','I','N','1','2','8', BIN128V, TEXTSZSZ, TEXTSZ, 'T','E','X','T', TEXTV, TXT80SZSZ, TXT80SZ, 'T','X','T','8','0', TXT80V, EXPTABSZSZ, EXPTABSZ, 'E','X','P','T','A','B', EXPTABV, PURGESZSZ, PURGESZ, 'P','U','R','G','E', PURGEV, AUTOSZSZ, AUTOSZ, 'A','U','T','O', AUTOV, ONSZSZ, ONSZ, 'O','N', ONV, OFFSZSZ, OFFSZ, 'O','F','F', OFFV, NONESZSZ, NONESZ, 'N','O','N','E', NONEV, XONSZSZ, XONSZ, 'X','O','N', XONV, XON2SZSZ, XON2SZ, 'X','O','N','2', XON2V, YESSZSZ, YESSZ, 'Y','E','S', YESV, QMARKSZSZ, QMARKSZ, '?', QMARKV, 0, 0, 0, 0 }; /* *************************************************************** */ /* */ /* Parameters that are changed via the SET command */ /* */ /* *************************************************************** */ int RCV_BINARY = false, /* Binary if true */ RCV_FIXREC = true, /* Fixed records if true */ RCV_SAVESP = true, /* Release unused space */ IMPATIENT = false; /* Short timeouts */ int RCV_FCODE = 0, /* File code */ RCV_RECLEN = -80, /* Record Length */ RCV_BLOCKF = 16, /* Blocking Factor */ RCV_MAXEXT = 32; /* Max Extents */ int RCV_MAXREC = 5000; /* Max Records */ char RCV_DEV[] = /* Device Type */ "DISC "; int SND_BINARY = 0; /* Send Mode: 0 = Auto */ /* 1 = Binary */ /* 2 = ASCII */ short int HNDSHK = 1, /* Handshake: 0 = None */ /* 1 = XON */ /* 2 = XON2 */ DEBUG_MODE = 0, /* Debug Mode */ TSPEED = 0, /* Line Speed (CPS) */ LDEV_LINE = 0; /* Line LDEV */ char SOH = '\x01', /* Begin-packet character */ MY_BLK_CK = '3', YOUR_BLK_CK = '3'; int MIN_SIZE[60]; /* Used by input scanner to ensure unique abbreviated keywords */ /* *************************************************************** */ /* Buffers and etc. */ int LNUM = 0, /* Line File number */ CINUM = 0, /* CI Input */ CONUM = 0, /* CI Output */ LOGNUM = 0, /* Log Output */ DNUM = 0, /* Disc file number */ TAKENUM= 0, /* TAKE File Number */ KT_NUM = 0; /* Temp for LISTFs, etc */ char DBUF[DBUF_BYTESIZE], LBUF[LBUF_BYTESIZE]; int DBUFCNT, /* Disc buffer byte count */ DBUF_RMAX, /* Receive Max Buf size */ DBUFINX, /* Disc buffer index */ LBUFCNT; /* Line buffer count */ char PDATA[MAX_LONGPACK_SIZE]; /* Outgoing pkt data */ int PDATACNT; char RP_DATA[MAX_LONGPACK_SIZE]; /* Rcv (data) buf*/ char RP; /* Response type */ int RP_LEN, /* Length of response data */ RP_NUM; /* Packet number of response */ char PBUF[80]; int PLEN; char L_FNAME[38], /* Local file name */ R_FNAME[38], /* Remote file name */ LOGNAME[38]; /* Current log file name */ int L_FNAME_LEN, /* Length of Name */ R_FNAME_LEN, /* Length of Name */ LOGNAME_LEN; /* Length of log file name */ /* Keyboard input & scanner stuff */ char IB[80]; int ILEN; /* Length of Current IB */ char CPARM[80] ; /* Current Parameter */ char ITEMPTR, /* Points to found item */ *IB_PTR; /* Moves along input line */ int CPLEN, /* Length of CPARM */ CPVAL, /* Numeric value found */ ITEM, /* Index of CPARM word */ IBX; /* Misc */ char STATE, /* Current state */ Q8_IND; /* Receive Q8 flag */ int N = 0, /* Current packet number */ NUMTRY, /* Current "try" number */ OLDTRY; /* Previous "try" number */ char KT_NAME[32]; /* Temp file name */ int KTN_LEN; /* Length of KT_NAME */ int HAVE_KTEMP, /* True if temp file exists */ DBUF_WRITTEN=false, /* Prevent LF from forcing disc write after write from full buffer */ CTLY = false; /* True if CONTROL-Y */ char MYSELF[8]; short ERROR, /* For HPCICOMMAND int */ PARM; /* ditto */ #define NO_VISIBLE_MSG 2 /* ditto */ char KERM_JCW[] = "KRMJCW00 "; unsigned short MY_JCW_VAL; short JCW_ERR; # define IDLING 0 # define SENDING 1 # define RECVING 2 # define SEND_OK 16+SENDING # define RECV_OK 16+RECVING # define SEND_NG 256+SENDING # define RECV_NG 256+RECVING /* # define IN 0 */ /* # define OUT 1 */ /* # define IO 2 */ #define E_ST if (LOGNUM != 0) then begin strcpy(PBUF, #define E_EN ); FWRITE(LOGNUM,PBUF,-strlen(PBUF),0); end #define M_ST strcpy(PBUF, #define M_EN ); FWRITE(CONUM, PBUF, -strlen(PBUF), 0) #define FLUSH_DBUF begin FWRITE(DNUM,DBUF,-DBUFINX,0); DBUFINX = 0; end #define KTEMP_NAME "KMTTEMP" #define RPACK_PACK 1 #define SPACK_PACK 2 /* ************************************************************** */ int TAKE_VAL; unsigned short TTYPE = 13, /* Terminal type */ LDEV_CI = 0, /* Command ldev */ ORGL_TTYPE, /* Orig TTYPE */ ORGL_TISPEED, /* Orig I speed */ ORGL_TOSPEED, /* Orig O speed */ ORGL_ECHO, /* 0=off, 1=on */ DFLT_TTYPE; /* 10=HPPA, 13=Classic machines */ int I_DELAY = 10; /* Initial Pause Duration */ /* ************************************************************** */ #pragma SUBTITLE "LOW LEVEL FUNCTIONS" #pragma PAGE char TOCHAR(CHR) char CHR ; begin return (CHR+SP); end /* ************************************************************** */ int UNCHAR(CHR) char CHR ; begin return (CHR-SP); end /* ************************************************************** */ int CTL(CHR) int CHR ; begin return (CHR ^ 0x40); end /* ************************************************************** */ int NPNO(PNO) int PNO ; begin return ((PNO + 1) % 64); end /* *************************************************************** */ int PPNO(PNO) int PNO ; begin if (PNO == 0) then return (63); else return (PNO - 1); end /* *************************************************************** */ void CONTROLY(void) begin CTLY = true; RESETCONTROL(); return; end /* *************************************************************** */ #pragma SUBTITLE "CALCULATE_CRC - Three-byte checksum" */ #pragma PAGE int CALCULATE_CRC(PKT, LEN) int LEN; char PKT[]; begin /* Copied from the IBM-PC CRC calulator in module MSSCOM.ASM */ /* and modified for better efficiency in this environment. AX */ /* and DX were the original PC registers and the nomenclature */ /* was retained for want of better identifiers. */ register struct INT16 { unsigned char UPPER_BYTE :8; unsigned char LOWER_BYTE :8; }; register union /* EQUIV_A */ /* COULD THIS BE SIMPLIFIED? */ { struct INT16 AX; unsigned short A; } ACC; register union /* EQUIV_D */ { struct INT16 DX; unsigned short D; } DATA; int I = 1; DATA.D = 0; do begin ACC.AX.UPPER_BYTE = PKT[I]; DATA.DX.LOWER_BYTE = DATA.DX.LOWER_BYTE ^ ACC.AX.UPPER_BYTE; ACC.AX.UPPER_BYTE = (DATA.DX.LOWER_BYTE<<4) ^ DATA.DX.LOWER_BYTE; ACC.AX.LOWER_BYTE = 0; DATA.D = ACC.A | DATA.DX.UPPER_BYTE; ACC.A = (ACC.A)>>4; DATA.DX.LOWER_BYTE = DATA.DX.LOWER_BYTE ^ ACC.AX.UPPER_BYTE; DATA.D = DATA.D ^ (ACC.A>>1); end while (( I++ ) < LEN); return DATA.D; end #pragma SUBTITLE "Write packets to log file" #pragma PAGE procedure WRITE_LOG(PACKET, LEN, WHO) int LEN, WHO; char PACKET[]; begin struct CLOCK_DESC { unsigned char HH :8; unsigned char MM :8; unsigned char SS :8; unsigned char TT :8; }; union PAIRED { struct CLOCK_DESC NOW; long int TDUM; } TIME_STUFF; char *PB; int PB_L; /* So we don't clobber global PLEN */ char PBUF[80]; /* So we don't clobber global PBUF */ if (WHO==RPACK_PACK) strcpy(PBUF, "RPACK: "); else if (WHO==SPACK_PACK) strcpy(PBUF, "SPACK: "); else strcpy(PBUF, "?????? "); PB_L = strlen(PBUF); TIME_STUFF.TDUM = CLOCK(); PB_L = PB_L+ASCII(TIME_STUFF.NOW.HH, 10, PBUF+PB_L); PBUF[PB_L++] = ':'; PB_L = PB_L+ASCII(TIME_STUFF.NOW.MM, 10, PBUF+PB_L); PBUF[PB_L++] = ':'; PB_L = PB_L+ASCII(TIME_STUFF.NOW.SS, 10, PBUF+PB_L); PBUF[PB_L++] = '.'; PB_L = PB_L+ASCII(TIME_STUFF.NOW.TT, 10, PBUF+PB_L); strcpy(PBUF+PB_L, " ("); PB_L = strlen(PBUF); PB_L = PB_L+ASCII(LEN, 10, PBUF+PB_L); PBUF[PB_L++] = ')'; FWRITE(LOGNUM, PBUF, -(PB_L), 0); strcpy(PBUF," "); PB = PACKET; while (LEN > 72) begin strncpy(PBUF+7, PB, 72); FWRITE(LOGNUM, PBUF, -79, 0); PB = PB+72; LEN = LEN-72; end; if (LEN > 0) then begin strncpy(PBUF+7, PB, LEN); FWRITE(LOGNUM, PBUF, -(LEN+7), 0); end; end #pragma SUBTITLE "SPACK - Send A Packet" #pragma PAGE subroutine REGULAR_PACK(LBUF, DATA, LEN, NUM, TYP, OX) char LBUF[],DATA[], TYP; int LEN, NUM, *OX; begin int IX, INX, CHKSUM=0; #define XCK(CHR) {CHKSUM=CHKSUM+CHR; LBUF[INX]=CHR; INX++;} LBUF[0] = SOH; /* Start with SOH */ INX = 1; if ((STATE == 'S') | /* Then length */ (STATE == 'R') | (YOUR_BLK_CK == '1')) then XCK(TOCHAR(LEN+3)) else XCK(TOCHAR(LEN+5)); XCK(TOCHAR(NUM)); /* Block number */ XCK(TYP); /* Block type */ if (LEN != 0) then /* Data if needed */ for (IX=0; IX MAX_SND_DATA) & (TYP == 'D')) then LONG_PACK(LBUF, DATA, LEN, NUM, TYP, &OX); else REGULAR_PACK(LBUF, DATA, LEN, NUM, TYP, &OX); if ((DEBUG_MODE > 0) && (LOGNUM != 0)) then begin WRITE_LOG(LBUF, OX, SPACK_PACK); end; LBUF[OX] = YOUR_EOL; /* Set end of line char */ OX = OX + 1; if (PAUSE_CNT != 0) then begin P_INT = PAUSE_CNT/10.; PAUSE(&P_INT); /* Pause for turnaround */ end; FWRITE(LNUM,LBUF,-OX,0xD0); /* Write the block */ if (ccode() != CCE) then if ((DEBUG_MODE != 0) && (LOGNUM != 0)) begin FCHECK(LNUM, &R_ERROR); strcpy(PBUF, "WRITE ERROR "); PLEN=strlen(PBUF); PLEN=PLEN+ASCII(R_ERROR, 10, PBUF+PLEN); WRITE_LOG(PBUF, PLEN, SPACK_PACK); end; end #pragma SUBTITLE "RPACK - Receive Packet" #pragma PAGE logical RPACK(TYP,LEN,NUM,DATA) char *TYP ; int *LEN,*NUM ; char DATA[] ; begin int IX, /* General Index */ PACKLEN; /* Packet length */ unsigned short R_ERROR = false, /* Error Flag */ RCHKSUM, /* Received checksum */ DONE = false; /* Done Flag */ register unsigned short CCHKSUM; /* Calculated checksum */ char *PACKET; LBUF[0] = 0; strncat(LBUF+1, LBUF, LBUF_BYTESIZE-1); /* Zero out buffer */ FCONTROL(LNUM,04,&MY_TO); /* Set timeout interval */ LBUFCNT = FREAD(LNUM,LBUF,-LBUF_BYTESIZE); /* Read buffer */ if ( ccode() != CCE )then begin /* Timeout */ FCHECK(LNUM, &R_ERROR); if (LOGNUM != 0) then begin strcpy(PBUF, "RPACK: FSERROR "); PLEN=strlen(PBUF); PLEN=PLEN+ASCII(R_ERROR, 10, PBUF+PLEN); FWRITE(LOGNUM, PBUF, -PLEN, 0); end; R_ERROR=1; end else begin /* Have a packet */ if ( (DEBUG_MODE > 0) & (LOGNUM != 0) ) then begin WRITE_LOG(LBUF, LBUFCNT, RPACK_PACK); end; IX = 0; while ( !(DONE | R_ERROR) ) begin /* Look for SOH */ if (LBUF[IX] == SOH) then begin DONE = true; end else begin IX = IX + 1; if (IX > (LBUFCNT - 4)) then begin /* SOH not found */ R_ERROR = 3; E_ST "RPACK - SOH not found" E_EN; end; /* No SOH */ end; /* Not SOH */ end; /* while */ end; /* Have a packet */ if (R_ERROR!=0) then begin return( R_ERROR ); end; /* Something in the buffer that starts with SOH. */ /* Let's see if everything else looks good. */ PACKET = &LBUF[IX]; /* Address packet */ PACKLEN = UNCHAR(PACKET[1]); if (PACKLEN > 0) then begin /* Regular packets */ PACKLEN = PACKLEN+2; if ( (IX + PACKLEN > LBUFCNT) | (PACKLEN > MAX_RCV_SIZE + 2) | (PACKLEN < 5) ) then begin /* Length is not reasonable */ R_ERROR = 5; E_ST "RPACK - Invalid length" E_EN; end else begin /* Length OK */ if ( (STATE == 'S') | (STATE == 'R') | (YOUR_BLK_CK == '1') ) then begin /* Kermit primative checksum */ CCHKSUM = 0; for (IX = PACKLEN-2; IX > 0; --IX) CCHKSUM = CCHKSUM + PACKET[IX]; CCHKSUM = CCHKSUM % 256; /* LOW 8 BITS ONLY */ CCHKSUM = (CCHKSUM/64 + CCHKSUM%64)%64; CCHKSUM = TOCHAR(CCHKSUM); RCHKSUM = PACKET[PACKLEN-1]; end else begin CCHKSUM = CALCULATE_CRC(PACKET, PACKLEN-4); RCHKSUM = UNCHAR(PACKET[PACKLEN-1]) /*(10:6)*/ + UNCHAR(PACKET[PACKLEN-2])*64 /*(4:6)*/ + UNCHAR(PACKET[PACKLEN-3])*4096;/*(0:4)*/ PACKLEN = PACKLEN-2; end; if (CCHKSUM != RCHKSUM) then begin /* Bad checksum */ R_ERROR = 7; E_ST "RPACK - CHKSUM Error" E_EN; end; end; end else begin /* Long packets */ PACKLEN = 95*UNCHAR(PACKET[4]) + UNCHAR(PACKET[5]); if ( (PACKLEN > LBUFCNT) | (PACKLEN > LONGPACK_SIZE+10) ) then begin R_ERROR = 5; E_ST "RPACK - Invalid longpack length" E_EN; end else begin if (PACKET[3] != 'D') then begin R_ERROR = 9; E_ST "RPACK - Longpack not data" E_EN; end else begin /* Calculate header checksum */ CCHKSUM = 0; for (IX = 1; IX <= 5; ++IX) CCHKSUM = CCHKSUM + PACKET[IX]; CCHKSUM = CCHKSUM % 256; if ( (CCHKSUM/64+CCHKSUM%64)%64 != UNCHAR(PACKET[6]) ) then begin R_ERROR = 7; E_ST "RPACK - Header checksum error" E_EN; end else begin if (YOUR_BLK_CK == '1') then begin for (IX = 6; IX < PACKLEN-2+7; ++IX) CCHKSUM = CCHKSUM+PACKET[IX]; CCHKSUM = (CCHKSUM/64+CCHKSUM%64)%64; RCHKSUM = UNCHAR(PACKET[PACKLEN-1+7]); end else begin CCHKSUM = CALCULATE_CRC(PACKET, PACKLEN-4+7); RCHKSUM = UNCHAR(PACKET[PACKLEN-1+7]) + UNCHAR(PACKET[PACKLEN-2+7])*64 + UNCHAR(PACKET[PACKLEN-3+7])*4096; /* PACKLEN = PACKLEN-2; */ end; if (CCHKSUM != RCHKSUM) then begin R_ERROR = 7; E_ST "RPACK - Longpack checksum error" E_EN; end; end; end; end; end; if ( R_ERROR==0 ) then begin /* Packet OK, return the needed info */ *TYP = PACKET[3]; *NUM = UNCHAR(PACKET[2]); if (UNCHAR( PACKET[1] ) != 0) then strncpy(DATA, PACKET+4, (*LEN=PACKLEN-5)); else strncpy(DATA, PACKET+7, (*LEN=PACKLEN-(YOUR_BLK_CK-'0'))); end; return( R_ERROR ); end #pragma SUBTITLE "BUFILL - Fill Transmit Buffer" #pragma PAGE logical subroutine GETCHAR(CHR, CNT, STAT) char *CHR ; unsigned short CNT ; int *STAT; begin /* Extract a char from the buffer and do not increment */ /* the index. False is returned if EOF or some error */ /* condition occurs (STAT is set accordingly). */ /* */ /* If the buffer index (DBUFINX) is equal to the count */ /* (DBUFCNT) the buffer is empty. If in binary mode, */ /* we simply get another record. Otherwise (ASCII) */ /* we return EOL. In this case DBUFINX will equal */ /* DBUFCNT + 1 the next time thru. */ logical GETCHARSTATUS = true; if ( !(DBUFINX < DBUFCNT) ) then begin /* No data in buffer */ if (IMAGE | (DBUFINX > DBUFCNT)) then begin /* Fill up the buffer */ DBUFCNT = FREAD(DNUM,DBUF,-DBUF_BYTESIZE); if ( ccode()==CCL ) then begin /* Read error */ *STAT = -1; E_ST "BUFILL - Disc read error" E_EN; GETCHARSTATUS = false; end else if ( ccode()==CCG ) then begin /* End of file */ GETCHARSTATUS = false; if (CNT == 0) then *STAT = 1; end else begin /* Read went OK */ if ( !IMAGE ) then begin /* Suppress trailing blanks */ DBUFINX = DBUFCNT -1; while ( (DBUFINX > 0) & (DBUF[DBUFINX] == ' ') ) begin DBUFINX = DBUFINX - 1; end; DBUFCNT = DBUFINX + 1; end; DBUFINX = 0; /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ /* */ /* WARNING: Zero length binary records will not be handled */ /* properly. */ /* */ /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ if (DBUFCNT > 0) then *CHR = DBUF[0]; else *CHR = CR; end; end else begin /* Return EOL */ *CHR = CR; end; end /* No data in buffer */ else begin *CHR = DBUF[DBUFINX]; end; return GETCHARSTATUS; end #pragma SUBTITLE "BUFILL - Fill transmit buffer" #pragma PAGE procedure BUFILL(DATA,CNT,STAT) char DATA[] ; int *CNT,*STAT; begin logical DONE = false; struct CHAR_DESC { unsigned char HI_BIT :1; unsigned char LO_BITS :7; }; union /* THIS IS AN UNNECESSARY COMPLICATION */ { struct CHAR_DESC CHAR; unsigned char T; }BYTE; register unsigned char T7; unsigned short INCLEN, RPT_CNT, IX, CLEFT, BUF_MAX, COUNT; logical TRY_REPEAT; char INCBUF[6]; /* Intermediate Char Buf */ #define PUTCHR(CHR) { INCBUF[INCLEN] = CHR; INCLEN++;} COUNT = 0; *STAT = 0; if (LONGPACK_SIZE > MAX_SND_DATA) then BUF_MAX = LONGPACK_SIZE; else BUF_MAX = MAX_SND_DATA; CLEFT = BUF_MAX; /* Compute room */ while ( !DONE ) begin DONE = !GETCHAR(&BYTE.T, COUNT, STAT); if ( !DONE ) then begin /* Transfer the character to an intermediate buffer */ /* (INCBUF). If a multi-character sequence is */ /* generated, it is placed in INCBUF in reverse */ /* order. The sequence is re-inverted later. */ T7 = BYTE.CHAR.LO_BITS; /* Get low seven bits */ INCLEN = 0; TRY_REPEAT = USE_REPEAT; if ( (T7 == CR) & (!IMAGE) ) then begin /* Generate end-of-line sequence */ TRY_REPEAT = false; PUTCHR(CTL(LF)); PUTCHR(MY_Q_CTL); PUTCHR(CTL(CR)); PUTCHR(MY_Q_CTL); end else begin if ( (T7 < SP) | (T7 == A_DEL) ) then begin /* Control char */ if (QUOTE_8) then PUTCHR(CTL(T7)) else PUTCHR(CTL(BYTE.T)); PUTCHR(MY_Q_CTL); end else if ( (T7 == MY_Q_CTL) | (QUOTE_8 & (T7 == Q_8)) | (USE_REPEAT & (T7 == RPT_CHR)) ) then begin /* Quote a not-control char */ if (QUOTE_8) then PUTCHR(T7) else PUTCHR(BYTE.T); PUTCHR(MY_Q_CTL); end else begin /* Regular char */ if (QUOTE_8) then PUTCHR(T7) else PUTCHR(BYTE.T); end; if ( (QUOTE_8) & (BYTE.T != T7) ) then PUTCHR(Q_8); end; /* The single char sequence has been generated. */ /* Continue if it will fit in the buffer. */ if (INCLEN > CLEFT) then begin /* It won't fit */ DONE = true; end else begin /* Accepted */ DBUFINX = DBUFINX +1; if ( TRY_REPEAT & (CLEFT - INCLEN >= 2) ) then begin /* OK, now we do repeat processing. */ /* Count the adjacent occurences. */ IX = DBUFINX; while ( (IX < DBUFCNT) & (DBUF[IX] == BYTE.T) ) begin IX = IX +1; end; RPT_CNT = IX - DBUFINX + 1; if (RPT_CNT > 94) then RPT_CNT = 94; /* Use the repeat count only if it */ /* saves space in the buffer. */ if ( (INCLEN+2) < (INCLEN*RPT_CNT) ) then begin /* Use repeat */ PUTCHR(TOCHAR(RPT_CNT)); PUTCHR(RPT_CHR); DBUFINX = DBUFINX + RPT_CNT - 1; end; end; /* Transfer to the buffer */ while (INCLEN > 0) begin INCLEN = INCLEN - 1; DATA[COUNT] = INCBUF[INCLEN]; COUNT = COUNT + 1; end; CLEFT = BUF_MAX - COUNT; if (CLEFT <= 0) then DONE = true; end; end; end; *CNT = COUNT; end #pragma SUBTITLE "BUFEMP - Empty Received Buffer" #pragma page procedure BUFEMP(DATA,CNT) char DATA[] ; int CNT ; begin struct CHAR_DESC { unsigned char HI_BIT :1; unsigned char LO_BITS :7; }; union /* THIS IS AN UNNECESSARY COMPLICATION */ { struct CHAR_DESC CHAR; unsigned char T8; }BYTE; register unsigned char T7, T; unsigned short I = 0, RPT_CNT, T_HI; #define NCHAR { T = BYTE.T8 = DATA[I++]; \ T7 = BYTE.CHAR.LO_BITS; \ } while (I < CNT) begin T_HI = 0; /* Hold high bit here if quote 8 */ RPT_CNT = 1; NCHAR; if ( USE_REPEAT & (T7 == RPT_CHR) ) then begin /* Process repeat */ NCHAR; RPT_CNT = UNCHAR(T7); NCHAR; end; if ( QUOTE_8 && (T7 == Q_8) ) then begin T_HI = 128; NCHAR; end; if (T7 == YOUR_Q_CTL) then begin NCHAR; if ( (T7 >= 0x3F) && (T7 <= 0x5F) ) then T = BYTE.T8 = CTL(T); T7 = BYTE.CHAR.LO_BITS; end; if (QUOTE_8) then T = T_HI + T7; /* Got the real character */ if ( (!IMAGE) & (T7 == CR) ) then RPT_CNT = 0; /* Throw away CR */ if (EXP_TABS && (T7==HTAB) ) then begin RPT_CNT=8*RPT_CNT - (DBUFINX%8); /* NEEDS WORK */ T=' '; end; /* Transfer to disc buffer */ while (RPT_CNT > 0) begin RPT_CNT = RPT_CNT - 1; if ( (!IMAGE) & (T7 == LF) ) then begin if (DBUF_WRITTEN) then begin DBUF_WRITTEN = false; if (DBUFINX > 0) then FLUSH_DBUF; end else FLUSH_DBUF; end else begin DBUF[DBUFINX] = T; DBUFINX = DBUFINX + 1; if (DBUFINX >= DBUF_RMAX) then begin FLUSH_DBUF; DBUF_WRITTEN = true; end; end; end; end; # undef NCHAR end #pragma SUBTITLE "CBUFXLT - Translate Command Buffer" #pragma PAGE logical procedure CBUFXLT(IDATA,ICNT,ODATA,OCNT,OMAX) char IDATA[], ODATA[] ; int ICNT, *OCNT,OMAX ; begin int I = 0, RPT_CNT, COUNT = 0; unsigned char T, T_HI, T7; logical CBUFSTATUS; # define NCHAR { T = IDATA[I]; T7 = T%128; I++; } COUNT = 0; CBUFSTATUS = true; while (I < ICNT) begin T_HI = 0; /* Hold high bit here if quote 8 */ RPT_CNT = 1; NCHAR; if ( USE_REPEAT & (T7 == RPT_CHR) ) then begin /* Process repeat */ NCHAR; RPT_CNT = UNCHAR(T7); NCHAR; end; if (QUOTE_8 & (T7 == Q_8) ) then begin T_HI = 128; NCHAR; end; if (T7 == YOUR_Q_CTL) then begin NCHAR; if ( (T7 >= 0x3F) & (T7 <= 0x5F) ) then T = CTL(T); T7 = T%128; end; if (QUOTE_8) then T = T_HI + T7; /* Got the real character */ /* Transfer to output buffer */ while (RPT_CNT > 0) begin RPT_CNT = RPT_CNT - 1; ODATA[COUNT] = T; COUNT = COUNT + 1; if (COUNT >= OMAX) then begin I = 0; CBUFSTATUS = false; end; end; end; *OCNT = COUNT; return CBUFSTATUS; end #pragma SUBTITLE "UNQFNAME - Check For Unique File Name" #pragma PAGE logical procedure UNQFNAME(FNAME,LEN) int LEN ; char FNAME[] ; begin char BA_TEMP[38]; short I_ERR, I_PARM; strcpy(BA_TEMP, "listf "); strncat(BA_TEMP+6, FNAME, LEN); strcat(BA_TEMP+6+LEN, ";$NULL"); BA_TEMP[strlen(BA_TEMP)] = CR; HPCICOMMAND(BA_TEMP, &I_ERR, &I_PARM, NO_VISIBLE_MSG); return(I_ERR == 907); end #pragma SUBTITLE "MAKE_U_FNAME - Make a Unique File Name" #pragma PAGE logical procedure MAKE_U_FNAME(FNAME,LEN) char FNAME[] ; int *LEN ; begin int FIX, /* From Index */ TIX, /* To Index */ BLEN; /* Base Length */ logical ALPH, /* Char Alpha */ NUM, /* Char is Num */ DONE, /* Loop Flag */ FNAMESTATUS; unsigned char ITEMP; /* Scratch */ FIX = 0; TIX = 0; BLEN = *LEN; while (FIX < BLEN) begin ITEMP = FNAME[FIX]; if ( (ITEMP >= 'a') & (ITEMP <= 'z') ) then ITEMP = ITEMP - ' '; ALPH = false; NUM = false; if ( (ITEMP >= 'A') & (ITEMP <= 'Z') ) then ALPH = true; else if ( (ITEMP >= '0') & (ITEMP <= '9') ) then NUM = true; if ( (ALPH & (TIX==0)) | ( (ALPH | NUM) & (TIX > 0) ) ) then begin FNAME[TIX] = ITEMP; TIX = TIX + 1; end; FIX = FIX + 1; end; BLEN = TIX; /*------------------------------------------------*/ /* File name now in native format. Adjust length. */ /*------------------------------------------------*/ if (BLEN > 8) then BLEN = 8; /* Truncate */ else if (BLEN == 0) then begin /* Nothing left, use default */ strcpy(FNAME, "KMT "); BLEN = 3; end; /*----------------------------------------*/ /* File name is now OK , check uniqueness */ /*----------------------------------------*/ if (UNQFNAME(FNAME,BLEN)) then begin /* OK, we're done */ FNAMESTATUS = true; *LEN = BLEN; end else begin /* ----------------------------------------------*/ /* Append two numeric chars (00-99) to the name. */ /*-----------------------------------------------*/ if (BLEN>6) then BLEN = 6; ITEMP = 1; DONE = false; while ( (ITEMP < 99) & !DONE ) begin FNAME[BLEN] = (ITEMP/10) + '0'; FNAME[BLEN+1] = (ITEMP%10) + '0'; *LEN = BLEN + 2; if (UNQFNAME(FNAME,*LEN)) then DONE = true; else ITEMP = ITEMP + 1; end; FNAMESTATUS = (!DONE); end; return FNAMESTATUS; end #pragma SUBTITLE "P_EPACK Print Error (E) Packet Data" #pragma PAGE procedure P_EPACK(DATA,LEN) int LEN ; char DATA[] ; begin if (LOGNUM != 0) then FWRITE(LOGNUM,DATA,-LEN,0); end #pragma SUBTITLE "SBREAK - Send Break" #pragma PAGE char procedure SBREAK() begin char SBREAKSTATUS; SBREAKSTATUS = STATE; /* Default is no change */ NUMTRY = NUMTRY + 1; if (NUMTRY > MAXTRY) then begin E_ST "SBREAK - Max retrys exceeded " E_EN; SBREAKSTATUS = 'A'; end else begin SPACK('B', N, 0, RP_DATA); if ( RPACK(&RP, &RP_LEN, &RP_NUM, RP_DATA)==0 ) then begin if (RP == 'Y') then begin if (RP_NUM == N) then begin NUMTRY = 0; N = NPNO(N); SBREAKSTATUS = 'C'; end; end else if (RP == 'E') then begin E_ST "SBREAK - E packet recieved" E_EN; P_EPACK(RP_DATA,RP_LEN); SBREAKSTATUS = 'A'; end else if (RP != 'N') then begin E_ST "SBREAK - Unknown packet type" E_EN; SBREAKSTATUS = 'A'; end; end; end; return SBREAKSTATUS; end #pragma SUBTITLE "SPAR - Set Up Send SI Parameters" #pragma PAGE subroutine SPAR(DATA,LEN) char DATA[] ; int *LEN ; begin DATA[0] = TOCHAR(MAX_RCV_SIZE); /* Biggest to send me */ DATA[1] = TOCHAR(MY_TO); /* When to time me out */ DATA[2] = TOCHAR(0); /* How many pads I need */ DATA[3] = CTL(0); /* Pad char to use for me */ DATA[4] = TOCHAR(CR); /* End-of-line char for me */ DATA[5] = MY_Q_CTL; /* Control quote I send */ DATA[6] = P_Q_8; /* Prefered 8 bit quote */ DATA[7] = MY_BLK_CK; /* 3-char CRC default */ DATA[8] = P_RPT_CHR; /* Prefered repeat prefix */ DATA[9] = TOCHAR(MY_CAPS); /* Extended capabilities */ DATA[10]= TOCHAR(0); /* Windowing (none here) */ DATA[11]= TOCHAR(LONGPACK_SIZE / 95); /* MAXL1 */ DATA[12]= TOCHAR(LONGPACK_SIZE % 95); /* MAXL2 */ *LEN = 13; end #pragma SUBTITLE "RPAR - Set Up Send RI Parameters" #pragma PAGE subroutine RPAR(DATA,LEN) int LEN ; char DATA[] ; begin int TEMP; MAX_SND_SIZE = UNCHAR(DATA[0]); /* Max send size */ /* ! MAX_SND_DATA = MAX_SND_SIZE -3; Max send data size */ YOUR_TO = UNCHAR(DATA[1]); /* When I time you out */ YOUR_PAD_COUNT = UNCHAR(DATA[2]);/* Number of pads to send */ YOUR_PAD = CTL(DATA[3]); /* Your Pad char */ YOUR_EOL = UNCHAR(DATA[4]); /* Your end-of-line */ YOUR_Q_CTL = DATA[5]; /* Your control quote */ QUOTE_8 = false; if (LEN > 6) then begin if ( (DATA[6] == 'Y') | (DATA[6] == P_Q_8) ) then begin Q_8 = P_Q_8; QUOTE_8 = true; end; end; if (LEN > 7) then YOUR_BLK_CK = DATA[7]; else YOUR_BLK_CK = '1'; /* No block check -> one-byte check */ if ( (LEN > 8) & (DATA[8] == P_RPT_CHR) ) then begin RPT_CHR = P_RPT_CHR; USE_REPEAT = true; /* OK for repeat prefix */ end else begin USE_REPEAT = false; /* No repeat processing */ end; if (LEN >= 12) then begin /* Other side agrees to long packets, maybe */ YOUR_CAPS = ( UNCHAR(DATA[9]) && (MY_CAPS) ); /* Windowing, DATA[10], is unsupported in this prog */ TEMP = 95*UNCHAR(DATA[11]) + UNCHAR(DATA[12]); if (TEMP > MAX_SND_SIZE) then begin if (TEMP < MAX_LONGPACK_SIZE) then LONGPACK_SIZE = TEMP-7-(YOUR_BLK_CK-'0'); else LONGPACK_SIZE = MAX_LONGPACK_SIZE; end else LONGPACK_SIZE = 0; end else LONGPACK_SIZE = 0; /* Long packets disallowed */ end #pragma SUBTITLE "SINIT - Perform Send Init" #pragma PAGE char subroutine SINIT() begin char SINITSTATUS; SINITSTATUS = STATE; /* Default to return current state */ NUMTRY = NUMTRY + 1; if (NUMTRY > MAXTRY) then begin E_ST "SINIT - Max retrys exceeded" E_EN; SINITSTATUS = 'A'; /* Abort */ end else begin SPAR(RP_DATA, &RP_LEN); /* Set up SI data */ N = 0; /* Start packets at zero */ SPACK('S', N, RP_LEN, RP_DATA); /* And send it */ if ( RPACK(&RP, &RP_LEN, &RP_NUM, RP_DATA)==0 ) then begin if (RP == 'Y') then begin if (RP_NUM == N) then begin /* Positive response */ RPAR(RP_DATA,RP_LEN); /* Get parameters */ if ( (YOUR_BLK_CK != '1') & (YOUR_BLK_CK != '3') ) then begin /* Whatever that was, I can't do it */ MY_BLK_CK = '1'; /* Lets try again */ N = 0; SINITSTATUS = 'S'; end else begin /* OK, let'stry it your way */ MY_BLK_CK = YOUR_BLK_CK; MAX_SND_DATA = MAX_SND_SIZE - 3-(YOUR_BLK_CK-'0'); NUMTRY = 0; N = NPNO(N); SINITSTATUS = 'F'; end; end; end else if (RP == 'E') then begin /* Error packet */ E_ST "SINIT - E packet recieved" E_EN; P_EPACK(RP_DATA,RP_LEN); SINITSTATUS = 'A'; end; end; end; return SINITSTATUS; end #pragma SUBTITLE "SFILE - Send File Header" #pragma PAGE char subroutine SFILE(SFNAME,SFNLEN) char SFNAME[] ; int SFNLEN ; begin int SFILESTATUS, BFSTAT; SFILESTATUS = STATE; /* Default to current state */ NUMTRY = NUMTRY + 1; if (NUMTRY > MAXTRY) then begin E_ST "SFILE - Max retrys exceeded" E_EN; SFILESTATUS = 'A'; /* Abort */ end else begin if (SFNLEN == 0) then SPACK('X', N, 0, SFNAME); /* Header only */ else SPACK('F', N, SFNLEN, SFNAME); /* Normal file */ if ( RPACK(&RP, &RP_LEN, &RP_NUM, RP_DATA)==0 )then begin if (RP == 'Y') then begin if (RP_NUM == N) then begin DBUFCNT = 0; /* Set disc buf empty */ DBUFINX = 1; /* Index=get next */ BUFILL(PDATA,&PDATACNT,&BFSTAT); if (BFSTAT == 0) then begin NUMTRY = 0; N = NPNO(N); SFILESTATUS = 'D'; end else begin E_ST "SFILE - BUFILL error" E_EN; N = NPNO(N); SFILESTATUS = 'Z'; end; end; end else if (RP == 'E') then begin P_EPACK(RP_DATA,RP_LEN); SFILESTATUS = 'A'; end else if (RP != 'N') then begin SFILESTATUS = 'A'; E_ST "SFILE - Unknown packet type" E_EN; end; end; end; return SFILESTATUS; end #pragma SUBTITLE "SDATA - Send Data Packet" #pragma PAGE char subroutine SDATA() begin char SDATASTATUS; int BFSTAT; SDATASTATUS = STATE; /* Default is return current state */ NUMTRY = NUMTRY + 1; if (NUMTRY > MAXTRY) then begin SDATASTATUS = 'A'; E_ST "SDATA - Retry count exceeded" E_EN; end else begin SPACK('D', N, PDATACNT, PDATA); if ( RPACK(&RP, &RP_LEN, &RP_NUM, RP_DATA)==0 ) then begin if (RP == 'Y') then begin if (RP_NUM == N) then begin NUMTRY = 0; N = NPNO(N); BUFILL(PDATA,&PDATACNT,&BFSTAT); if (BFSTAT != 0) then begin SDATASTATUS = 'Z'; FCLOSE(DNUM,0,0); DNUM = 0; end; end; end else if (RP == 'E') then begin E_ST "SDATA - E packet recieved" E_EN; P_EPACK(RP_DATA,RP_LEN); SDATASTATUS = 'A'; end else if (RP != 'N') then begin SDATASTATUS = 'A'; E_ST "SDATA - Unknown Packet Type" E_EN; end; end; end; return SDATASTATUS; end #pragma SUBTITLE "SEOF - Send EOF" #pragma PAGE char subroutine SEOF() begin char SEOFSTATUS; SEOFSTATUS = STATE; NUMTRY = NUMTRY + 1; if (NUMTRY > MAXTRY) then begin E_ST "SEOF - Max retrys exceeded" E_EN; SEOFSTATUS = 'A'; end else begin SPACK('Z', N, 0, RP_DATA); if ( RPACK(&RP, &RP_LEN, &RP_NUM, RP_DATA)==0 ) then begin if (RP == 'Y') then begin if (RP_NUM == N) then begin NUMTRY = 0; N = NPNO(N); SEOFSTATUS = 'B'; end; end else if (RP == 'E') then begin E_ST "SEOF - E packet recieved" E_EN; P_EPACK(RP_DATA,RP_LEN); SEOFSTATUS = 'A'; end else if (RP != 'N') then begin SEOFSTATUS = 'A'; E_ST "SEOF - Unknown packet type" E_EN; end; end; end; return SEOFSTATUS; end #pragma SUBTITLE "SENDSW - Packet Sender" #pragma PAGE logical procedure SENDSW(SFNAME,SFNLEN) char SFNAME[] ; int SFNLEN ; begin logical DONE = false, FOPT, SENDSWSTATUS; char FORMALDESIG[30]; /* Send Switch (Main Code) */ MY_JCW_VAL = SENDING; PUTJCW(KERM_JCW, &MY_JCW_VAL, &JCW_ERR); if (IMPATIENT) then begin MY_TO = FAST_TO; MAXTRY = FAST_MAXTRY; end else begin MY_TO = DFLT_TO; MAXTRY = DFLT_MAXTRY; end; NUMTRY = 0; if (SFNLEN <= 0) then begin STATE = 'S'; /* Normal file send */ SFNLEN = -SFNLEN; /* Make positive again */ end else STATE = 'F'; /* Sending text, skip SI */ if (SND_BINARY == 1) then begin /* Always binary */ IMAGE = true; end else if (SND_BINARY == 2) then begin /* Always ASCII */ IMAGE = false; end else begin /* Auto, check file */ FGETINFO(DNUM,FORMALDESIG,&FOPT); if ( (FOPT & 0x4) != 0 ) then IMAGE = false; else IMAGE = true; end; while ( !(DONE | CTLY) ) begin if (STATE == 'S') then STATE = SINIT(); else if (STATE == 'F') then STATE = SFILE(SFNAME,SFNLEN); else if (STATE == 'D') then STATE = SDATA(); else if (STATE == 'Z') then STATE = SEOF(); else if (STATE == 'B') then begin STATE = 'C'; DONE = true; end else begin DONE = true; end; end; if (DNUM != 0) then begin FCLOSE(DNUM,0,0); DNUM = 0; end; if (STATE == 'C') then begin MY_JCW_VAL = SEND_OK; SENDSWSTATUS = true; end else begin MY_JCW_VAL = SEND_NG; SENDSWSTATUS = false; end; return SENDSWSTATUS; end #pragma SUBTITLE "R_RPAR - Receive Read RI Parms" #pragma PAGE procedure R_RPAR(DATA,LEN) int LEN ; char DATA[] ; begin int TEMP; MAX_SND_SIZE = UNCHAR(DATA[0]); /* Max send size */ MAX_SND_DATA = MAX_SND_SIZE -3; /* Max send data size */ YOUR_TO = UNCHAR(DATA[1]); /* When I time you out */ YOUR_PAD_COUNT = UNCHAR(DATA[2]); /* Number of pads to send */ YOUR_PAD = CTL(DATA[3]); /* Your Pad char */ YOUR_EOL = UNCHAR(DATA[4]); /* Your end-of-line */ YOUR_Q_CTL = DATA[5]; /* Your control quote */ if ( (LEN > 6) & (DATA[6] == 'Y') ) then begin /* I specify the quote */ Q8_IND = 'Y'; QUOTE_8 = true; end else if ( (LEN > 6) & (DATA[6] != 'N') ) then begin /* Quote specified for me */ Q_8 = DATA[6]; Q8_IND = ' '; QUOTE_8 = true; end else begin /* No 8 bit quoting */ QUOTE_8 = false; end; if (LEN > 7) then begin YOUR_BLK_CK = DATA[7]; if ( (YOUR_BLK_CK == '1') | (YOUR_BLK_CK == '3') ) then MY_BLK_CK = YOUR_BLK_CK; /* Will do it your way */ else MY_BLK_CK = YOUR_BLK_CK = '1'; /* The old way */ end else MY_BLK_CK = YOUR_BLK_CK = '1'; /* No blk ck -> one-byte ck */ if ( (LEN > 8) & (DATA[8] != ' ') ) then begin RPT_CHR = DATA[8]; USE_REPEAT = true; end else begin USE_REPEAT = false; end; if (LEN > 12) then /* Extended packet stuff */ begin YOUR_CAPS = UNCHAR(DATA[9]) & MY_CAPS; /* Windowing, DATA(10), is unsupported herein */ TEMP = UNCHAR(DATA[11])*95 + UNCHAR(DATA[12]); if (TEMP > MAX_LONGPACK_SIZE) then TEMP = MAX_LONGPACK_SIZE; LONGPACK_SIZE = TEMP-7-(YOUR_BLK_CK-'1'); end else LONGPACK_SIZE = MAX_SND_SIZE-6; end #pragma SUBTITLE "R_SPAR - Set up SEND Parameters" #pragma PAGE procedure R_SPAR(DATA,LEN) char DATA[] ; int *LEN ; begin DATA[0] = TOCHAR(MAX_RCV_SIZE /* Biggest to send me */ + 1 - (MY_BLK_CK-'0')); DATA[1] = TOCHAR(MY_TO); /* When to time me out */ DATA[2] = TOCHAR(0); /* How many pads I need */ DATA[3] = CTL(0); /* Pad char to use for me */ DATA[4] = TOCHAR(CR); /* End-of-line char for me */ DATA[5] = MY_Q_CTL; /* Control quote I send */ if (QUOTE_8) then begin if (Q8_IND == 'Y') then begin /* I specify the char */ Q_8 = P_Q_8; DATA[6] = P_Q_8; end else begin /* Already specified */ DATA[6] = 'Y'; end; end else begin DATA[6] = 'N'; /* No 8 bit quoting */ end; DATA[7] = MY_BLK_CK; if (USE_REPEAT) then DATA[8] = RPT_CHR; else DATA[8] = ' '; DATA[9] = TOCHAR(YOUR_CAPS); /* We negotiated this */ DATA[10] = TOCHAR(0); /* We don't do windows */ DATA[11] = TOCHAR( (LONGPACK_SIZE / 95) ); /* MAXL1 */ DATA[12] = TOCHAR( (LONGPACK_SIZE % 95) ); /* MAXL2 */ *LEN = 13; end #pragma SUBTITLE "RINIT - Recieve Initialization" #pragma PAGE char subroutine RINIT() begin int R_ERROR, RINITSTATUS; RINITSTATUS = STATE; NUMTRY = NUMTRY + 1; if (NUMTRY > MAXTRY) then begin E_ST "RINIT - Retry count exceeded" E_EN; RINITSTATUS = 'A'; end else begin R_ERROR = RPACK(&RP, &RP_LEN, &RP_NUM, RP_DATA); if (R_ERROR == 0) then begin if (RP == 'S') then begin R_RPAR(RP_DATA,RP_LEN); /* Read the others*/ R_SPAR(RP_DATA,&RP_LEN); /* Generate ours */ SPACK('Y', N, RP_LEN, RP_DATA); /* Send it */ OLDTRY = NUMTRY; /* Save trys */ NUMTRY = 0; N = NPNO(RP_NUM); /* Syncronize */ RINITSTATUS = 'F'; /* Switch to F mode */ end else if (RP == 'E') then begin E_ST "RINIT - E packet recieved" E_EN; P_EPACK(RP_DATA,RP_LEN); RINITSTATUS = 'A'; end else if (RP == 'N') then begin E_ST "RINIT - NAK packet recieved" E_EN; P_EPACK(RP_DATA,RP_LEN); end else begin E_ST "RINIT - Unexpected packet type" E_EN; RINITSTATUS = 'A'; end; end else begin if (R_ERROR != 3) then /*no SOH found*/ SPACK('N', N, 0, RP_DATA); end; end; return RINITSTATUS; end #pragma SUBTITLE "RFILE - Recieve a File Header" #pragma PAGE char subroutine RFILE() begin char FNAME[30], RFILESTATUS; int FN_LEN, FOPT; #define FN_MAX 35 RFILESTATUS = STATE; NUMTRY = NUMTRY + 1; if (NUMTRY > MAXTRY) then begin E_ST "RFILE - Retry count exceeded" E_EN; RFILESTATUS = 'A'; end else begin if ( RPACK(&RP, &RP_LEN, &RP_NUM, RP_DATA)==0 ) then begin /* Got a packet*/ if (RP == 'S') then begin /* Still in SI, perhaps ACK lost*/ OLDTRY = OLDTRY + 1; if (OLDTRY > MAXTRY) then begin E_ST "RFILE - Pretry (S) exceeded" E_EN; RFILESTATUS = 'A'; end else if (RP_NUM != PPNO(N)) then begin /* Number must match */ E_ST "RFILE - N mismatch on S packet" E_EN; RFILESTATUS = 'A'; end else begin /* OK, re-ACK the packet */ R_SPAR(RP_DATA,&RP_LEN); SPACK('Y', RP_NUM, RP_LEN, RP_DATA); NUMTRY = 0; end; end else if (RP == 'Z') then begin /* End of file, previous packet (?) */ OLDTRY = OLDTRY + 1; if (OLDTRY > MAXTRY) then begin E_ST "RFILE - Pretry (Z) exceeded" E_EN; RFILESTATUS = 'A'; end else if (RP_NUM != PPNO(N)) then begin /* N must match */ E_ST "RFILE - N mismatch on Z packet" E_EN; RFILESTATUS = 'A'; end else begin /* OK, re-ACK the packet */ SPACK('Y', RP_NUM, 0, RP_DATA); NUMTRY = 0; end; end else if (RP == 'F') then begin /* File header (what we expect) */ if (RP_NUM != N) then begin /* Oops */ E_ST "RFILE - N mismatch" E_EN; RFILESTATUS = 'A'; end else begin /* OK, Open the file */ if (L_FNAME_LEN != 0) then begin strncpy(FNAME, L_FNAME, L_FNAME_LEN); FN_LEN = L_FNAME_LEN; end else begin CBUFXLT(RP_DATA,RP_LEN, FNAME,&FN_LEN,FN_MAX); if ( !UNQFNAME(FNAME,FN_LEN) ) then begin MAKE_U_FNAME(FNAME,&FN_LEN); end; end; FNAME[FN_LEN] = ' '; if (RCV_BINARY) then begin /* Binary mode */ IMAGE = true; FOPT = 0; end else begin /* ASCII mode */ IMAGE = false; FOPT = 4; end; if ( !RCV_FIXREC ) then FOPT = FOPT + 0x40; /* set variable */ if (RCV_RECLEN < 0) then DBUF_RMAX = -RCV_RECLEN; else DBUF_RMAX = RCV_RECLEN * 2; begin DNUM = FOPEN(FNAME,FOPT,1, RCV_RECLEN, RCV_DEV,0,0, RCV_BLOCKF,0, RCV_MAXREC, RCV_MAXEXT,1, RCV_FCODE); if (DNUM == 0) then begin /* Can't open file */ E_ST "RFILE - Can't open file" E_EN; RFILESTATUS = 'A'; end else begin /* OK */ strcpy(RP_DATA, FNAME); RP_LEN = FN_LEN; SPACK('Y', N, RP_LEN, RP_DATA); OLDTRY = NUMTRY; NUMTRY = 0; N = NPNO(N); RFILESTATUS = 'D'; DBUFCNT = 0; DBUFINX = 0; end; end; end; end else if (RP == 'B') then begin /* Break transmission */ if (RP_NUM != N) then begin /* Oops */ E_ST "RFILE - (B) N mismatch" E_EN; RFILESTATUS = 'A'; end else begin SPACK('Y', N, 0, RP_DATA); RFILESTATUS = 'C'; end; end else if (RP == 'E') then begin E_ST "RFILE - E packet recieved" E_EN; P_EPACK(RP_DATA,RP_LEN); RFILESTATUS = 'A'; end else begin E_ST "RFILE - Unknown packet type" E_EN; RFILESTATUS = 'A'; end; end /* Got a packet */ else begin SPACK('N', N, 0, RP_DATA); /* No (readable) packet */ end; end; return RFILESTATUS; #undef FN_MAX end #pragma SUBTITLE "RDATA - Recieve Data" #pragma PAGE char subroutine RDATA() begin char RDATASTATUS; RDATASTATUS = STATE; NUMTRY = NUMTRY + 1; if (NUMTRY > MAXTRY) then begin E_ST "RDATA - Retry count exceeded" E_EN; RDATASTATUS = 'A'; end else begin MY_TO = 5 + LONGPACK_SIZE/TSPEED; /* Rcv timeout */ if ( RPACK(&RP, &RP_LEN, &RP_NUM, RP_DATA)==0 ) then begin if (RP == 'D') then begin /* Good, what we expect */ if (RP_NUM != N) then begin /* Oops, not this packet */ OLDTRY = OLDTRY + 1; if (OLDTRY > MAXTRY) then begin E_ST "RDATA - Pretry exceeded" E_EN; RDATASTATUS = 'A'; end else if (RP_NUM == PPNO(N)) then begin /* Already have this one */ SPACK('Y', RP_NUM, 0, RP_DATA);/*Re-ACK*/ NUMTRY = 0; end else begin E_ST "RDATA - N (D) mismatch" E_EN; RDATASTATUS = 'A'; end; end /* Wrong packet */ else begin /* Got the one we want */ BUFEMP(RP_DATA,RP_LEN); /* Process */ SPACK('Y', N, 0, RP_DATA); /* and ACK */ OLDTRY = NUMTRY; NUMTRY = 0; N = NPNO(N); end; end /* RP = 'D' */ else if (RP == 'F') then begin /* File header */ OLDTRY = OLDTRY + 1; if (OLDTRY > MAXTRY) then begin E_ST "RDATA - Pretry (F) exceeded" E_EN; RDATASTATUS = 'A'; end else if (RP_NUM != PPNO(N)) then begin /* Oops */ E_ST "RDATA - N (F) mismatch" E_EN; RDATASTATUS = 'A'; end else begin /* OK */ SPACK('Y', RP_NUM, 0, RP_DATA); /* ReACK */ NUMTRY = 0; end; end /* RP = 'F' */ else if (RP == 'Z') then begin /* End of File */ if (RP_NUM != N) then begin E_ST "RDATA - N (Z) mismatch" E_EN; RDATASTATUS = 'A'; end else begin if (DBUFINX > 0) then FLUSH_DBUF; if (RCV_SAVESP) then FCLOSE(DNUM,0x9,0); else FCLOSE(DNUM,1,0); DNUM = 0; SPACK('Y', N, 0, RP_DATA); /* ACK */ L_FNAME_LEN = 0; N = NPNO(N); RDATASTATUS = 'F'; end; end /* RP = 'Z' */ else if (RP == 'E') then begin E_ST "RDATA - E packet recieved" E_EN; P_EPACK(RP_DATA,RP_LEN); RDATASTATUS = 'A'; end else begin E_ST "RDATA - Unknown packet type" E_EN; RDATASTATUS = 'A'; end; end /* Got packet */ else begin SPACK('N', N, 0, RP_DATA); /* NAK */ end; end; return RDATASTATUS; end #pragma SUBTITLE "RECSW - Receive Switch (Definitions)" #pragma PAGE logical procedure RECSW(SERVE) logical SERVE ; begin logical DONE = false, RECSWSTATUS, R_ERROR; int FOPT, /* File Options (calculated) */ FN_LEN; /* File Name Length */ #define FN_MAX 35 /* Max File Name Length */ char FNAME[FN_MAX]; /* "RECSW - Main Code" */ MY_JCW_VAL = RECVING; PUTJCW(KERM_JCW, &MY_JCW_VAL, &JCW_ERR); if (IMPATIENT) then begin MY_TO = FAST_TO; MAXTRY = FAST_MAXTRY; end else begin MY_TO = DFLT_TO; MAXTRY = DFLT_MAXTRY; end; if ( !SERVE ) then begin STATE = 'R'; N = 0; NUMTRY = 0; end else begin STATE = 'F'; end; while ( !(DONE || CTLY) ) begin if (STATE == 'R') then STATE = RINIT(); else if (STATE == 'F') then STATE = RFILE(); else if (STATE == 'D') then STATE = RDATA(); else if (STATE == 'C') then begin DONE = true; RECSWSTATUS = true; end else if (STATE == 'A') then begin DONE = true; RECSWSTATUS = false; end; end; if (DNUM != 0) then begin FCLOSE(DNUM,0,0); DNUM = 0; end; if (STATE == 'C') then MY_JCW_VAL = RECV_OK; else MY_JCW_VAL = RECV_NG; MY_TO = DFLT_TO; return RECSWSTATUS; end #pragma SUBTITLE "TYPESW - Type a file on the terminal" #pragma PAGE logical procedure TYPESW() begin logical DONE = false; DNUM = FOPEN(L_FNAME, 5, 0); if (DNUM == 0) then begin M_ST "File open failure" M_EN; return false; end; while ( !(DONE | CTLY) ) begin DBUFCNT = FREAD(DNUM, DBUF, -DBUF_BYTESIZE); if (DBUFCNT == 0) then begin /* No data read. Assume EOF */ DONE = true; end else FWRITE(CONUM, DBUF, -DBUFCNT, 0); end; FCLOSE(DNUM, 0, 0); DNUM = 0; if (CTLY) then return false; else return true; end #pragma SUBTITLE "OPEN_LINE - Open Communications Line" #pragma PAGE logical procedure OPEN_LINE() begin logical R_ERROR = false, TEMP; int DEV_L; char A_DEV[12], NONAME[3] = " "; if (LNUM == 0) then begin /* Line not open */ if (LDEV_LINE == 0) then begin E_ST "Line not specified or defaultable" E_EN; R_ERROR = true; end else begin strcpy(PBUF, "SETMSG OFF"); PLEN = strlen(PBUF); PBUF[PLEN] = CR; HPCICOMMAND(PBUF, &ERROR, &PARM, NO_VISIBLE_MSG); strcpy(A_DEV, "000 "); ASCII(LDEV_LINE, -10, A_DEV+2); LNUM = FOPEN(NONAME, 0, 0x4, LBUF_WORDSIZE, A_DEV); if (LNUM==0) then if ( LOGNUM!=0) then begin FCHECK(LNUM, &R_ERROR); strcpy(PBUF, "OPEN_LINE: FOPEN ERROR "); PLEN = strlen(PBUF); PLEN=PLEN+ASCII(R_ERROR, 10, PBUF+PLEN); FWRITE(LOGNUM, PBUF, -PLEN, 0); R_ERROR=true; end; if (LNUM == 0) then begin E_ST "FOPEN error on communications port" E_EN; R_ERROR = true; end else begin /* Set up the line */ if (HNDSHK == 0) then TTYPE = 18; else TTYPE = DFLT_TTYPE; /* Some of the following FCONTROLs don't do anything and, if probed via ccode(), return an error. This is a fruitfull area for future cleanup. */ FCONTROL(LNUM,39,&ORGL_TTYPE); FCONTROL(LNUM,38,&TTYPE); FCONTROL(LNUM,13,&ORGL_ECHO); if (TSPEED != 0) then begin ORGL_TISPEED = TSPEED; FCONTROL(LNUM,10,&ORGL_TISPEED); ORGL_TOSPEED = TSPEED; FCONTROL(LNUM,11,&ORGL_TOSPEED); end else FCONTROL(LNUM,40,&TSPEED); /* Get speed */ FSETMODE(LNUM,4); /* Inhibit LF */ if (HNDSHK == 2) then begin /* Set XON as termination char */ TEMP = XON; FCONTROL(LNUM,25,&TEMP); end; /* TEMP = MY_EOL+(256*CTL('Y')); FCONTROL(LNUM, 41, &TEMP); Almost transparent rx*/ if ( (LDEV_CI == LDEV_LINE) & (LOGNUM == CONUM) ) then LOGNUM = 0; end; end; end; return (!R_ERROR); end #pragma SUBTITLE "SHUT_LINE - Close Communications Line" #pragma PAGE procedure SHUT_LINE() begin unsigned short TEMP; if (LNUM != 0) then begin /* Line is open */ FSETMODE(LNUM,0); /* Turn on linefeed */ if (ORGL_TTYPE != TTYPE) then FCONTROL(LNUM,38,&ORGL_TTYPE); if (TSPEED != 0) then begin if (ORGL_TISPEED != TSPEED) then begin TEMP = ORGL_TISPEED; FCONTROL(LNUM,10,&TEMP); end; if (ORGL_TOSPEED != TSPEED) then begin TEMP = ORGL_TOSPEED; FCONTROL(LNUM,11,&TEMP); end; end; if (ORGL_ECHO == 0) then FCONTROL(LNUM,12,&TEMP); if (HNDSHK == 2) then begin TEMP = 0; FCONTROL(LNUM,25,&TEMP); end; FCLOSE(LNUM,0,0); LNUM = 0; if (LOGNUM == 0) then LOGNUM = CONUM; strcpy(PBUF, "SETMSG ON"); PLEN = strlen(PBUF); PBUF[PLEN] = CR; HPCICOMMAND(PBUF, &ERROR, &PARM, NO_VISIBLE_MSG); end; end #pragma SUBTITLE "Temporary File Allocation/Deletion" #pragma PAGE procedure KILL_KTEMP() begin int TNUM=0, /* Temp file number */ X; /* Temp variable */ char TBUF[80]; strcpy(TBUF, "RESET "); strcat(TBUF, KTEMP_NAME); /* Reset file equate */ X = strlen(TBUF); TBUF[X] = CR; HPCICOMMAND(TBUF, &ERROR, &PARM, NO_VISIBLE_MSG); strcpy(TBUF, KTEMP_NAME); X = strlen(TBUF); TBUF[X] = ' '; TNUM = FOPEN(TBUF,7,4); /* Try to open it */ if (TNUM != 0) then FCLOSE(TNUM,4,0); /* Kill it */ HAVE_KTEMP = false; end procedure GET_KTEMP() begin int TNUM, /* Temp file number */ X; /* Temp variable */ char TBUF[80]; KILL_KTEMP(); /* Delete any old one */ TNUM = FOPEN(KT_NAME,4,4,-80,0,0,0,16,0,2048); /* Open new */ if (TNUM != 0) then begin FCLOSE(TNUM,2,0); /* Save as temporary */ if (ccode() == CCE) then begin strcpy(TBUF, "FILE "); strcat(TBUF, KTEMP_NAME); strcat(TBUF, ",OLDTEMP"); X = strlen(TBUF); TBUF[X] = CR; HPCICOMMAND(TBUF, &ERROR, &PARM, NO_VISIBLE_MSG); if (ERROR == 0) then HAVE_KTEMP = true; end; end; end #pragma SUBTITLE "HOST_COMMAND - Process an HP 3000 Command" #pragma PAGE procedure HOST_COMMAND(CMD,CMD_LEN,LONG_REPLY) char CMD[] ; int CMD_LEN ; logical LONG_REPLY ; begin char CMD_BUF[80]; logical CMD_ERR = false; short CI_ERNO, CI_PARM, CMD_BUF_LEN; strncpy(CMD_BUF, CMD, CMD_LEN); if (LONG_REPLY) then begin GET_KTEMP(); if ( !HAVE_KTEMP ) then begin strcpy(CMD_BUF, "HOST_CMD Unable to allocate temp file"); CMD_BUF_LEN = strlen(CMD_BUF); SPACK('E', N, CMD_BUF_LEN, CMD_BUF); CMD_ERR = true; end; end; if ( !CMD_ERR ) then begin CMD_BUF[CMD_LEN] = CR; HPCICOMMAND(CMD_BUF, &CI_ERNO, &CI_PARM, NO_VISIBLE_MSG); if (CI_ERNO != 0) then begin /* Command Interpreter error */ strcpy(CMD_BUF, "Command Error, CIERROR = "); CMD_BUF_LEN = strlen(CMD_BUF); CMD_BUF_LEN = CMD_BUF_LEN +ASCII(CI_ERNO, 10, CMD_BUF+CMD_BUF_LEN); SPACK('E', N, CMD_BUF_LEN, CMD_BUF); CMD_ERR = true; end else begin /* Command OK */ if (LONG_REPLY) then begin DNUM = FOPEN(KT_NAME,6,0); if (DNUM == 0) then begin /* Temp file open error */ strcpy(CMD_BUF, "Temp file open failure"); CMD_BUF_LEN = strlen(CMD_BUF); SPACK('E', N, CMD_BUF_LEN, CMD_BUF); CMD_ERR = true; end else begin SENDSW(CMD_BUF,0); STATE = SBREAK(); end; end else begin /* Short reply */ SPACK('Y', N, 0, CMD_BUF); end; end; end; end #pragma SUBTITLE "KERMIT_HPCICOMMAND - Process Generic KERMIT Command" #pragma PAGE procedure KERMIT_HPCICOMMAND(KCMD,KCMD_LEN) char KCMD[] ; int KCMD_LEN ; begin char KC_BUF[80]; int INTRINSIC_STATUS[6]; short KC_LEN, ERR, X; int SESSION = 0; float WRITE_FINISH = 2.0; if ( (KCMD[0]=='D') & (KCMD_LEN>0) ) then begin /* Directory Command */ strcpy(KC_BUF, "LISTF "); KC_LEN = strlen(KC_BUF); if (KCMD_LEN > 2) then begin /* Check for filespec */ X = UNCHAR(KCMD[1]); if ( (X>0) & (X<=(KCMD_LEN-2)) ) then begin /* Use filespec */ strncat(KC_BUF, KCMD+2, X); KC_LEN = KC_LEN + X; end; end; strcat(KC_BUF, ",2;*"); strcat(KC_BUF, KTEMP_NAME); KC_LEN = strlen(KC_BUF); HOST_COMMAND(KC_BUF, KC_LEN, true, NO_VISIBLE_MSG); end else if ( (KCMD[0] == 'U') & (KCMD_LEN > 0) ) then begin /* File space usage */ strcpy(KC_BUF, "REPORT "); KC_LEN = strlen(KC_BUF); if (KCMD_LEN > 2) then begin /* Check for groupspec */ X = UNCHAR(KCMD[1]); if ( (X > 0) & (X <= (KCMD_LEN -2)) ) then begin /* Use groupspec */ strncat(KC_BUF, KCMD+2, X); KC_LEN = KC_LEN + X; end; end; strcat(KC_BUF, ",*"); strcat(KC_BUF, KTEMP_NAME); KC_LEN = strlen(KC_BUF); HOST_COMMAND(KC_BUF, KC_LEN, true, NO_VISIBLE_MSG); end else if ( (KCMD[0]=='E') & (KCMD_LEN>0) ) then begin /* Erase (delete) command */ strcpy(KC_BUF, "PURGE "); KC_LEN = strlen(KC_BUF); if (KCMD_LEN > 2) then begin X = UNCHAR(KCMD[1]); end else begin X = 0; end; if ( (X < 1) | (X > (KCMD_LEN-2)) ) then begin strcpy(KC_BUF, "Filespec missing or invalid"); KC_LEN = strlen(KC_BUF); SPACK('E', N, KC_LEN, KC_BUF); end else begin strncat(KC_BUF, KCMD+2, X); KC_LEN = KC_LEN + X; HOST_COMMAND(KC_BUF, KC_LEN, false, NO_VISIBLE_MSG); end; end else if ( (KCMD[0]=='T') & (KCMD_LEN>0) ) then begin /* Type Command */ if (KCMD_LEN > 1) then begin X = UNCHAR(KCMD[1]); end else begin X = 0; end; if ( (X < 1) | (X > (KCMD_LEN -2)) ) then begin strcpy(KC_BUF, "Filespec missing or invalid"); KC_LEN = strlen(KC_BUF); SPACK('E', N, KC_LEN, KC_BUF); end else begin strncpy(KC_BUF, &KCMD[2], X); KC_BUF[X] = ' '; begin DNUM = FOPEN(KC_BUF,5,0); if (DNUM == 0) then begin strcpy(KC_BUF, "File open error"); KC_LEN = strlen(KC_BUF); SPACK('E', N, KC_LEN, KC_BUF); end else begin SENDSW(KC_BUF,0); STATE = SBREAK(); end; end; end; end else if (KCMD[0] == 'L') then begin /* Bye command */ JOBINFO(1, &SESSION, INTRINSIC_STATUS, 15, &SESSION, &ERR); if ( INTRINSIC_STATUS[0] != 0 ) then begin strcpy(PBUF, "Can't 'BYE'. JOBINFO status="); PLEN = strlen(PBUF); PLEN = PLEN+ASCII(INTRINSIC_STATUS[0], 10, PBUF+PLEN); SPACK('E', N, PLEN, PBUF); end else begin strcpy(PBUF, "Kermit session aborted by user"); PLEN=strlen(PBUF); SPACK('Y', N, PLEN, PBUF); if (LOGNUM!=0) then FCLOSE(LOGNUM, 0x9, 0); if (HAVE_KTEMP) then KILL_KTEMP(); PAUSE(&WRITE_FINISH); /* FWRITE in SPACK */ ABORTSESS(1, SESSION, INTRINSIC_STATUS); end; end else begin strcpy(KC_BUF, "Unimplementented Server Command"); KC_LEN = strlen(KC_BUF); SPACK('E', N, KC_LEN, KC_BUF); end; end #pragma SUBTITLE "DIRSEARCH - Locate Candidates for Send" #pragma page logical subroutine DIRSEARCH(SEARCHED) unsigned short *SEARCHED ; begin logical DIRSEARCHSTATUS; DIRSEARCHSTATUS = false; /* Prepare for the worst */ if ( *SEARCHED==0 ) then begin GET_KTEMP(); if ( !HAVE_KTEMP ) then begin strcpy( PBUF, "DIR Unable to allocate temp file"); PLEN = strlen(PBUF); SPACK('E', N, PLEN, PBUF); return DIRSEARCHSTATUS; end; strcpy(PBUF, "LISTF "); strncat(PBUF, L_FNAME, L_FNAME_LEN); strcat(PBUF, "; *"); strncat(PBUF, KTEMP_NAME, KTN_LEN); PBUF[strlen(PBUF)] = CR; HPCICOMMAND(PBUF, &ERROR, &PARM, NO_VISIBLE_MSG); if (ERROR != 0) then begin strcpy(PBUF, "Directory search failed. Error="); PLEN = strlen(PBUF); PLEN = PLEN+ ASCII(ERROR, 10, PBUF+PLEN); SPACK('E', N, PLEN, PBUF); return DIRSEARCHSTATUS; end; KT_NUM = FOPEN(KT_NAME, 6, 0); if (KT_NUM == 0) then begin strcpy(PBUF, "Temp file open failure"); PLEN = strlen(PBUF); SPACK('E', N, PLEN, PBUF); return DIRSEARCHSTATUS; end; FREAD(KT_NUM, PBUF, -80); /*Hopefully skip over junk */ FREAD(KT_NUM, PBUF, -80); FREAD(KT_NUM, PBUF, -80); *SEARCHED = 1; end; strcpy(PBUF, " "); if ( (FREAD(KT_NUM, PBUF, -80) <= 1) | !isalnum(PBUF[0]) ) then begin *SEARCHED = 0; FCLOSE(KT_NUM, 4, 0); /* Purge */ KT_NUM = 0; KILL_KTEMP(); STATE = SBREAK(); return DIRSEARCHSTATUS; end; /* If we survived all of that, we will return one file name */ L_FNAME_LEN = 0; while ( isalnum(PBUF[L_FNAME_LEN]) ) begin L_FNAME[L_FNAME_LEN] = PBUF[L_FNAME_LEN]; L_FNAME_LEN++; end; L_FNAME[L_FNAME_LEN] = ' '; if (*SEARCHED==1) then begin *SEARCHED = 2; L_FNAME_LEN = -L_FNAME_LEN; end; DIRSEARCHSTATUS = true; return DIRSEARCHSTATUS; end #pragma SUBTITLE "SPLIT_CBUF - Separate File Names" #pragma page subroutine SPLIT_CBUF(BUF, LEN) /* Handle the case where we */ int LEN; /* have local and remote file */ char BUF[]; /* names specified in a remote*/ /* GET request. */ begin int IX = 0; while (BUF[IX] == ' ') IX++; L_FNAME_LEN = 0; while ( (BUF[IX] !=' ') & (IX < LEN) ) begin L_FNAME[L_FNAME_LEN] = BUF[IX]; L_FNAME_LEN = L_FNAME_LEN+1; IX++; end; L_FNAME[L_FNAME_LEN] = ' '; R_FNAME_LEN = 0; while ( (BUF[IX] == ' ') & (IX < LEN) ) IX++; while ( (BUF[IX] != ' ') & (IX < LEN) ) begin R_FNAME[R_FNAME_LEN] = BUF[IX]; R_FNAME_LEN = R_FNAME_LEN+1; IX++; end; R_FNAME[R_FNAME_LEN] = ' '; R_FNAME_LEN = -R_FNAME_LEN; end #pragma SUBTITLE "SERVER - Driver for Server Mode" #pragma PAGE procedure SERVER() begin # define CB_MAX 80 /* Max command size -1 */ char CBUF[CB_MAX]; /* Command Buffer */ logical DONE = false, SEARCHED = 0; int CB_CNT, /* Command size */ IX; /* Set default conditions */ MAX_SND_SIZE = 80; MAX_SND_DATA = 77; YOUR_PAD_COUNT = 0; YOUR_PAD = 0; YOUR_EOL = CR; YOUR_Q_CTL = 0x23; QUOTE_8 = false; USE_REPEAT = false; while ( !(DONE | CTLY) ) begin N = 0; NUMTRY = 0; STATE = 'S'; if ( (RPACK(&RP, &RP_LEN, &RP_NUM, RP_DATA)==0) | (RP_NUM == 0) ) then begin MY_JCW_VAL = IDLING; PUTJCW(KERM_JCW, &MY_JCW_VAL, &JCW_ERR); if (RP == 'I') then begin /* Exchange Parameters */ R_RPAR(RP_DATA,RP_LEN); R_SPAR(RP_DATA,&RP_LEN); SPACK('Y', N, RP_LEN, RP_DATA); OLDTRY = NUMTRY; NUMTRY = 0; N = NPNO(RP_NUM); end else if (RP == 'S') then begin /* Other side is sending */ R_RPAR(RP_DATA,RP_LEN); R_SPAR(RP_DATA,&RP_LEN); SPACK('Y', N, RP_LEN, RP_DATA); OLDTRY = NUMTRY; NUMTRY = 0; N = NPNO(RP_NUM); RECSW(true); PUTJCW(KERM_JCW, &MY_JCW_VAL, &JCW_ERR); end else if (RP == 'R') then begin /* Other side wants us to send */ CBUFXLT(RP_DATA,RP_LEN,CBUF,&CB_CNT,CB_MAX); SPLIT_CBUF(CBUF, CB_CNT); while ( DIRSEARCH(&SEARCHED) ) begin DNUM = FOPEN(L_FNAME,5,0); if (DNUM == 0) then begin /* File open error */ strcpy(RP_DATA, "File open error - "); strncat(RP_DATA, L_FNAME, L_FNAME_LEN); SPACK('E', N, strlen(RP_DATA), RP_DATA); MY_JCW_VAL = SEND_NG; end else if (R_FNAME_LEN == 0) then begin SENDSW(L_FNAME, L_FNAME_LEN); L_FNAME_LEN = 0; end else begin SENDSW(R_FNAME, R_FNAME_LEN); R_FNAME_LEN = 0; end; end; PUTJCW(KERM_JCW, &MY_JCW_VAL, &JCW_ERR); end else if (RP == 'G') then begin /* KERMIT Command */ if ( (RP_DATA[0] == 'F') & (RP_LEN == 1) ) then begin SPACK('Y', N, 0, RP_DATA); DONE = true; end else begin if ( CBUFXLT(RP_DATA,RP_LEN, CBUF,&CB_CNT,CB_MAX) ) then begin KERMIT_HPCICOMMAND(CBUF, CB_CNT, NO_VISIBLE_MSG); end else begin strcpy(CBUF, "Command too big"); CB_CNT = strlen(CBUF); SPACK('E', N, CB_CNT, CBUF); end; end; end else begin SPACK('N', N, 0, RP_DATA); end; end else begin SPACK('N', N, 0, RP_DATA); end; end; end #pragma SUBTITLE "VERIFY - List assorted attributes" #pragma PAGE procedure VERIFY() begin static char BLANKS[] = " "; char *P, NUMBER[10]; # define SAY {strcat(P, /* Better than M_ST */ # define ENDSAY ); } /* Better than M_EN */ # define SAYNUM {PLEN = ASCII( # define DECIMAL , 10, NUMBER); strncat(P, NUMBER, PLEN); } # define SPIT SPIT1 SPIT2 SPIT3 # define SPIT1 {PLEN = strlen(P); # define SPIT2 FWRITE(CONUM, PBUF, -PLEN, 0); # define SPIT3 strcpy(PBUF, BLANKS); strcpy(P, ""); } # define MIDLINE strncat(P, BLANKS, 30-strlen(P)) # define SAYBOOL(TRUTH) BOO1(TRUTH) BOO2 # define BOO1(TRUTH) if (TRUTH) # define BOO2 SAY "ON" ENDSAY else SAY "OFF" ENDSAY P = PBUF; SAY BLANKS ENDSAY; SPIT; SAY "RECEIVE parameters" ENDSAY; MIDLINE; SAY "Other parameters" ENDSAY; SPIT; SAY " BINARY: " ENDSAY; SAYBOOL(RCV_BINARY); MIDLINE; SAY " SEND BINARY: " ENDSAY; switch(SND_BINARY) begin case 0: begin SAY "Auto" ENDSAY; break; end; case 1: begin SAY "Binary" ENDSAY; break; end; case 2: begin SAY "ASCII" ENDSAY; break; end; end; SPIT; SAY " FIXREC: " ENDSAY; SAYBOOL(RCV_FIXREC); MIDLINE; SAY " SEND PAUSE: " ENDSAY; SAYNUM PAUSE_CNT DECIMAL; SPIT; SAY " SAVESP: " ENDSAY; SAYBOOL(RCV_SAVESP); MIDLINE; SAY " DELAY: " ENDSAY; SAYNUM I_DELAY DECIMAL; SPIT; SAY " FCODE: " ENDSAY; SAYNUM RCV_FCODE DECIMAL; MIDLINE; SAY " HANDSHAKE: " ENDSAY; switch (HNDSHK) begin case 0: begin SAY "None" ENDSAY; break; end; case 1: begin SAY "XON" ENDSAY; break; end; case 2: begin SAY "XON2" ENDSAY; break; end; end; SPIT; SAY " RECLEN: " ENDSAY; SAYNUM RCV_RECLEN DECIMAL; MIDLINE; SAY " DEBUG: " ENDSAY; SAYNUM DEBUG_MODE DECIMAL; SPIT; SAY " BLOCKF: " ENDSAY; SAYNUM RCV_BLOCKF DECIMAL; MIDLINE; SAY " LOG: " ENDSAY; if ( (LOGNUM > 0) & (LOGNUM != CONUM) ) then begin SAY "TRUE (" ENDSAY; SAY LOGNAME ENDSAY; SAY ")" ENDSAY; end else SAY "FALSE" ENDSAY; SPIT; SAY " MAXEXT: " ENDSAY; SAYNUM RCV_MAXEXT DECIMAL; MIDLINE; SAY " LINE LDEV: " ENDSAY; SAYNUM LDEV_LINE DECIMAL; SPIT; SAY " MAXREC: " ENDSAY; PLEN = DASCII(RCV_MAXREC, 10, NUMBER); strncat(P, NUMBER, PLEN); MIDLINE; SAY " LINE SPEED: " ENDSAY; SAYNUM TSPEED DECIMAL; SPIT; SAY " DEVICE: " ENDSAY; strncat(P, RCV_DEV, 4); MIDLINE; SAY " SOH: " ENDSAY; SAYNUM SOH DECIMAL; SPIT; SAY " EXPTAB: " ENDSAY; SAYBOOL(EXP_TABS); SPIT; end #pragma SUBTITLE "KINIT - Perform KERMIT Initialization" #pragma PAGE logical procedure KINIT() begin logical R_ERROR = false; unsigned short J_MODE, J_LDEV, F_LDEV; char TEST_CMD[20]; int T = 0; char STDIN[] = "$STDIN ", STDLIST[] = "$STDLIST "; unsigned short DUM16; int DUM32; char DUMARY[20]; LNUM = 0; CINUM = FOPEN(STDIN , 0x2C, 0); CONUM = FOPEN(STDLIST , 0x10C, 0); /* LOGNUM := CONUM; Equates to non-STDLIST cause confusion */ if ( (CINUM != 0) & (CONUM != 0) ) then begin M_ST VERS M_EN; /* Output current version # */ M_ST " " M_EN; XCONTRAP( (int)CONTROLY, &DUM32 ); strcpy(KT_NAME, KTEMP_NAME); KTN_LEN = strlen(KT_NAME); KT_NAME[KTN_LEN] = ' '; LDEV_CI = 0; LDEV_LINE = 0; WHO(&J_MODE, &DUM32, &DUM32, MYSELF, DUMARY, DUMARY, DUMARY, &J_LDEV); if ( (J_MODE % 16) / 4 == 1 )then /* .(12:2) */ begin /* Session */ LDEV_LINE = J_LDEV; /* Default COM to session dev */ /* Get CI ldev */ FGETINFO(CINUM, DUMARY, &DUM16, &DUM16, &DUM16, &DUM16, &F_LDEV); if (F_LDEV == J_LDEV) then begin /* Command input uses session device */ LDEV_CI = J_LDEV; end else begin /* Get CO ldev */ FGETINFO(CONUM, DUMARY, &DUM16, &DUM16, &DUM16 ,&DUM16, &F_LDEV); if (F_LDEV == J_LDEV) then LDEV_CI = J_LDEV; /* CO uses session ldev */ end; end; for (T=0; T<60; T++) MIN_SIZE[T]=32767; MIN_SIZE[DELETEV] = 2; MIN_SIZE[DIRV] = 2; MIN_SIZE[EXITV] = 1; MIN_SIZE[NULLV] = 1; MIN_SIZE[RECEIVEV] = 1; MIN_SIZE[SENDV] = 3; MIN_SIZE[SERVEV] = 3; MIN_SIZE[SETV] = 3; MIN_SIZE[SPACEV] = 2; MIN_SIZE[STATUSV] = 2; MIN_SIZE[TAKEV] = 2; MIN_SIZE[TYPEV] = 2; MIN_SIZE[VERIFYV] = 1; MIN_SIZE[DEBUGV] = 3; MIN_SIZE[DELAYV] = 3; MIN_SIZE[HANDSHAKEV]= 1; MIN_SIZE[LINEV] = 2; MIN_SIZE[LOGV] = 2; MIN_SIZE[SENDV_1] = 3; MIN_SIZE[SPEEDV] = 2; MIN_SIZE[SOHV] = 2; MIN_SIZE[RECEIVEV_1]= 1; MIN_SIZE[AUTOV] = 1; MIN_SIZE[BIN128V] = 4; MIN_SIZE[BINARYV] = 4; MIN_SIZE[BLOCKFV] = 2; MIN_SIZE[DEVICEV] = 1; MIN_SIZE[FIXRECV] = 2; MIN_SIZE[FCODEV] = 2; MIN_SIZE[MAXRECV] = 4; MIN_SIZE[MAXEXTV] = 4; MIN_SIZE[PAUSEV] = 2; MIN_SIZE[PROGV] = 2; MIN_SIZE[RECLENV] = 1; MIN_SIZE[SAVESPV] = 1; MIN_SIZE[TEXTV] = 2; MIN_SIZE[TXT80V] = 2; MIN_SIZE[EXPTABV] = 1; MIN_SIZE[FASTV] = 2; MIN_SIZE[NONEV] = 1; MIN_SIZE[OFFV] = 2; MIN_SIZE[ONV] = 2; MIN_SIZE[XONV] = 3; MIN_SIZE[XON2V] = 4; MIN_SIZE[YESV] = 1; MY_CAPS = 2;/* 0 CAT 1 (LONGP_F) CAT 0 (WINDOWS_F) CAT 0 (ATTRS_F); */ strcpy(TEST_CMD, "SETVAR NOTHING 0"); TEST_CMD[strlen(TEST_CMD)] = 0x0D; HPCICOMMAND(TEST_CMD, &ERROR, &PARM, NO_VISIBLE_MSG); if (ccode() == CCE) then DFLT_TTYPE = 10; /* HPPA machines */ else DFLT_TTYPE = 13; /* Classic machines */ end else begin R_ERROR = true; end; if (TAKE_VAL > 0) then begin strcpy(PBUF, "F599KM00 "); PLEN = strlen(PBUF); ASCII(TAKE_VAL, -10, PBUF+(PLEN-2)); TAKENUM = FOPEN(PBUF, 0x5, 0x400); if (TAKENUM == 0) then begin strcat(PBUF, "take file open error"); PLEN = strlen(PBUF); FWRITE(CONUM, PBUF, -PLEN, 0); end; end; LONGPACK_SIZE = MAX_LONGPACK_SIZE-10; return !R_ERROR; end #pragma SUBTITLE "HELP - User Help Function" #pragma PAGE procedure HELP(ITEM, LEVEL, RCVCASE) int ITEM, LEVEL, RCVCASE; /* WARNING* No check is made for missing params!!!!!!!!!!!!*/ begin M_ST " " M_EN; switch (ITEM) begin /* HPCICOMMANDS IN GENERAL */ case 0: begin M_ST "Commands:" M_EN; M_ST " " M_EN; M_ST " TAKE" M_EN; M_ST " SERVE" M_EN; M_ST " SEND" M_EN; M_ST " RECEIVE" M_EN; M_ST " SET" M_EN; M_ST " VERIFY" M_EN; M_ST " DIR" M_EN; M_ST " SPACE" M_EN; M_ST " DELETE" M_EN; M_ST " TYPE" M_EN; M_ST " EXIT" M_EN; break; end; /* TAKE */ case TAKEV: begin M_ST "Syntax: TAKE filespec" M_EN; M_ST " " M_EN; M_ST "The TAKE command causes subsequent commands to be" M_EN; M_ST "taken from the specified file until EOF is reached." M_EN; M_ST "If a subsequent TAKE is encountered within the original" M_EN; M_ST "TAKE file, the first file is closed and execution" M_EN; M_ST "continues with the second. This means that if a" M_EN; M_ST "TAKE appears within a TAKE file, commands that follow" M_EN; M_ST "it (in the original TAKE file) will be ignored." M_EN; break; end; /* SEND */ case SENDV: begin M_ST "Syntax: SEND filespec1 [filespec2]" M_EN; M_ST " " M_EN; M_ST "This command causes a file (indicated by filespec1)" M_EN; M_ST "to be sent from the HP to the local KERMIT. Wildcard" M_EN; M_ST "characters are not permitted. If filespec2 is speci-" M_EN; M_ST "fied, the file will be sent with that name." M_EN; break; end; /* RECEIVE */ case RECEIVEV: begin M_ST "Syntax: RECEIVE filespec" M_EN; M_ST " " M_EN; M_ST "The RECEIVE command causes HP KERMIT to enter receive" M_EN; M_ST "mode and wait for the local kermit to start sending" M_EN; M_ST "a file. Filespec must be specified. The file will be" M_EN; M_ST "stored under that name." M_EN; break; end; /* SERVE */ case SERVEV: begin M_ST "Syntax: SERVE" M_EN; M_ST " " M_EN; M_ST "The SERVE command causes HP 3000 KERMIT to go into" M_EN; M_ST "server mode. Once in server mode, the only way back" M_EN; M_ST "to command mode is the Control-Y trap." M_EN; M_ST " " M_EN; M_ST "In addition to the standard KERMIT transactions for" M_EN; M_ST "file transfer, the following server functions are" M_EN; M_ST "supported:" M_EN; M_ST " " M_EN; M_ST "FUNCTION PROBABLE SYNTAX" M_EN; M_ST " (If available on local KERMIT)" M_EN; M_ST "------------------- -------------------------------" M_EN; M_ST " " M_EN; M_ST "Finish serving FINISH" M_EN; M_ST "Type a file REMOTE TYPE filespec" M_EN; M_ST "Directory Listing REMOTE DIRECTORY [filespec]" M_EN; M_ST "File Space Listing REMOTE SPACE [filespec]" M_EN; M_ST "Delete a file REMOTE DELETE filespec" M_EN; M_ST " " M_EN; M_ST "Wildcard file specification may be used only for the" M_EN; M_ST "DIRECTORY and SPACE transactions. Wildcard specifi-" M_EN; M_ST "cations are in the native HP 3000 format. To produce" M_EN; M_ST "a DIRECTORY listing of all files starting with FOO use:" M_EN; M_ST " " M_EN; M_ST " REMOTE DIRECTORY FOO@" M_EN; break; end; /* SET */ case SETV: begin switch (LEVEL) begin /* SET HPCICOMMANDS IN GNERAL */ case DEBUGV-1: begin M_ST "SET items:" M_EN; M_ST " " M_EN; M_ST " SET DEBUG" M_EN; M_ST " SET DELAY" M_EN; M_ST " SET LINE" M_EN; M_ST " SET SEND" M_EN; M_ST " SET SPEED" M_EN; M_ST " SET HANDSHAKE" M_EN; M_ST " SET RECEIVE" M_EN; M_ST " SET LOG" M_EN; M_ST " SET SOH" M_EN; M_ST " SET FAST" M_EN; M_ST " " M_EN; M_ST "type 'SET item ?' for explanation" M_EN; break; end; /* SET DEBUG */ case DEBUGV: begin M_ST "Syntax: SET DEBUG number" M_EN; M_ST " " M_EN; M_ST "This sets the debug level to the indicated" M_EN; M_ST "number. Currently, only one level exists." M_EN; M_ST "This level is enabled by setting the number to" M_EN; M_ST "any non-negative, non-zero number. If DEBUG is" M_EN; M_ST "enabled, packets sent and received are written" M_EN; M_ST "to the LOG file." M_EN; break; end; /* SET DELAY */ case DELAYV: begin M_ST "Syntax: SET DELAY number" M_EN; M_ST " " M_EN; M_ST "Causes a pause for the indicated number of" M_EN; M_ST "seconds prior to starting a SEND command. This" M_EN; M_ST "is to allow the user to escape back to the local" M_EN; M_ST "KERMIT and enter a RECEIVE command." M_EN; break; end; /* SET LINE */ case LINEV: begin M_ST "Syntax: SET LINE ldev" M_EN; M_ST " " M_EN; M_ST "This causes the indicated ldev (logical device" M_EN; M_ST "number) to be used for communications purposes." M_EN; break; end; /* SET SEND */ case SENDV_1: begin M_ST " { PAUSE 1/10 secs}" M_EN; M_ST " { }" M_EN; M_ST "Syntax: SET SEND { { ON } }" M_EN; M_ST " { BINARY{ OFF } }" M_EN; M_ST " { { AUTO } }" M_EN; M_ST " " M_EN; M_ST "This parameter is used to alter the default" M_EN; M_ST "conditions relating to how files are sent." M_EN; break; end; /* SET SPEED */ begin M_ST "Syntax: SET SPEED speed" M_EN; M_ST " " M_EN; M_ST "Sets the communications speed to the indicated" M_EN; M_ST "number of characters per second. Supported" M_EN; M_ST "speeds are: 30, 60, 120, 480, 960, and 1920." M_EN; M_ST "Note that external devices may limit the speed " M_EN; M_ST "to lower rates." M_EN; break; end; /* SET HANDSHAKE */ case HANDSHAKEV: begin M_ST "Syntax: SET HANDSHAKE option" M_EN; M_ST " " M_EN; M_ST "This specifies any handshaking that is to be" M_EN; M_ST "done on the communications line. Options are:" M_EN; M_ST " " M_EN; M_ST "XON Generate an XON character prior to each" M_EN; M_ST "read. This is the default mode and is needed" M_EN; M_ST "in most cases since the HP will lose any" M_EN; M_ST "characters that are transmitted when no read is" M_EN; M_ST "posted. The local KERMIT must be capable of" M_EN; M_ST "waiting for an XON character before issuing a" M_EN; M_ST "a write to the communications line." M_EN; M_ST " " M_EN; M_ST "NONE Generate no special characters prior to a" M_EN; M_ST "read." M_EN; M_ST " " M_EN; M_ST "XON2 Same as XON except in both directions." M_EN; M_ST "This sets the read termination character to XON" M_EN; M_ST "in an attempt to synchronize with another KERMIT" M_EN; M_ST "having similar limitations." M_EN; break; end; /* SET RECEIVE */ case RECEIVEV_1: begin switch (RCVCASE) begin /* General stuff */ case BINARYV-1: begin M_ST "The SET RECEIVE parameter is used to alter the" M_EN; M_ST "default conditions regarding file reception." M_EN; M_ST "The various options are:" M_EN; M_ST " " M_EN; M_ST " SET RECEIVE DEVICE" M_EN; M_ST " SET RECEIVE FCODE" M_EN; M_ST " SET RECEIVE BINARY" M_EN; M_ST " SET RECEIVE RECLEN" M_EN; M_ST " SET RECEIVE FIXREC" M_EN; M_ST " SET RECEIVE BLOCKF" M_EN; M_ST " SET RECEIVE MAXREC" M_EN; M_ST " SET RECEIVE MAXEXT" M_EN; M_ST " SET RECEIVE SAVESP" M_EN; M_ST " SET RECEIVE PROG" M_EN; M_ST " SET RECEIVE TEXT" M_EN; M_ST " SET RECEIVE TXT80" M_EN; M_ST " SET RECEIVE BIN128" M_EN; M_ST " SET RECEIVE EXPTAB" M_EN; break; end; /* SET RECEIVE BINARY */ case BINARYV: begin M_ST "Syntax: SET RECEIVE BINARY { ON }" M_EN; M_ST " { OFF }" M_EN; M_ST " " M_EN; M_ST "BINARY tells how to store received files on the" M_EN; M_ST "3000." M_EN; M_ST " ON Store files as binary." M_EN; M_ST " OFF Store files as ASCII." M_EN; break; end; /* SET RECEIVE DEVICE */ case DEVICEV: begin M_ST "Syntax: SET RECEIVE DEVICE [ dev ]" M_EN; M_ST " " M_EN; M_ST "DEVICE specifies the device class for received" M_EN; M_ST "files. Default is DISC. This command can be" M_EN; M_ST "used to send files directly to the system line" M_EN; M_ST "printer." M_EN; M_ST " " M_EN; break; end; /* SET RECEIVE FCODE */ case FCODEV: begin M_ST "Syntax: SET RECEIVE FCODE n" M_EN; M_ST " " M_EN; M_ST "FCODE specifies the file code for received files." M_EN; break; end; /* SET RECEIVE RECLEN */ case RECLENV: begin M_ST "Syntax: SET RECEIVE RECLEN [-]n" M_EN; M_ST " " M_EN; M_ST "RECLEN specifies the maximum record length (n)" M_EN; M_ST "for a received file. As with other HP file " M_EN; M_ST "system commands, n is assumed to be words if" M_EN; M_ST "positive and bytes if negative" M_EN; break; end; /* SET RECEIVE BLOCKF */ case BLOCKFV: begin M_ST "Syntax: SET RECEIVE BLOCKF n" M_EN; M_ST " " M_EN; M_ST "BLOCKF specifies the blocking factor for received" M_EN; M_ST "files. If n is 0, the file system will calculate" M_EN; M_ST "a blocking factor automatically and usually " "unsatisfactorily." M_EN; break; end; /* SET RECEIVE FIXREC */ case FIXRECV: begin M_ST "Syntax: SET RECEIVE FIXREC { ON }" M_EN; M_ST " { OFF }" M_EN; M_ST " " M_EN; M_ST "FIXREC is used to identify fixed or variable" M_EN; M_ST "length records. Options are:" M_EN; M_ST " ON Use fixed length records." M_EN; M_ST " OFF Use variable length records."M_EN; break; end; /* SET RECEIVE MAXREC */ case MAXRECV: begin M_ST "Syntax: SET RECEIVE MAXREC n" M_EN; M_ST " " M_EN; M_ST "MAXREC specifies the maximum number of records" M_EN; M_ST "that can be stored in a received file." M_EN; break; end; /* SET RECEIVE MAXEXT */ case MAXEXTV: begin M_ST "Syntax: SET RECEIVE MAXEXT n" M_EN; M_ST " " M_EN; M_ST "MAXEXT specifies the maximum number of extents" M_EN; M_ST "for a received file. This number (n) must be in" M_EN; M_ST "the range 1 ... 32." M_EN; break; end; /* SET RECEIVE SAVESP */ case SAVESPV: begin M_ST "Syntax: SET RECEIVE SAVESP { ON }" M_EN; M_ST " { OFF }" M_EN; M_ST " " M_EN; M_ST "SAVESP specifies if unused file space at the end" M_EN; M_ST "of the file is to be returned to the operating" M_EN; M_ST "system. Options are:" M_EN; M_ST " ON Return unused apace" M_EN; M_ST " OFF Do not return unused space"M_EN; break; end; /* SET RECEIVE PROG */ case PROGV: begin M_ST "Syntax: SET RECEIVE PROG" M_EN; M_ST " " M_EN; M_ST "PROG will set all of the other parameters needed" M_EN; M_ST "to receive an HP 3000 program (executable) file." M_EN; M_ST "It is equivalent to:" M_EN; M_ST " SET RECEIVE BINARY ON" M_EN; M_ST " SET RECEIVE FIXREC ON" M_EN; M_ST " SET RECEIVE FCODE 1029" M_EN; M_ST " SET RECEIVE RECLEN 128" M_EN; M_ST " SET RECEIVE BLOCKF 1" M_EN; M_ST " SET RECEIVE MAXEXT 1" M_EN; break; end; /* SET RECEIVE BIN128 */ case BIN128V: begin M_ST "Syntax: SET RECEIVE BIN128" M_EN; M_ST " " M_EN; M_ST "BIN128 sets up the needed parameters for recei-" M_EN; M_ST "ving a binary file in the ""normal"" HP repre-" M_EN; M_ST "sentation. It is equivalent to:" M_EN; M_ST " SET RECEIVE BINARY ON" M_EN; M_ST " SET RECEIVE FIXREC OFF" M_EN; M_ST " SET RECEIVE FCODE 0" M_EN; M_ST " SET RECEIVE RECLEN 128" M_EN; M_ST " SET RECEIVE BLOCKF 0" M_EN; break; end; /* SET RECEIVE TEXT */ case TEXTV: begin M_ST "Syntax: SET RECEIVE TEXT" M_EN; M_ST " " M_EN; M_ST "TEXT sets up the needed parameters for receiving" M_EN; M_ST """generic"" text files. It is equivalent to:" M_EN; M_ST " SET RECEIVE BINARY OFF" M_EN; M_ST " SET RECEIVE FIXREC OFF" M_EN; M_ST " SET RECEIVE FCODE 0" M_EN; M_ST " SET RECEIVE RECLEN -254" M_EN; M_ST " SET RECEIVE BLOCKF 0" M_EN; break; end; /* SET RECEIVE TXT80 */ case TXT80V: begin M_ST "Syntax: SET RECEIVE TXT80" M_EN; M_ST " " M_EN; M_ST "TXT80 sets up the needed parameters for recei-" M_EN; M_ST "ving 80 character text files in the manner that" M_EN; M_ST "is most convenient for the typical text editor" M_EN; M_ST "on the HP. It is equivalent to:" M_EN; M_ST " SET RECEIVE BINARY OFF" M_EN; M_ST " SET RECEIVE FIXREC ON" M_EN; M_ST " SET RECEIVE FCODE 0" M_EN; M_ST " SET RECEIVE RECLEN -80" M_EN; M_ST " SET RECEIVE BLOCKF 16" M_EN; break; end; /* SET RECEIVE EXPTAB */ case EXPTABV: begin M_ST "Syntax: SET RECEIVE EXPTAB { ON }" M_EN; M_ST " { OFF }" M_EN; M_ST " " M_EN; M_ST "EXPTAB expands horizontal tabs found in the" M_EN; M_ST "data. Tab stops are assumed to be at columns" M_EN; M_ST "1, 9, 17, 25, etc." M_EN; break; end; break; end; /* case SET RECEIVE */ break; end; /* SET LOG */ case LOGV: begin M_ST "Syntax: SET LOG { [ filespec ] }" M_EN; M_ST " { PURGE }" M_EN; M_ST " " M_EN; M_ST "This command sets the LOG file to the indicated" M_EN; M_ST "filespec. Error and DEBUG messages (if enabled)" M_EN; M_ST "are written to the LOG file (see SET DEBUG)." M_EN; M_ST "If filespec is not specified, the current LOG" M_EN; M_ST "file, if open, is closed. If PURGE is specified," M_EN; M_ST "the file is closed and purged." M_EN; break; end; /* SET SOH */ case SOHV: begin M_ST "Syntax: SET SOH [%]n" M_EN; M_ST " " M_EN; M_ST "This option sets the value of the start-of-header" M_EN; M_ST "character used to begin each packet. If the %-" M_EN; M_ST "sign is used, n is assumed to be octal. Other-" M_EN; M_ST "wise n is assumed to be decimal. Default value" M_EN; M_ST "for SOH is 1." M_EN; break; end; /* SET FAST */ case FASTV: begin M_ST "Syntax: SET FAST {ON }" M_EN; M_ST " {OFF}" M_EN; M_ST " " M_EN; M_ST "FAST ON shortens both the number of timeouts " M_EN; M_ST "and the timeout time for receiving packets. " M_EN; M_ST "It is intended primarily for machine-to-machine" M_EN; M_ST "RECEIVES by this Kermit when there are also a" M_EN; M_ST "number of files stacked up to be transmitted by" M_EN; M_ST "this Kermit. The timing out may be too fast for" M_EN; M_ST "a human sitting at a PC Keyboard, and should " M_EN; M_ST "probably not be used in that case." M_EN; break; end; break; end; break; end; /* SET (LEVEL) case */ /* EXIT */ case EXITV: begin M_ST "Syntax: {EXIT}" M_EN; M_ST " {QUIT}" M_EN; M_ST " " M_EN; M_ST "This command causes the HP KERMIT process to" M_EN; M_ST "terminate in an orderly manner." M_EN; break; end; /* DIR */ case DIRV: begin M_ST "Syntax: DIR [filespec]" M_EN; M_ST " " M_EN; M_ST "This command searches the disc directory for the" M_EN; M_ST "indicated filespec, if any. Wildcard characters" M_EN; M_ST "may be used." M_EN; break; end; /* SPACE */ case SPACEV: begin M_ST "Syntax: SPACE [groupspec]" M_EN; M_ST " " M_EN; M_ST "This command reports the amount of in-use and" M_EN; M_ST "available disc for the user's account and group." M_EN; M_ST "(Groupspec may not be valid if the logon user does" M_EN; M_ST "not have account manager capability.)" M_EN; break; end; /* DELETE */ case DELETEV: begin M_ST "Syntax: DELETE filespec" M_EN; M_ST " " M_EN; M_ST "This command causes the indicated filespec to be" M_EN; M_ST "removed from disc." M_EN; break; end; /* TYPE */ case TYPEV: begin M_ST "Syntax: TYPE filespec" M_EN; M_ST " " M_EN; M_ST "TYPE lists a file on your terminal." M_EN; break; end; /* STATUS */ case STATUSV: begin M_ST "Syntax: { STATUS }" M_EN; M_ST " { VERIFY }" M_EN; M_ST " " M_EN; M_ST "STATUS provides a listing of the current file and" M_EN; M_ST "transmission attributes." M_EN; break; end; end; /* ITEM case */ M_ST " " M_EN; IB[ILEN-1] = ' '; /*Hopefully wipe out question mark*/ FWRITE(CONUM, IB, -ILEN, 0xD0); end #pragma SUBTITLE "SEARCH - Command table lookup" #pragma PAGE procedure SEARCH(TARGET, LENGTH, DICT, DEFN, START) int LENGTH, START; char TARGET[], DICT[], *DEFN ; begin int I; char *P; I = 0; P = DICT; while ( *( P+(*P)-1 ) < START ) P = P + *P; while ( *P != 0 ) begin I = I+1; if (LENGTH <= *(P+1) ) then if ( strncmp(TARGET, P+2, LENGTH) == 0) then if ( LENGTH >= MIN_SIZE[*(P+(*P)-1)] ) then begin *DEFN = *(P + (*P)-1); return I; end; P = P + *P; end; return 0; end #pragma SUBTITLE "READ_USER - Read from keyboard or TAKE file" #pragma page subroutine READ_USER(PROMPT) logical PROMPT; begin int DUM32; IBX = 0; /* Index to zero */ begin /* Not initial command */ if (CTLY) then begin M_ST " " M_EN; M_ST "" M_EN; M_ST " " M_EN; if (TAKENUM != 0) then begin FCLOSE(TAKENUM,0,0); TAKENUM = 0; end; CTLY = false; end; if (TAKENUM != 0) then begin /* Open TAKE file */ ILEN = FREAD(TAKENUM,IB,-72); if (ccode()==CCG) then begin /* End of file */ FCLOSE(TAKENUM,0,0); TAKENUM = 0; end else if (ccode()==CCL) then begin /* Some other error */ M_ST "Read error on TAKE file" M_EN; FCLOSE(TAKENUM,0,0); TAKENUM = 0; end; end; if (TAKENUM == 0) then do begin if (PROMPT) then begin strcpy(PBUF, "KERMIT3000>"); FWRITE(CONUM,PBUF,-strlen(PBUF), 0xD0); end; ILEN = FREAD(CINUM,IB,-80); if (ccode() != CCE) then begin strcpy(IB, "EXIT"); ILEN = 4; end; end while ( !(ILEN > 0 | !(PROMPT) ) ); end; IB_PTR = IB; IB[ILEN] = '^'; /* Stopper */ MY_JCW_VAL = IDLING; end #pragma SUBTITLE "SCANIT - Command scanner" #pragma PAGE subroutine SCANIT(START) int START; begin ITEM = NULLV; /* Default return */ CPLEN = 0; while (*IB_PTR == ' ') IB_PTR++; /* Skip blanks */ if (*IB_PTR == '^') then /* End of input */ begin return; end; if ( (*IB_PTR>='A' & *IB_PTR<='z') | *IB_PTR == '@' ) then begin do begin if ( *IB_PTR>='a' & *IB_PTR<='z' ) then CPARM[CPLEN] = *IB_PTR-' '; /* Upshift */ else CPARM[CPLEN] = *IB_PTR; IB_PTR++; /* Points after moved entity */ CPLEN++; end while ( (*IB_PTR != ' ') & (*IB_PTR != '^') ); if ( SEARCH(CPARM, CPLEN, RESWDS, &ITEMPTR, START)>0 ) then ITEM = ITEMPTR; return; end; if ('0' <= *IB_PTR & *IB_PTR <= '9' | *IB_PTR == '-' | *IB_PTR == '%') then begin /* It looks numeric. Will know for sure later. */ if (*IB_PTR == '-' | *IB_PTR == '%') then begin CPARM[CPLEN] = *IB_PTR; CPLEN++; IB_PTR++; end; if ( !('0' <= *IB_PTR & *IB_PTR <= '9') ) then begin return; end; while ('0' <= *IB_PTR & *IB_PTR<= '9') begin CPARM[CPLEN] = *IB_PTR; CPLEN++; IB_PTR++; end; CPVAL = BINARY(CPARM, CPLEN); if (ccode()==CCE) then /* If this is bad then */ ITEM = NUMBERV; /* move numeric is bad */ return; end; if (*IB_PTR == '?') then begin ITEM = QMARKV; IB_PTR++; return; end; /* At this point the item found is not alphanumeric, */ /* numeric (including optional minus sign), or question */ /* mark. Pass it back for the command processor to work */ /* with. */ while (*IB_PTR != ' ' & *IB_PTR != '^') begin CPARM[PLEN] = *IB_PTR; CPLEN++; IB_PTR++; end; /* del; ????? Cut back stack */ end #pragma SUBTITLE "CMDINT - Command Interpreter" #pragma PAGE procedure CMDINT(ICMD,ICLEN) int ICLEN ; char ICMD[] ; begin int IBYTE, /* Current Character */ X; /* Temp Variable */ int D_X; /* Temp Double */ logical DONE = false, /* Done Flag */ XFROK; /* Xfer OK flag */ float P_INT, /* PAUSE Interval*/ BRIEFLY = 1.0; /* Give HPCICOMMAND some time */ /* label TAKE_EXIT, SEND_EXIT, RECEIVE_EXIT, SERVE_EXIT, SET_EXIT; */ while ( !DONE ) begin if (ICLEN != 0) then begin strncpy(IB, ICMD, ICLEN); IB[ILEN=ICLEN] = '^'; IB_PTR = IB; ICLEN = 0; end else READ_USER(true); SCANIT(NULLV); if (TAKEV <= ITEM & ITEM <= VERIFYV) then switch (ITEM) begin /* TAKE */ case TAKEV: begin SCANIT(QMARKV); while (ITEM == QMARKV) begin HELP(TAKEV); READ_USER(false); SCANIT(QMARKV); if (CTLY) then goto TAKE_EXIT; end; if (ITEM != NULLV) then /* No reserved words allowed */ begin M_ST "Cannot use reserved word for filespec." M_EN; goto TAKE_EXIT; end; CPARM[CPLEN] = ' '; if (TAKENUM != 0) then begin FCLOSE(TAKENUM,0,0); TAKENUM = 0; end; TAKENUM = FOPEN(CPARM,0x5,0x400); if (TAKENUM == 0) then begin M_ST "take error" M_EN; end; TAKE_EXIT: break; end; /* SEND */ case SENDV: begin SCANIT(QMARKV); /* get local file name */ while (ITEM == QMARKV) begin HELP(SENDV); READ_USER(false); SCANIT(QMARKV); if (CTLY) then goto SEND_EXIT; end; MY_JCW_VAL = SEND_NG; /* pessimism */ while (CPLEN == 0) begin strcpy(PBUF, "HP3000 file name?"); FWRITE(CONUM, PBUF, -strlen(PBUF), 0xD0); READ_USER(false); SCANIT(QMARKV); if (CTLY) then goto SEND_EXIT; end; strcpy(L_FNAME, CPARM); L_FNAME[CPLEN] = ' '; L_FNAME_LEN = CPLEN; DNUM = FOPEN(L_FNAME,5,0); if (DNUM == 0) then begin M_ST "File open error" M_EN; end else begin SCANIT(QMARKV); if (CPLEN != 0) then begin strcpy(R_FNAME, CPARM); end; R_FNAME_LEN = CPLEN; if ( !OPEN_LINE() ) then begin M_ST "Line open failure" M_EN; end else begin M_ST "Escape back to your local KERMIT " "and enter the RECEIVE command" M_EN; if (I_DELAY > 0) then begin P_INT = I_DELAY; PAUSE(&P_INT); end; if (R_FNAME_LEN != 0) then XFROK = SENDSW(R_FNAME, -R_FNAME_LEN); else XFROK = SENDSW(L_FNAME, -L_FNAME_LEN); STATE = SBREAK(); if (LDEV_CI == LDEV_LINE) then SHUT_LINE(); /* Echo on, etc. */ if ( !XFROK ) then begin M_ST "SEND failure" M_EN; end else begin M_ST "SEND completed" M_EN; end; end; end; SEND_EXIT: PUTJCW(KERM_JCW, &MY_JCW_VAL, &JCW_ERR); L_FNAME_LEN = 0; break; end; /* RECEIVE */ case RECEIVEV: begin SCANIT(QMARKV); while (ITEM == QMARKV) begin HELP(RECEIVEV); READ_USER(false); SCANIT(QMARKV); if (CTLY) then goto RECEIVE_EXIT; end; MY_JCW_VAL = RECV_NG; /* pessimism */ while (CPLEN == 0) begin strcpy(PBUF, "HP3000 file name?"); FWRITE(CONUM, PBUF, -strlen(PBUF), 0xD0); READ_USER(false); SCANIT(QMARKV); if (CTLY) then goto RECEIVE_EXIT; end; strncpy(L_FNAME, CPARM, CPLEN); L_FNAME_LEN = CPLEN; strcpy(PBUF, "listf "); strncat(PBUF, L_FNAME, L_FNAME_LEN); strcat(PBUF, ";$null"); PBUF[strlen(PBUF)] = CR; HPCICOMMAND(PBUF, &ERROR, &PARM, NO_VISIBLE_MSG); if (ERROR != 0) then; /* Its not there. OK. */ else begin strcpy(PBUF, "File is already present. " "OK to remove? (Y/N)"); FWRITE(CONUM, PBUF, -strlen(PBUF), 0xD0); READ_USER(false); SCANIT(ONV); if (ITEM==YESV) then begin L_FNAME[L_FNAME_LEN] = 0; remove(L_FNAME); end else begin M_ST "RECEIVE attempt abandoned" M_EN; goto RECEIVE_EXIT; end; end; if ( !OPEN_LINE() ) then begin M_ST "Line open error" M_EN; end else begin M_ST "Escape back to your local KERMIT " "and enter the SEND command" M_EN; XFROK = RECSW(false); if (LDEV_CI == LDEV_LINE) then SHUT_LINE(); /* Echo on, etc. */ if ( !XFROK ) then begin M_ST "RECEIVE error" M_EN; end else begin M_ST "RECEIVE complete" M_EN; end; end; RECEIVE_EXIT: PUTJCW(KERM_JCW, &MY_JCW_VAL, &JCW_ERR); L_FNAME_LEN = 0; break; end; /* SERVE */ case SERVEV: begin SCANIT(QMARKV); if (ITEM == QMARKV) then begin HELP(SERVEV); READ_USER(false); if (CTLY) then goto SERVE_EXIT; end; if ( !OPEN_LINE() ) then begin M_ST "Line open failure" M_EN; end else begin M_ST "Entering SERVER mode - " "escape back to your local KERMIT" M_EN; SERVER(); if (LDEV_CI == LDEV_LINE) then SHUT_LINE(); /* DONE = !CTLY; */ end; SERVE_EXIT: break; end; /* SET */ case SETV: begin SCANIT(DEBUGV); if (ITEM == QMARKV) then begin HELP(SETV, DEBUGV-1); READ_USER(false); SCANIT(DEBUGV); if (CTLY) then goto SET_EXIT; end; if ( !(DEBUGV <= ITEM & ITEM <= FASTV) ) then begin M_ST "set error" M_EN; end else switch (ITEM) begin /* SET DEBUG */ case DEBUGV: begin SCANIT(QMARKV); while (ITEM == QMARKV) begin HELP(SETV, DEBUGV); READ_USER(false); SCANIT(QMARKV); if (CTLY) then goto SET_EXIT; end; if (ITEM == NUMBERV) then DEBUG_MODE = CPVAL; else begin M_ST "set debug error" M_EN; end; break; end; /* SET DELAY */ case DELAYV: begin SCANIT(QMARKV); while (ITEM == QMARKV) begin HELP(SETV, DELAYV); READ_USER(false); SCANIT(QMARKV); if (CTLY) then goto SET_EXIT; end; if (CPLEN == 0) then begin I_DELAY = 0; end else begin if (ITEM == NUMBERV) then I_DELAY = CPVAL; else begin M_ST "set delay error" M_EN; end; end; break; end; /* SET LINE */ case LINEV: begin SCANIT(QMARKV); while (ITEM == QMARKV) begin HELP(SETV, LINEV); READ_USER(false); SCANIT(QMARKV); if (CTLY) then goto SET_EXIT; end; if (CPLEN == 0) then begin LDEV_LINE = 0; SHUT_LINE(); end else begin if (ITEM != NUMBERV) then begin M_ST "set line error" M_EN; end else begin LDEV_LINE = CPVAL; SHUT_LINE(); end; end; ASCII(LDEV_LINE,-10,KERM_JCW+7); break; end; /* SET SEND */ case SENDV_1: begin SCANIT(PAUSEV); while (ITEM == QMARKV) begin HELP(SETV, SENDV_1); READ_USER(false); SCANIT(PAUSEV); if (CTLY) then goto SET_EXIT; end; if (ITEM == PAUSEV) then begin SCANIT(QMARKV); if (ITEM != NUMBERV) then begin M_ST "send pause error" M_EN; end else PAUSE_CNT = CPVAL; end else if (ITEM == BINARYV) then begin SCANIT(AUTOV); /* POTENTIAL TROUBLE */ if (AUTOV <= ITEM & ITEM <= OFFV) then SND_BINARY = ITEM-AUTOV; else begin M_ST "set send binary error" M_EN; end; end else begin M_ST "set send error" M_EN; end break; end; /* SET SPEED */ case SPEEDV: begin SCANIT(QMARKV); while (ITEM == QMARKV) begin HELP(SETV, SPEEDV); READ_USER(false); SCANIT(QMARKV); if (CTLY) then goto SET_EXIT; end; X = CPVAL; if( (X != 30) & (X != 60) & (X != 120) & (X != 240) & (X != 480) & (X != 960) & (X != 1920) ) then begin M_ST "Invalid SPEED, use 30,60,120,240,480,960,1920" M_EN; end else TSPEED = X; break; end; /* SET HANDSHAKE */ case HANDSHAKEV: begin SCANIT(ONV); while (ITEM == QMARKV) begin HELP(SETV, HANDSHAKEV); READ_USER(false); SCANIT(ONV); if (CTLY) then goto SET_EXIT; end; if (NONEV <= ITEM & ITEM <= XON2V) then HNDSHK = ITEM-NONEV; else begin M_ST "set handshake error" M_EN; end; break; end; /* SET RECEIVE */ case RECEIVEV_1: begin SCANIT(PAUSEV); while (ITEM == QMARKV) begin HELP(SETV, RECEIVEV_1, BINARYV-1); READ_USER(false); SCANIT(PAUSEV); if (CTLY) then goto SET_EXIT; end; if ( !(BINARYV <= ITEM & ITEM <= EXPTABV) ) then begin M_ST "set receive error" M_EN; end else /* case (ITEM-BINARYV of */ switch (ITEM) begin /* SET RECEIVE BINARY */ case BINARYV: begin SCANIT(ONV); while (ITEM == QMARKV) begin HELP(SETV, RECEIVEV_1, BINARYV); READ_USER(false); SCANIT(ONV); if (CTLY) then goto SET_EXIT; end; if (ITEM == ONV | ITEM == OFFV) then RCV_BINARY = (ITEM == ONV); else begin M_ST "set receive binary error" M_EN; end; break; end; /* SET RECEIVE DEVICE */ case DEVICEV: begin SCANIT(QMARKV); while (ITEM == QMARKV) begin HELP(SETV, RECEIVEV_1, DEVICEV); READ_USER(false); SCANIT(QMARKV); if (CTLY) then goto SET_EXIT; end; if (CPLEN != 0) then begin strcpy(RCV_DEV, CPARM); RCV_DEV[CPLEN] = CR; end else begin strcpy(RCV_DEV, "DISC"); RCV_DEV[CPLEN] = CR; end; break; end; /* SET RECEIVE FCODE */ case FCODEV: begin SCANIT(QMARKV); while (ITEM == QMARKV) begin HELP(SETV, RECEIVEV_1, FCODEV); READ_USER(false); SCANIT(QMARKV); if (CTLY) then goto SET_EXIT; end; if (ITEM != NUMBERV) then begin M_ST "set receive fcode error" M_EN; end else begin RCV_FCODE = CPVAL; end; break; end; /* SET RECEIVE RECLEN */ case RECLENV: begin SCANIT(QMARKV); while (ITEM == QMARKV) begin HELP(SETV, RECEIVEV_1, RECLENV); READ_USER(false); SCANIT(QMARKV); if (CTLY) then goto SET_EXIT; end; if (ITEM != NUMBERV) then begin M_ST "set receive reclen error" M_EN; end else if (CPVAL != 0) then begin RCV_RECLEN = CPVAL; end else RCV_RECLEN = -254; break; end; /* SET RECEIVE BLOCKF */ case BLOCKFV: begin SCANIT(QMARKV); while (ITEM == QMARKV) begin HELP(SETV, RECEIVEV_1, BLOCKFV); READ_USER(false); SCANIT(QMARKV); if (CTLY) then goto SET_EXIT; end; if (ITEM != NUMBERV) then begin M_ST "set receive blockf error" M_EN; end else begin RCV_BLOCKF = CPVAL; end; break; end; /* SET RECEIVE FIXREC */ case FIXRECV: begin SCANIT(ONV); while (ITEM == QMARKV) begin HELP(SETV, RECEIVEV_1, FIXRECV); READ_USER(false); SCANIT(ONV); if (CTLY) then goto SET_EXIT; end; if (ITEM == ONV | ITEM == OFFV) then RCV_FIXREC = (ITEM==ONV); else begin M_ST "set receive fixrec error" M_EN; end; break; end; /* SET RECEIVE MAXREC */ case MAXRECV: begin SCANIT(QMARKV); while (ITEM == QMARKV) begin HELP(SETV, RECEIVEV_1, MAXRECV); READ_USER(false); SCANIT(QMARKV); if (CTLY) then goto SET_EXIT; end; D_X = DBINARY(CPARM,CPLEN); if (ccode() != CCE) then begin M_ST "set receive maxrec error" M_EN; end else begin RCV_MAXREC = D_X; end; break; end; /* SET RECEIVE MAXEXT */ case MAXEXTV: begin SCANIT(QMARKV); while (ITEM == QMARKV) begin HELP(SETV, RECEIVEV_1, MAXEXTV); READ_USER(false); SCANIT(QMARKV); if (CTLY) then goto SET_EXIT; end; if (ITEM != NUMBERV) then begin M_ST "set receive maxext error" M_EN; end else begin RCV_MAXEXT = CPVAL; end; break; end; /* SET RECEIVE SAVESP */ case SAVESPV: begin SCANIT(ONV); while (ITEM == QMARKV) begin HELP(SETV, RECEIVEV_1, SAVESPV); READ_USER(false); SCANIT(ONV); if (CTLY) then goto SET_EXIT; end; if (ITEM == ONV | ITEM == OFFV) then RCV_SAVESP = (ITEM == ONV); else begin M_ST "set receive savesp error" M_EN; end; break; end; /* SET RECEIVE PROG */ case PROGV: begin SCANIT(QMARKV); while (ITEM == QMARKV) begin HELP(SETV, RECEIVEV_1, PROGV); READ_USER(false); SCANIT(QMARKV); if (CTLY) then goto SET_EXIT; end; RCV_BINARY = true; RCV_FIXREC = true; RCV_FCODE = 1029; RCV_RECLEN = 128; RCV_BLOCKF = 1; RCV_MAXEXT = 1; break; end; /* SET RECEIVE BIN128 */ case BIN128V: begin SCANIT(QMARKV); while (ITEM == QMARKV) begin HELP(SETV, RECEIVEV_1, BIN128V); READ_USER(false); SCANIT(QMARKV); if (CTLY) then goto SET_EXIT; end; RCV_BINARY = true; RCV_FIXREC = false; RCV_FCODE = 0; RCV_RECLEN = 128; RCV_BLOCKF = 0; break; end; /* SET RECEIVE TEXT */ case TEXTV: begin SCANIT(QMARKV); while (ITEM == QMARKV) begin HELP(SETV, RECEIVEV_1, TEXTV); READ_USER(false); SCANIT(QMARKV); if (CTLY) then goto SET_EXIT; end; RCV_BINARY = false; RCV_FIXREC = false; RCV_FCODE = 0; RCV_RECLEN = -254; RCV_BLOCKF = 0; break; end; /* SET RECEIVE TXT80 */ case TXT80V: begin SCANIT(QMARKV); while (ITEM == QMARKV) begin HELP(SETV, RECEIVEV_1, TXT80V); READ_USER(false); SCANIT(QMARKV); if (CTLY) then goto SET_EXIT; end; RCV_BINARY = false; RCV_FIXREC = true; RCV_FCODE = 0; RCV_RECLEN = -80; RCV_BLOCKF = 16; break; end; /* SET RECEIVE EXPTAB */ case EXPTABV: begin SCANIT(ONV); while (ITEM == QMARKV) begin HELP(SETV, RECEIVEV_1, EXPTABV); READ_USER(false); SCANIT(ONV); if (CTLY) then goto SET_EXIT; end; if (ITEM == ONV | ITEM == OFFV) then EXP_TABS = (ITEM == ONV); else begin M_ST "set receive exptab error" M_EN; end; break; end; end; /* SET RECEIVE cases */ break; end; /* SET LOG */ case LOGV: begin SCANIT(PAUSEV); while (ITEM == QMARKV) begin HELP(SETV, LOGV); READ_USER(false); SCANIT(PAUSEV); if (CTLY) then goto SET_EXIT; end; if (LOGNUM != 0 & LOGNUM != CONUM) then begin if (ITEM == PURGEV) then begin FCLOSE(LOGNUM,0x4,0); CPLEN = 0; end else FCLOSE(LOGNUM,0x9,0); LOGNUM = 0; end else if (ITEM == PURGEV) then CPLEN = 0; /* SCANIT; Was done above */ if (CPLEN == 0) then begin /* Take no action */ end else begin strncpy(LOGNAME, CPARM, LOGNAME_LEN=CPLEN); LOGNAME[LOGNAME_LEN+1] = 0; /* For VERIFY */ strcpy(PBUF, "listf "); ; strncat(PBUF, LOGNAME, LOGNAME_LEN); strcat(PBUF, "; $null"); PBUF[strlen(PBUF)] = CR; HPCICOMMAND(PBUF, &ERROR, &PARM, NO_VISIBLE_MSG); if (ERROR != 0) then; /* Its not there. OK. */ else begin strcpy(PBUF, "File is already present. " "Ok to remove? (Y/N)"); FWRITE(CONUM, PBUF, -strlen(PBUF), 0xD0); READ_USER(false); SCANIT(ONV); if (ITEM == YESV) then begin LOGNAME[LOGNAME_LEN] = 0; remove(LOGNAME); end else begin M_ST "SET LOG attempt abandoned" M_EN; goto SET_EXIT; end; end; LOGNAME[LOGNAME_LEN] = ' '; LOGNUM = FOPEN(LOGNAME,0x4,0x1,64, 0,0,0,2,0,10016); if (LOGNUM == 0) then begin M_ST "File open error" M_EN; end; end; break; end; /* SET SOH */ case SOHV: begin SCANIT(QMARKV); while (ITEM == QMARKV) begin HELP(SETV, SOHV); READ_USER(false); SCANIT(QMARKV); if (CTLY) then goto SET_EXIT; end; if (ITEM == NUMBERV) then SOH = CPVAL; else begin M_ST "set soh error" M_EN; end; break; end; /* SET FAST */ case FASTV: begin SCANIT(ONV); while (ITEM == QMARKV) begin HELP(SETV, FASTV); READ_USER(false); SCANIT(ONV); if (CTLY) then goto SET_EXIT; end; if (ITEM == ONV | ITEM == OFFV) then IMPATIENT = (ITEM==ONV); else begin M_ST "set fast error" M_EN; end; break; end; break; end; /* SET cases */ SET_EXIT: break; end; /* EXIT */ case EXITV: begin SCANIT(QMARKV); while (ITEM == QMARKV) begin HELP(EXITV); READ_USER(false); SCANIT(QMARKV); if (CTLY) then goto EXIT_EXIT; end; DONE = true; EXIT_EXIT: break; end; /* DIR */ case DIRV: begin SCANIT(QMARKV); while (ITEM == QMARKV) begin HELP(DIRV); READ_USER(false); SCANIT(QMARKV); if (CTLY) then goto DIR_EXIT; end; begin strcpy(PBUF, "LISTF "); strncat(PBUF, CPARM, CPLEN); strcat(PBUF, ", 2"); PBUF[strlen(PBUF)] = CR; HPCICOMMAND(PBUF, &ERROR, &PARM, NO_VISIBLE_MSG); if (ERROR > 0) then begin printf("CIerror %d \n", ERROR); end; end; DIR_EXIT: break; end; /* SPACE */ case SPACEV: begin SCANIT(QMARKV); while (ITEM == QMARKV) begin HELP(SPACEV); READ_USER(false); SCANIT(QMARKV); if (CTLY) then goto SPACE_EXIT; end; begin strcpy(PBUF, "REPORT "); strncat(PBUF, CPARM, CPLEN); PBUF[strlen(PBUF)] = CR; HPCICOMMAND(PBUF, &ERROR, &PARM, NO_VISIBLE_MSG); if (ERROR > 0) then begin printf("CIerror %d \n", ERROR); end else begin M_ST " " M_EN; /* Cosmetic output */ end; end; SPACE_EXIT: break; end; /* DELETE */ case DELETEV: begin SCANIT(QMARKV); while (ITEM == QMARKV) begin HELP(DELETEV); READ_USER(false); SCANIT(QMARKV); if (CTLY) then goto DELETE_EXIT; end; if (CPLEN > 0) then begin strncpy(PBUF, CPARM, CPLEN); CPARM[CPLEN] = 0; ERROR = remove(CPARM); if (ERROR != 0) then begin printf("CIerror %d \n", ERROR); end; PAUSE(&BRIEFLY); /* Let HPCICOMMAND finish */ end else begin M_ST "Filespec missing or invalid" M_EN; end; DELETE_EXIT: break; end; /* TYPE */ case TYPEV: begin SCANIT(QMARKV); /* get local file name */ while (ITEM == QMARKV) begin HELP(TYPEV); READ_USER(false); SCANIT(QMARKV); if (CTLY) then goto SEND_EXIT; end; while (CPLEN == 0) begin strcpy(PBUF, "HP3000 file name?"); FWRITE(CONUM, PBUF, -strlen(PBUF), 0xD0); READ_USER(false); SCANIT(QMARKV); if (CTLY) then goto SEND_EXIT; end; strncpy(L_FNAME, CPARM, CPLEN); L_FNAME[CPLEN] = ' '; L_FNAME_LEN = CPLEN; M_ST " " M_EN; if ( TYPESW() ) then begin M_ST " " M_EN; M_ST "TYPE completed" M_EN; end else begin M_ST " " M_EN; M_ST "TYPE failure" M_EN; end; L_FNAME_LEN = 0; break; end; /* VERIFY */ case STATUSV: begin SCANIT(QMARKV); while (ITEM == QMARKV) begin HELP(VERIFYV); READ_USER(false); SCANIT(QMARKV); if (CTLY) then goto VERIFY_EXIT; end; VERIFY(); VERIFY_EXIT: break; end; end /* case */ else if (ITEM == QMARKV) then HELP(NULLV); else begin M_ST "command error" M_EN; end; end; end #pragma SUBTITLE "Main program (for what its worth)" #pragma PAGE main (ARGC, ARGV, envp, PARM_VAL, INFO_STR) int ARGC; char *ARGV[]; /* Individual groups in INFO */ char *envp[]; /* Book sez do not reference this, period */ int PARM_VAL; char *INFO_STR; { if ((TAKE_VAL=PARM_VAL) == 0) then /*Must be in outer block*/ TAKE_VAL = GETJCW(); /*to work*/ if ( !KINIT() ) then begin QUIT(7300+TAKE_VAL); end else begin CMDINT(INFO_STR, strlen(INFO_STR)); SHUT_LINE(); if (HAVE_KTEMP) then KILL_KTEMP(); if (LOGNUM != 0) then FCLOSE(LOGNUM, 0x9, 0); end; }