home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
archives
/
hp3000.tar.gz
/
hp3000.tar
/
hp3000.c
< prev
next >
Wrap
C/C++ Source or Header
|
1994-09-03
|
188KB
|
5,789 lines
#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 <stdio.h>
#include <string.h>
#include <time.h>
#include <ctype.h>
#include <stdlib.h>
#include <mpe.h>
#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<LEN; ++IX)
XCK(DATA[IX]);
if ((STATE == 'S') |
(STATE == 'R') |
(YOUR_BLK_CK == '1')) then
begin /* Kermit primative checksum */
CHKSUM = (CHKSUM) % 256;
CHKSUM = ((CHKSUM)/64 + (CHKSUM)%64)%64;
LBUF[INX] = TOCHAR(CHKSUM); /* Insert checksum */
INX++;
end
else
begin /* Fancy 3-byte CRC */
CHKSUM = CALCULATE_CRC(LBUF, INX-1);
LBUF[INX] = TOCHAR(CHKSUM/4096); /* Byte 1 */
LBUF[INX=INX+1] = TOCHAR((CHKSUM%4096)/64); /* Byte 2 */
LBUF[INX=INX+1] = TOCHAR(CHKSUM%64); /* Byte 3 */
INX = INX + 1;
end;
*OX = INX;
#undef XCK
end
#pragma SUBTITLE "BUILD A LONG PACKET"
#pragma PAGE
subroutine LONG_PACK(LBUF, DATA, LEN, NUM, TYP, OX)
char LBUF[],
DATA[];
int LEN,
NUM,
TYP,
*OX;
begin
int IX,
INX = 1;
register int CHKSUM=0;
#define XCK(CHR) {LBUF[INX]=CHR; CHKSUM=CHKSUM+CHR; INX++;}
LBUF[0] = SOH;
XCK(TOCHAR(0)); /*Length=0 says long data packet*/
XCK(TOCHAR(NUM)); /*Packet number*/
XCK(TYP); /*Should be 'D' only*/
IX = LEN + (YOUR_BLK_CK-'0');
XCK(TOCHAR(IX / 95)); /*Length, most significant part*/
XCK(TOCHAR(IX % 95)); /*Length, least significant part*/
CHKSUM = CHKSUM%256;
XCK(TOCHAR( ((CHKSUM/64)+(CHKSUM%64) )%64 )); /*HDR BCC*/
if (YOUR_BLK_CK == '1') then
begin
for (IX=0; IX<LEN; ++IX)
XCK(DATA[IX]);
CHKSUM = (CHKSUM/64+CHKSUM%64)%64;
LBUF[INX] = TOCHAR( CHKSUM );
end
else
begin /* Fancy 3-byte CRC */
strncpy(LBUF+INX, DATA, LEN);
INX = INX+LEN;
CHKSUM = CALCULATE_CRC(LBUF, INX-1);
LBUF[INX] = TOCHAR(CHKSUM/4096); /* Byte 1 */
LBUF[INX=INX+1] = TOCHAR((CHKSUM%4096)/64); /* Byte 2 */
LBUF[INX=INX+1] = TOCHAR(CHKSUM%64); /* Byte 3 */
end;
*OX = INX+1;
#undef XCK
end
#pragma SUBTITLE "SPACK - Send a packet"
#pragma PAGE
procedure SPACK(TYP,NUM,LEN,DATA)
char TYP;
int NUM,LEN;
char DATA[];
begin
logical R_ERROR = false;
int OX = 1;
float P_INT;
if ((LEN > 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 "<CONTROL-Y>" 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;
}