home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
gould3
/
kermit0
< prev
next >
Wrap
Text File
|
2020-01-01
|
121KB
|
1,498 lines
* BASE -ULTLY-KERM -SFM-A2703 - 08/01/90 WJH HEADER SFMKERM 0001.000
PROGRAM KERMIT 0001.100
IMPLICIT NONE 0002.000
C 0003.000
C= File transfer program using kermit protocol 0004.000
C 0005.000
C 0006.000
C REVISION LIST 0007.000
C 0008.000
C 1.0 This Kermit was the direct implemention of the Cyber-170 0009.000
C version, University of Texas. L. Tate, SAI, Sept. 1985. 0010.000
C 0011.000
C 2.0 Added the CONNECT, GET, FINISH, BYE commands. This required 0012.000
C significant changes to the io interface. The local on/off 0013.000
C option was also part of this. L. Tate, SAI, Nov. 1985. 0014.000
C 0015.000
C 2.1 Correct bug in SUDT. When use the SVC 1,X'27' which 0016.000
C set full duplex on a terminal it previously used a trashed 0017.000
C file control block. This had caused unpredicatable results 0018.000
C in alot of the io including 2 reads pending at once. 0019.000
C Correcting this problem allowed removal of HIOALL routine. 0020.000
C Files to be read are opened with OPENMODE='R' and files to 0021.000
C be written are opened with OPENMODE='U'. Also added the 0022.000
C TAKE command. L. Tate, SAI, Mar. 1986. 0023.000
C 0024.000
C 2.2 Improved receive/get reliablity by moving the terminal 0025.000
C reporting to before the ACK/NAK is sent. The problem seems 0026.000
C to have been during the reporting time, the sending flooded 0027.000
C the 8-line buffer and caused a break, losing data. Also 0028.000
C corrected error in printl routine which wrote to stdout 0029.000
C instead of the parameter fd. L. Tate, SAI, Mar. 1986. 0030.000
C 0031.000
C 2.3 Added to SERVER the ability to recognize the I packet. 0032.000
C This packet is used by advanced Kermits (2.27 at least) 0033.000
C to initialize the Server. 0034.000
C Changed the method by which nowait is established so that 0035.000
C if ECHO was off for the terminal before kermit operation, 0036.000
C it will remain so afterwards. Good for network operation. 0037.000
C Corrected the error reporting code such that now the error 0038.000
C messages are produced. However, they can be very cryptic. 0039.000
C What is needed is a general method of handling text, like 0040.000
C help messages and error messages, such that memory is not 0041.000
C filled but ready access is available. 0042.000
C L. TATE, SAI, MAY 1986. 0043.000
C 0044.000
C AS IN TO LFC=UT 0045.000
C AS OUT TO LFC=UT 0046.000
C 0047.000
C 0048.000
C 2.4 Modified to run on GOULD 32/77 machine using the MPX 1.5E 0049.000
C operating system. 0050.000
C B.WILSON, QEC, JANUARY 1989 0051.000
C 0052.000
C 0053.000
C 0054.000
INCLUDE K.KERMV 0055.000
INCLUDE K.KERMD 0056.000
INCLUDE K.PROTC 0057.000
INCLUDE K.MSGCOM 0058.000
INCLUDE K.DBUGC 0059.000
C 0060.000
INTEGER NCMD ;PARAMETER (NCMD=15) 0061.000
CHARACTER*10 CMD(NCMD) !commands 0062.000
$ /'BYE', 'CONNECT','EXIT','FINISH','GET','HELP', 0063.000
$ 'QUIT','RECEIVE','SEND','SERVER', 0064.000
$ 'SET', 'SHOW', 'STATUS','TAKE', 'X'/ 0065.000
INTEGER NNOLOCAL ;PARAMETER (NNOLOCAL = 3) 0066.000
CHARACTER*63 NOLOCAL (NNOLOCAL) 0067.000
$/'This KERMIT does not support the following commands; BYE,', 0068.000
$ 'CONNECT, FINISH, SEND and GET. These commands require KERMIT', 0069.000
$ 'to be installed on MPX3.2B or greater.'/ 0070.000
INTEGER IDX !current command 0071.000
CHARACTER*80 CMDLIN !command line that started program 0072.000
INTEGER IOS 0073.000
C 0074.000
INTEGER MATCH !get and match command 0075.000
INTEGER OPEN 0076.000
C 0077.000
INPUTFD = 0 0077.100
CALL SLINE(CMDLIN) !get startup command line 0078.000
CALL INIT(CMDLIN) !pass to initialize 0079.000
C 0080.000
IOS = OPEN('STDIN','R') 0081.000
IF (IOS .NE. STDIN) THEN 0082.000
CALL PRTMSG(' Cannot open standard input', -IOS) 0083.000
STOP 0084.000
ENDIF 0085.000
IOS = OPEN('STDOUT','W') 0086.000
IF (IOS .NE. STDOUT) THEN 0087.000
CALL PRTMSG(' Cannot open standard output',-IOS) 0088.000
STOP 0089.000
ENDIF 0090.000
C 0091.000
C initializing program 0092.000
C 0093.000
C INPUTFD = OPEN('KERM.INI', 'R') 0094.000
IF (INPUTFD .LE. 0) INPUTFD = STDIN 0095.000
C 0096.000
CALL PRINTL(STDOUT, VERSION) 0097.000
DO BEGIN 0098.000
IF (INPUTFD .EQ. STDIN) THEN 0099.000
CALL PUTSTR(STDOUT, PROMPT) 0100.000
CALL FLUSH(STDOUT) 0101.000
ENDIF 0102.000
CALL FLUSH(INPUTFD) 0103.000
IDX = MATCH(CMD, NCMD, .TRUE.) 0104.000
IF (IDX .EQ. ERROR .OR. IDX .EQ. 0) GOTO 200 0105.000
IF (IDX .EQ. EOF) THEN 0106.000
IF (INPUTFD .NE. STDIN) THEN 0107.000
CALL TAKEDONE 0108.000
GOTO 200 0109.000
ELSE 0110.000
CALL EXITPGM 0111.000
ENDIF 0112.000
ENDIF 0113.000
GOTO (130, 40, 50, 140, 20, 90, 50, 30, 10, 80, 100, 0114.000
$ 110, 120, 60, 50 ) IDX 0115.000
C 0116.000
10 CONTINUE !send - Not debugged yet 0117.000
C CALL SNDFILE 0118.000
C GOTO 200 0119.000
GO TO 190 0120.000
20 CONTINUE !get 0121.000
IF (.NOT. LOCALON) GOTO 190 0122.000
CALL GETFROM 0123.000
GOTO 200 0124.000
30 CONTINUE !receive 0125.000
CALL RCVFILE 0126.000
GOTO 200 0127.000
40 CONTINUE !connect 0128.000
IF (.NOT. LOCALON) GOTO 190 0129.000
CALL CONNECT 0130.000
GOTO 200 0131.000
50 CONTINUE !exit 0132.000
CALL EXITPGM 0133.000
60 CONTINUE !take 0134.000
CALL TAKE 0135.000
GOTO 200 0136.000
80 CONTINUE !server 0137.000
CALL SERVER 0138.000
CALL INIT(CMDLIN) 0138.100
GOTO 200 0139.000
90 CONTINUE !help 0140.000
CALL HELP 0141.000
GOTO 200 0142.000
100 CONTINUE !set 0143.000
CALL SET 0144.000
GOTO 200 0145.000
110 CONTINUE !show 0146.000
CALL SHOW 0147.000
GOTO 200 0148.000
120 CONTINUE !status 0149.000
CALL STATUS 0150.000
GOTO 200 0151.000
130 CONTINUE !bye 0152.000
IF (.NOT. LOCALON) GOTO 190 0153.000
CALL BYE 0154.000
GOTO 200 0155.000
140 CONTINUE !finish 0156.000
IF (.NOT. LOCALON) GOTO 190 0157.000
CALL FINISH 0158.000
GOTO 200 0159.000
190 CONTINUE !no local 0160.000
CALL OUTTBL(NOLOCAL, 1, NNOLOCAL) 0161.000
GOTO 200 0162.000
210 CONTINUE 0162.100
200 CONTINUE 0163.000
ENDDO 0164.000
END 0165.000
SUBROUTINE INIT(COMLIN) 0166.000
IMPLICIT NONE 0167.000
CHARACTER*80 COMLIN !command line of program 0168.000
C 0169.000
C= initializes all kermit context 0170.000
C 0171.000
INCLUDE K.KERMV 0172.000
INCLUDE K.KERMD 0173.000
INCLUDE K.DBUGC 0174.000
INCLUDE K.PROTC 0175.000
INCLUDE K.PACKC 0176.000
INCLUDE K.MSGCOM 0177.000
C 0178.000
INTEGER I !index 0179.000
CHARACTER*2 MACH !machine type code 0180.000
C 0181.000
INTEGER LASTCHR !last non blank character 0182.000
INTRINSIC ICHAR !character to int 0183.000
C INTEGER ICHAR 0183.100
INTEGER MATCH 0184.000
INTEGER OPEN 0185.000
C 0186.000
C dbugcom 0187.000
C 0188.000
C CALL M_UPRIV 0189.000
CALL BREAKR 0190.000
C 0191.000
DEBUG = .FALSE. !no debug on 0192.000
DBGFD = 0 !standoutput 0193.000
DBGFILE = 'KERMLOG' !standoutput 0194.000
C 0195.000
C protcom 0196.000
C 0197.000
PACKET = 0 0198.000
RECPACK = 0 0199.000
FILESTR = 0 0200.000
PSIZE = 0 0201.000
PACKNUM = 0 0202.000
NUMTRY = 0 0203.000
MAXRTRY = MAXTRY 0204.000
MAXRINI = MAXINIT 0205.000
STATE = C 0206.000
IFD = STDIN 0207.000
OFD = STDOUT 0208.000
COMPORT = 'UT' 0209.000
FFD = 0 0210.000
DELAYFP = 0 0211.000
STARTIM = 0 0212.000
ENDTIM = 0 0213.000
SCHCNT = 0 0214.000
RCHCNT = 0 0215.000
SCHOVRH = 0 0216.000
RCHOVRH = 0 0217.000
ECHO = .FALSE. 0218.000
ESCCHR = 29 ! CONTROL-] 0219.000
LOG = .FALSE. 0220.000
LFD = 0 0221.000
LOGFILE = 'KERMSESN' 0222.000
INSTACK = 0 !initialize stack pointer 0223.000
INSTKFD = 0 !zero stack for good measure 0224.000
C 0225.000
C packcom 0226.000
C 0227.000
SYNC = SNDSYNC = SOH 0228.000
PACKSIZ = SPKSIZ = MAXPACK 0229.000
TIMEOUT = STIMOUT = MYTIME 0230.000
NPAD = SPAD = MYPAD 0231.000
PADCH = SPADCH = MYPADCH 0232.000
EOLCH = SPEOL = MYEOL 0233.000
QUOTECH = SPQUOTE = MYQUOTE 0234.000
QUOTE8 = S8QUOTE = QUOT8CH 0235.000
CHKTYP = SCHKTYP = MYCKTYP 0236.000
RESERVE = UNUSED = 0 0237.000
RPREFIX = SREPEAT = PREFXCH 0238.000
C 0239.000
C msgcom 0240.000
C 0241.000
IF (LOCALON) THEN 0242.000
VERSION = 'Gould KERMIT version 2.3, Local/Remote enabled' 0243.000
ELSE 0244.000
VERSION = 'Gould KERMIT version 2.3, Local/Remote disabled' 0245.000
ENDIF 0246.000
CALL GETMACH(MACH) 0247.000
PROMPT(1) = NEL 0248.000
CALL DPC2AS('kermit-'//MACH//'>', PROMPT(2), 19) 0249.000
I = LASTCHR(COMLIN) 0250.000
IF (I .GT. 18 ) I = 18 0251.000
IF (I .GT. 0) CALL DPC2AS(COMLIN(:I)//'>', PROMPT(2), I+1) 0252.000
CLT 2.3 FIXED THE LOGIC FOR LNAME 0253.000
I = 2 0254.000
LNAME = 0 0255.000
DO WHILE (PROMPT(I) .NE. ICHAR('>') .AND. I .LT. 21) 0256.000
LNAME = LNAME + 1 0257.000
NAME(LNAME) = PROMPT(I) 0258.000
I = I + 1 0259.000
ENDDO 0260.000
C 0261.000
CALL BREAKR 0262.000
CALL X:SYNCH 0263.000
C 0264.000
RETURN 0265.000
END 0266.000
SUBROUTINE EXITPGM 0267.000
IMPLICIT NONE 0268.000
C 0269.000
C= Exit kermit 0270.000
C 0271.000
INTEGER I !index 0272.000
C 0273.000
DO I=1, 10 0274.000
CALL CLOSE(I) 0275.000
ENDDO 0276.000
CALL EXIT 0277.000
END 0278.000
SUBROUTINE RCVFILE 0279.000
IMPLICIT NONE 0280.000
C 0281.000
C= Top level subroutine to start receive state. 0282.000
C 0283.000
INCLUDE K.KERMD 0284.000
INCLUDE K.PROTC 0285.000
INCLUDE K.PACKC 0286.000
C 0287.000
INTEGER RECEIVE !receive file 0288.000
INTEGER GTTY !get tty status 0289.000
LOGICAL CONFIRM !confirm input 0290.000
C 0291.000
IF (.NOT. CONFIRM(INPUTFD)) RETURN 0292.000
C 0293.000
C receive file 0294.000
C 0295.000
CALL STTY(IFD, 'BINARY', ON) 0296.000
CALL STTY(IFD, 'TIMEOUT', TIMEOUT) 0297.000
CALL STTY(IFD, 'NOWAIT', ON) 0298.000
IF (INPUTFD .NE. STDIN .AND. OFD .NE. STDOUT) THEN 0299.000
CALL PRINTL(STDOUT, 'Receiving file ') 0300.000
CALL PUTSTR(STDOUT, FILESTR) 0301.000
CALL FLUSH(STDOUT) 0302.000
ENDIF 0303.000
IF (RECEIVE(R) .EQ. OK) THEN 0304.000
CALL PRINTL(STDOUT, 'Receive complete.') 0305.000
ELSE 0306.000
CALL PRINTL(STDOUT, 'Received failed.') 0307.000
ENDIF 0308.000
CALL STTY(IFD, 'NOWAIT', OFF) 0309.000
CALL STTY(IFD, 'TIMEOUT', 0) 0310.000
CALL STTY(IFD, 'BINARY', OFF) 0311.000
RETURN 0312.000
END 0313.000
SUBROUTINE SNDFILE 0314.000
IMPLICIT NONE 0315.000
C 0316.000
C= Sends a file to other kermit 0317.000
C 0318.000
INCLUDE K.KERMD 0319.000
INCLUDE K.PROTC 0320.000
INCLUDE K.PACKC 0321.000
C 0322.000
CHARACTER*8 FNAME !name of file to send 0323.000
INTEGER IRET !return status 0324.000
C 0325.000
LOGICAL ISFILE 0326.000
INTEGER SEND 0327.000
C 0328.000
C pick up file name and save it for opening later 0329.000
C 0330.000
CALL SETVAL(FILESTR, 'S', IRET, 16, 0, 0, 0331.000
$ 'Filename to send', .TRUE.) 0332.000
IF (IRET .EQ. ERROR) RETURN 0333.000
C 0334.000
C check to make sure it's there to send 0335.000
C 0336.000
CALL AS2DPC(FILESTR, FNAME) 0337.000
IF (.NOT. ISFILE(FNAME)) THEN 0338.000
CALL PRINTL(STDOUT, '?File ') 0339.000
CALL PUTSTR(STDOUT, FILESTR) 0340.000
CALL PRINT(STDOUT,' is not found.') 0341.000
CALL PUTC(STDOUT, NEL) 0342.000
RETURN 0343.000
ENDIF 0344.000
C 0345.000
CALL STTY(IFD, 'BINARY', ON) 0346.000
CALL STTY(IFD, 'TIMEOUT', TIMEOUT) 0347.000
CALL STTY(IFD, 'NOWAIT', ON) 0348.000
C 0349.000
C delay the first packet 0350.000
C 0351.000
IF (DELAYFP .GT. 0) CALL SLEEP(DELAYFP) 0352.000
C 0353.000
C start sending packet 0354.000
C 0355.000
IF (INPUTFD .NE. STDIN .AND. OFD .NE. STDOUT) THEN 0356.000
CALL PRINTL(STDOUT, 'Sending file ') 0357.000
CALL PUTSTR(STDOUT, FILESTR) 0358.000
CALL FLUSH(STDOUT) 0359.000
ENDIF 0360.000
PACKNUM = 0 0361.000
IF (SEND() .EQ. OK) THEN 0362.000
CALL PRINTL(STDOUT, 'Send complete.') 0363.000
ELSE 0364.000
CALL PRINTL(STDOUT, 'Send failed.') 0365.000
ENDIF 0366.000
CALL STTY(IFD, 'NOWAIT', OFF) 0367.000
CALL STTY(IFD, 'TIMEOUT', 0) 0368.000
CALL STTY(IFD, 'BINARY', OFF) 0369.000
RETURN 0370.000
END 0371.000
SUBROUTINE SERVER 0372.000
IMPLICIT NONE 0373.000
C 0374.000
C= Start kermit server routine 0375.000
C 0376.000
C The server currently knows about the send and receive packets 0377.000
C and also the generic kermit packets logout and finish. 0378.000
C 0379.000
INCLUDE K.KERMD 0380.000
INCLUDE K.DBUGC 0381.000
INCLUDE K.PROTC 0382.000
INCLUDE K.PACKC 0383.000
C 0384.000
INTEGER PTYP 0385.000
INTEGER I 0386.000
INTEGER NUM !packet number 0387.000
INTEGER RECSTAT !receive status 0388.000
INTEGER SNDSTAT !send status 0389.000
CHARACTER*72 SRVMES (4 ) 0390.000
$ /'[Kermit SERVER running on Gould host. Please type your', 0391.000
$ 'escape sequence ( altK ) to return to your local machine', 0392.000
$ 'Use GET to request a file from the GOULD host. ', 0393.000
$ 'Use FINISH to return control to GOULD host.]'/ 0394.000
CHARACTER*56 FILENAME 0395.000
INTEGER*8 FINAME 0396.000
CHARACTER*8 FCNAME 0397.000
EQUIVALENCE (FILENAME,FINAME,FCNAME) 0398.000
C 0399.000
LOGICAL CONFIRM 0400.000
INTEGER RDPACK !read a packet 0401.000
INTEGER SNDPAR !build init packet 0402.000
INTEGER GTTY !get terminal stuff 0403.000
INTEGER RECEIVE !receive file 0404.000
INTEGER SEND !send file 0405.000
INTEGER LASTCHR !last non-blank character 0406.000
INTEGER MAX 0407.000
INTEGER SLEN !string length 0408.000
INTEGER USCMD 0408.100
LOGICAL ISFILE !does file exist 0409.000
INTEGER M /'A'/ 0409.010
C 0409.100
INTRINSIC MOD 0409.200
C 0410.000
IF (.NOT. CONFIRM(INPUTFD)) RETURN 0411.000
C 0412.000
C initialize msg #, say no tries yet 0413.000
C 0414.000
PACKNUM = 0 0415.000
USCMD = 0 0415.100
NUMTRY = 0 0416.000
CALL OUTTBL(SRVMES, 1, 4) 0417.000
C 0418.000
CALL STTY(IFD, 'BINARY', ON) 0419.000
CALL STTY(IFD, 'TIMEOUT', TIMEOUT) 0420.000
CALL STTY(IFD, 'NOWAIT', ON) 0421.000
CALL STTY(IFD, 'SIZE' ,768) 0421.100
C 0422.000
10 CONTINUE 0423.000
PTYP = RDPACK(LEN, NUM, RECPACK) 0424.000
X WRITE(19,1000)PTYP,LEN,NUM 0424.100
X1000 FORMAT(' 4242** ',8(1X,1Z8)) 0424.200
IF (PTYP .EQ. S) THEN 0425.000
PACKNUM = NUM 0426.000
CALL RDPARAM(RECPACK) 0427.000
I = SNDPAR(PACKET) 0428.000
X WRITE(19,1001)Y,PACKNUM,I,PACKET 0428.100
X1001 FORMAT(' 428.2** ',8(1X,1Z8)) 0428.200
CALL SNDPACK(Y, PACKNUM, I, PACKET) 0429.000
NUMTRY = 0 0430.000
PACKNUM = MOD(PACKNUM+1, 64) 0431.000
RECSTAT = RECEIVE(F) 0432.000
X WRITE(19,1002)RECSTAT 0432.100
X1002 FORMAT(' 432.2** ',1Z8) 0432.200
IF (DEBUG(DBGON)) THEN 0433.000
IF (RECSTAT .EQ. ERROR) THEN 0434.000
CALL PRINTL(DBGFD, 'Receive failed.') 0435.000
ELSE 0436.000
CALL PRINTL(DBGFD, 'Receive completed.') 0437.000
ENDIF 0438.000
ENDIF 0439.000
ELSE IF (PTYP .EQ. M) THEN 0439.100
CALL SNDPACK(Y, NUM, 0, 0) 0439.200
CALL STTY(IFD, 'NOWAIT', OFF) 0439.300
CALL STTY(IFD, 'TIMEOUT', 0) 0439.400
CALL STTY(IFD, 'BINARY', OFF) 0439.500
ELSE IF (PTYP .EQ. R) THEN 0440.000
C IF (DEBUG(DBGON)) THEN 0441.000
C CALL PRINTL(DBGFD, 'SERVER: PACKET TYPE IS R ') 0442.000
C ENDIF 0443.000
I = 0 0444.000
CALL STRCPY(RECPACK, FILESTR) 0445.000
CALL AS2DPC(FILESTR, FILENAME) 0446.000
CALL FILCHK(FCNAME) 0447.000
X WRITE(19,890)FILENAME 0447.100
X890 FORMAT(' 890** ',1X,1A56) 0447.200
C 0448.000
CLT 2.3 5/12/86 CHECK TO SEE IF FILE EXISTS 0449.000
C 0450.000
IF (ISFILE(FINAME)) THEN 0451.000
IF (DEBUG(DBGON)) THEN 0452.000
CALL PRINTL(DBGFD, 'SERVER: FILE FOUND ') 0453.000
ENDIF 0454.000
CALL DPC2AS(FILENAME, FILESTR, MAX(1,LASTCHR(FILENAME))) 0455.000
X WRITE(19,900) 0455.100
X900 FORMAT(' SERVER : FILE FOUND ') 0455.200
SNDSTAT = SEND() 0456.000
PACKNUM = 0 0457.000
IF (DEBUG(DBGON)) THEN 0458.000
IF (SNDSTAT .EQ. ERROR) THEN 0459.000
CALL PRINTL(DBGFD, 'Send failed.') 0460.000
ELSE 0461.000
CALL PRINTL(DBGFD, 'Send completed.') 0462.000
ENDIF 0463.000
ENDIF 0464.000
CLT 2.3 5/12/86 SEND ERROR PACKET IF NOT FOUND 0465.000
ELSE 0466.000
CALL DPC2AS('? FILE ', PACKET, 7) 0467.000
I = LASTCHR(FILENAME) 0468.000
CALL DPC2AS(FILENAME, PACKET(8), I) 0469.000
CALL DPC2AS(' NOT FOUND', PACKET(I+8), 10) 0470.000
CALL SNDPACK(E, PACKNUM, SLEN(PACKET), PACKET) 0471.000
ENDIF 0472.000
ELSE IF (PTYP .EQ. G) THEN 0473.000
IF (RECPACK(1) .EQ. L) THEN 0474.000
CALL SNDPACK(Y, NUM, 0, 0) 0475.000
CALL STTY(IFD, 'NOWAIT', OFF) 0476.000
CALL STTY(IFD, 'TIMEOUT', 0) 0477.000
CALL STTY(IFD, 'BINARY', OFF) 0478.000
CCCCCCC CALL EXITPGM !LOGOUT WH JAN 90 0479.000
RETURN 0479.100
ELSE IF (RECPACK(1) .EQ. F) THEN 0480.000
CALL SNDPACK(Y, NUM, 0, 0) 0481.000
CALL STTY(IFD, 'NOWAIT', OFF) 0482.000
CALL STTY(IFD, 'TIMEOUT', 0) 0483.000
CALL STTY(IFD, 'BINARY', OFF) 0484.000
CCCCCCC CALL EXITPGM ! WH JAN 90 0485.000
RETURN 0485.100
C 0486.000
CLT 2.3 5/12/86 SEND ERROR MESSAGE FOR UNSUPPORTED COMMAND 0487.000
C 0488.000
ELSE 0489.000
CALL DPC2AS('? UNSUPPORTED SERVER COMMAND', PACKET, 28) 0490.000
CALL SNDPACK(E, PACKNUM, SLEN(PACKET), PACKET) 0491.000
ENDIF 0492.000
C 0493.000
CLT 2.3 5/8/86 RECEIVE SERVER INIT PACKET 0494.000
C 0495.000
ELSE IF (PTYP .EQ. ITYP) THEN 0496.000
PACKNUM = NUM 0497.000
CALL RDPARAM(RECPACK) 0498.000
I = SNDPAR(PACKET) 0499.000
CALL SNDPACK(Y, PACKNUM, I, PACKET) 0500.000
C 0501.000
CLT END 0502.000
C 0503.000
ELSE 0504.000
CLT 2.3 5/12/86 Added error message for unrecognized packet 0505.000
CALL DPC2AS('? UNRECOGNIZED SERVER PACKET',PACKET,28) 0506.000
CALL SNDPACK(E,PACKNUM, SLEN(PACKET), PACKET) 0507.000
IF (DEBUG(DBGON)) THEN 0508.000
CALL PRINTL(DBGFD, 'server: invalid packet type: ') 0509.000
CALL PUTINT(DBGFD, PTYP, 1) 0510.000
CALL FLUSH(DBGFD) 0511.000
ENDIF 0512.000
CALL SNDPACK(Y, NUM, 0, 0) 0512.100
CALL STTY(IFD, 'NOWAIT', OFF) 0512.200
CALL STTY(IFD, 'TIMEOUT', 0) 0512.300
CALL STTY(IFD, 'BINARY', OFF) 0512.400
CCCCCCC CALL EXITPGM ! WH JAN 90 0512.500
USCMD = USCMD + 1 0512.510
IF (USCMD.LT.3)GO TO 10 0512.520
RETURN 0512.600
C 0512.700
ENDIF 0513.000
GOTO 10 0514.000
END 0515.000
SUBROUTINE SET 0516.000
IMPLICIT NONE 0517.000
C 0518.000
C= Set some attributes. 0519.000
C 0520.000
INCLUDE K.KERMV 0521.000
INCLUDE K.KERMD 0522.000
INCLUDE K.PROTC 0523.000
INCLUDE K.PACKC 0524.000
C 0525.000
INTEGER TSIZE !set commands 0526.000
PARAMETER (TSIZE = 10) 0527.000
CHARACTER*10 SETTYP(TSIZE) 0528.000
$ /'DEBUG','DELAY','ECHO', 'ESCAPE', 0529.000
$ 'INIT-RETRY','LOG','PORT','RECEIVE','RETRY','SEND'/ 0530.000
INTEGER NNOLOCAL ;PARAMETER (NNOLOCAL = 3 ) 0531.000
CHARACTER*63 NOLOCAL (NNOLOCAL) 0532.000
$/'This KERMIT does not support the following SET commands;', 0533.000
$ 'PORT and LOG. These commands require KERMIT to be installed', 0534.000
$ 'on MPX3.2B or greater.'/ 0535.000
INTEGER INDX 0536.000
INTEGER ESIZE ;PARAMETER (ESIZE = 2) 0537.000
CHARACTER*3 ECHOTYP(ESIZE) /'OFF','ON'/ 0538.000
CHARACTER*63 HLPASCH/ 0539.000
$'Decimal, octal (O), or hexidecimal (H) code for ASCII character' 0540.000
$/ 0541.000
C 0542.000
INTEGER MATCH 0543.000
C 0544.000
INDX = MATCH (SETTYP, TSIZE, .FALSE.) 0545.000
IF (INDX .LE. 0) RETURN 0546.000
GOTO (10, 20, 23, 27, 30, 80, 70, 40, 50, 60) INDX 0547.000
C 0548.000
C set debugging modes 0549.000
C 0550.000
10 CONTINUE !debug 0551.000
CALL DBUGCMD 0552.000
RETURN 0553.000
C 0554.000
20 CONTINUE !set first packet delay 0555.000
CALL SETVAL(DELAYFP,'I',0,60,0,60, 0556.000
$ 'Number of seconds to delay first packet', .TRUE.) 0557.000
RETURN 0558.000
C 0559.000
23 CONTINUE !set echo on/off 0560.000
INDX = MATCH(ECHOTYP, ESIZE, .TRUE.) 0561.000
IF (INDX .LE. 0) RETURN 0562.000
ECHO = INDX .EQ. 2 0563.000
RETURN 0564.000
C 0565.000
27 CONTINUE !escape 0566.000
CALL SETVAL(ESCCHR, 'I', 0, 31, 0, 31, HLPASCH, .TRUE.) 0567.000
RETURN 0568.000
C 0569.000
30 CONTINUE ! set initial packet retry count 0570.000
CALL SETVAL(MAXRINI,'I',1,50,1,50, 0571.000
$ 'Initial packet retry count', .TRUE.) 0572.000
RETURN 0573.000
C 0574.000
40 CONTINUE !set receive packet attributes 0575.000
CALL SETPACK(PACKSIZ) 0576.000
RETURN 0577.000
C 0578.000
50 CONTINUE !set packet retry count 0579.000
CALL SETVAL(MAXRTRY, 'I',1,50,1,50, 0580.000
$ 'Packet retry count', .TRUE.) 0581.000
RETURN 0582.000
C 0583.000
60 CONTINUE !set send packet attributes 0584.000
CALL SETPACK(SPKSIZ) 0585.000
RETURN 0586.000
C 0587.000
70 CONTINUE !set port 0588.000
IF (.NOT. LOCALON) GOTO 90 0589.000
CALL PORTCMD 0590.000
RETURN 0591.000
C 0592.000
80 CONTINUE !set log 0593.000
IF (.NOT. LOCALON) GOTO 90 0594.000
CALL LOGGER 0595.000
RETURN 0596.000
C 0597.000
90 CONTINUE !no local 0598.000
CALL OUTTBL(NOLOCAL, 1, NNOLOCAL) 0599.000
RETURN 0600.000
END 0601.000
SUBROUTINE SHOW 0602.000
IMPLICIT NONE 0603.000
C 0604.000
C= Show the current program settings 0605.000
C 0606.000
INCLUDE K.KERMV 0607.000
INCLUDE K.KERMD 0608.000
INCLUDE K.PROTC 0609.000
INCLUDE K.PACKC 0610.000
INCLUDE K.DBUGC 0611.000
INCLUDE K.MSGCOM 0612.000
C 0613.000
INTEGER MM,DD,YY,HR,MIN,SEC 0614.000
C 0615.000
INTEGER CTL 0616.000
LOGICAL CONFIRM 0617.000
C 0618.000
IF (.NOT. CONFIRM(INPUTFD)) RETURN 0619.000
CALL PRINTL(STDOUT, VERSION) 0620.000
C 0621.000
C display current date and time 0622.000
C 0623.000
CALL GETNOW(MM, DD, YY, HR, MIN, SEC) 0624.000
CALL PUTC(STDOUT, NEL) 0625.000
CALL PUTDAY(STDOUT, MM, DD, YY) 0626.000
CALL PRINT(STDOUT,', ') 0627.000
CALL PUTMNTH(STDOUT,MM) 0628.000
CALL PUTC(STDOUT,ICHAR(' ')) 0629.000
CALL PUTINT(STDOUT,DD, 1) 0630.000
CALL PRINT(STDOUT,', ') 0631.000
CALL PUTINT(STDOUT,YY, 1) 0632.000
CALL PUTC(STDOUT,ICHAR(' ')) 0633.000
IF (HR .LT. 10) CALL PRINT(STDOUT,'0') 0634.000
CALL PUTINT(STDOUT,HR,1) 0635.000
CALL PUTC(STDOUT,ICHAR(':')) 0636.000
IF (MIN .LT. 10) CALL PRINT(STDOUT,'0') 0637.000
CALL PUTINT(STDOUT,MIN,1) 0638.000
CALL PUTC(STDOUT,ICHAR(':')) 0639.000
IF (SEC .LT. 10) CALL PRINT(STDOUT,'0') 0640.000
CALL PUTINT(STDOUT,SEC,1) 0641.000
C 0642.000
C display current debug modes 0643.000
C 0644.000
CALL PRINTL(STDOUT,'Debugging: ') 0645.000
IF (DEBUG(DBGSTAT)) CALL PRINT(STDOUT,'States ') 0646.000
IF (DEBUG(DBGPACK)) CALL PRINT(STDOUT,'Packets ') 0647.000
IF (.NOT. DEBUG(DBGON)) CALL PRINT(STDOUT,'Off ') 0648.000
IF (DEBUG(DBGON)) THEN 0649.000
CALL PRINT(STDOUT,' Debug log file: '//DBGFILE) 0650.000
ENDIF 0651.000
C 0652.000
C session log 0653.000
C 0654.000
IF (LOCALON) THEN 0655.000
CALL PRINTL(STDOUT, 'Session log: ') 0656.000
IF (LOG) THEN 0657.000
CALL PRINT(STDOUT, 'ON') 0658.000
ELSE 0659.000
CALL PRINT(STDOUT, 'OFF') 0660.000
ENDIF 0661.000
IF (LOGFILE .NE. ' ') THEN 0662.000
CALL PRINT( STDOUT, ' Session log file: ') 0663.000
CALL PRINT(STDOUT, LOGFILE) 0664.000
ENDIF 0665.000
ENDIF 0666.000
C 0667.000
C display current port 0668.000
C 0669.000
IF (LOCALON) THEN 0670.000
CALL PRINTL(STDOUT, 'Selected Communications port: ') 0671.000
CALL PRINT (STDOUT, COMPORT) 0672.000
CALL PRINTL(STDOUT, 'Connection escape character: ^') 0673.000
CALL PUTC(STDOUT, CTL(ESCCHR)) 0674.000
CALL PRINTL(STDOUT, 'Local echo: ') 0675.000
IF (ECHO) THEN 0676.000
CALL PRINT(STDOUT, 'ON') 0677.000
ELSE 0678.000
CALL PRINT(STDOUT, 'OFF') 0679.000
ENDIF 0680.000
ENDIF 0681.000
C 0682.000
C display packet settings 0683.000
C 0684.000
CALL PRINTL(STDOUT,'Packet Parameters') 0685.000
CALL PRINTL(STDOUT, 0686.000
$ ' Receive Send') 0687.000
CALL PRINTL(STDOUT,' Size: ') 0688.000
CALL PUTINT(STDOUT,PACKSIZ,10) 0689.000
CALL PUTINT(STDOUT,SPKSIZ,10) 0690.000
CALL PRINTL(STDOUT,' Timeout: ') 0691.000
CALL PUTINT(STDOUT,TIMEOUT,10) 0692.000
CALL PUTINT(STDOUT,STIMOUT,10) 0693.000
CALL PRINTL(STDOUT,' Padding: ') 0694.000
CALL PUTINT(STDOUT,NPAD,10) 0695.000
CALL PUTINT(STDOUT,SPAD,10) 0696.000
CALL PRINTL(STDOUT,' Pad character: ') 0697.000
CALL PUTC(STDOUT,ICHAR('^')) 0698.000
CALL PUTC(STDOUT,CTL(PADCH)) 0699.000
CALL PRINT(STDOUT,' ') 0700.000
CALL PUTC(STDOUT,ICHAR('^')) 0701.000
CALL PUTC(STDOUT,CTL(SPADCH)) 0702.000
CALL PRINTL(STDOUT,' End-of-Line: ') 0703.000
CALL PUTC(STDOUT,ICHAR('^')) 0704.000
CALL PUTC(STDOUT,CTL(EOLCH)) 0705.000
CALL PRINT(STDOUT,' ') 0706.000
CALL PUTC(STDOUT,ICHAR('^')) 0707.000
CALL PUTC(STDOUT,CTL(SPEOL)) 0708.000
CALL PRINTL(STDOUT,' Control quote: ') 0709.000
CALL PUTC(STDOUT,QUOTECH) 0710.000
CALL PRINT(STDOUT,' ') 0711.000
CALL PUTC(STDOUT,SPQUOTE) 0712.000
CALL PRINTL(STDOUT,' Start-of-Packet: ') 0713.000
CALL PUTC(STDOUT,ICHAR('^')) 0714.000
CALL PUTC(STDOUT,CTL(SYNC)) 0715.000
CALL PRINT(STDOUT,' ') 0716.000
CALL PUTC(STDOUT,ICHAR('^')) 0717.000
CALL PUTC(STDOUT,CTL(SNDSYNC)) 0718.000
C 0719.000
C display protocol stuff 0720.000
C 0721.000
CALL PRINTL(STDOUT,'Delay before sending first packet: ') 0722.000
CALL PUTINT(STDOUT,DELAYFP,1) 0723.000
CALL PRINTL(STDOUT,'Init packet retry count: ') 0724.000
CALL PUTINT(STDOUT,MAXRINI,1) 0725.000
CALL PRINTL(STDOUT,'Packet retry count: ') 0726.000
CALL PUTINT(STDOUT,MAXRTRY,1) 0727.000
CALL PUTC(STDOUT,NEL) 0728.000
RETURN 0729.000
END 0730.000
SUBROUTINE STATUS 0731.000
IMPLICIT NONE 0732.000
C 0733.000
C= Tell how long last transfer took. 0734.000
C 0735.000
INCLUDE K.KERMV 0736.000
INCLUDE K.KERMD 0737.000
INCLUDE K.PROTC 0738.000
INCLUDE K.PACKC 0739.000
INCLUDE K.TIMEC 0740.000
C 0741.000
INTEGER HR,MIN,SEC 0742.000
INTEGER NSEC 0743.000
C 0744.000
LOGICAL CONFIRM 0745.000
C 0746.000
C confirm the command 0747.000
C 0748.000
IF (.NOT. CONFIRM(INPUTFD)) RETURN 0749.000
C 0750.000
CALL PRINTL(STDOUT,'Max characters in packet: ') 0751.000
CALL PUTINT(STDOUT, PACKSIZ, 1) 0752.000
CALL PRINT(STDOUT,' received; ') 0753.000
CALL PUTINT(STDOUT, SPKSIZ, 1) 0754.000
CALL PRINT(STDOUT,' sent') 0755.000
CALL PUTC(STDOUT,NEL) 0756.000
IF (ENDTIM .LT. STARTIM) ENDTIM = ENDTIM + 86400 0757.000
NSEC = ENDTIM - STARTIM 0758.000
HR = NSEC / 3600 0759.000
NSEC = NSEC - (HR * 3600) 0760.000
MIN = NSEC / 60 0761.000
NSEC = NSEC - (MIN * 60) 0762.000
CALL PRINTL(STDOUT,'Number of characters transmitted in ') 0763.000
IF (HR .GT. 0) THEN 0764.000
CALL PUTINT(STDOUT,HR,1) 0765.000
CALL PRINT(STDOUT,' hours ') 0766.000
ENDIF 0767.000
IF (MIN .GT. 0 .OR. HR .GT. 0) THEN 0768.000
CALL PUTINT(STDOUT,MIN,1) 0769.000
CALL PRINT(STDOUT,' minutes ') 0770.000
ENDIF 0771.000
CALL PUTINT(STDOUT,NSEC,1) 0772.000
CALL PRINT(STDOUT,' seconds') 0773.000
CALL PRINTL(STDOUT,' Sent: ') 0774.000
CALL PUTINT(STDOUT, SCHCNT, 20) 0775.000
CALL PRINT(STDOUT,' Overhead: ') 0776.000
CALL PUTINT(STDOUT, SCHOVRH, 1) 0777.000
CALL PRINTL(STDOUT,' Received: ') 0778.000
CALL PUTINT(STDOUT, RCHCNT, 20) 0779.000
CALL PRINT(STDOUT,' Overhead: ') 0780.000
CALL PUTINT(STDOUT, RCHOVRH, 1) 0781.000
CALL PRINTL(STDOUT,'Total Transmitted: ') 0782.000
CALL PUTINT(STDOUT, RCHCNT+SCHCNT, 20) 0783.000
CALL PRINT(STDOUT,' Overhead: ') 0784.000
CALL PUTINT(STDOUT, RCHOVRH+SCHOVRH, 1) 0785.000
CALL PUTC(STDOUT, NEL) 0786.000
CALL PRINTL(STDOUT,'Total characters transmitted per sec: ') 0787.000
CALL PUTINT(STDOUT,(SCHCNT+RCHCNT)/(ENDTIM-STARTIM),1) 0788.000
CALL PRINTL(STDOUT,'Effective data rate: ') 0789.000
CALL PUTINT(STDOUT,((SCHCNT+RCHCNT)-(SCHOVRH+RCHOVRH)) / 0790.000
$ (ENDTIM-STARTIM) * 10, 1) 0791.000
CALL PRINT(STDOUT,' baud') 0792.000
CALL FLUSH(STDOUT) 0793.000
IF (STATE .NE. C) THEN 0794.000
CALL GETEMSG(PACKET) 0795.000
CALL PRINTL(STDOUT,'?Kermit: ') 0796.000
CALL PUTSTR(STDOUT, PACKET) 0797.000
CALL FLUSH(STDOUT) 0798.000
ENDIF 0799.000
C 0800.000
C timing 0801.000
C 0802.000
IF (LOCALON) THEN 0803.000
CALL PRINTL(STDOUT, 'Connect timing averages: ') 0804.000
CALL PRINT(STDOUT, 'GETC ') 0805.000
CALL PUTINT(STDOUT, GETIME/GETCOUNT, 5) 0806.000
CALL PRINT(STDOUT, ' PUTC ') 0807.000
CALL PUTINT(STDOUT, PUTIME/PUTCOUNT, 5) 0808.000
CALL PRINT(STDOUT, ' WAIT ') 0809.000
CALL PUTINT(STDOUT, WAITIME/WAITCNT, 5) 0810.000
CALL PRINT(STDOUT, ' TOTAL ') 0811.000
CALL PUTINT(STDOUT, TOTIME, 5) 0812.000
ENDIF 0813.000
RETURN 0814.000
END 0815.000
SUBROUTINE DBUGCMD 0816.000
IMPLICIT NONE 0817.000
C 0818.000
C= Set the debugging modes. 0819.000
C 0820.000
INCLUDE K.KERMD 0821.000
INCLUDE K.PROTC 0822.000
INCLUDE K.DBUGC 0823.000
C 0824.000
INTEGER DEBUGFN(17) !file name 0825.000
INTEGER TSIZE ;PARAMETER (TSIZE = 5) 0826.000
CHARACTER*10 DBGTYP(TSIZE) 0827.000
$ /'ALL','LOG-FILE','OFF','PACKETS','STATES'/ 0828.000
INTEGER INDX 0829.000
INTEGER IRET 0830.000
C 0831.000
INTEGER MATCH 0832.000
LOGICAL CONFIRM 0833.000
INTEGER OPEN 0834.000
C 0835.000
INDX = MATCH(DBGTYP, TSIZE, .FALSE.) 0836.000
IF (INDX .LE. 0) RETURN 0837.000
GOTO (10, 20, 30, 40 ) INDX 0838.000
C 0839.000
10 CONTINUE !set all debug modes 0840.000
DEBUG = .TRUE. 0841.000
GOTO 100 0842.000
C 0843.000
20 CONTINUE !set logfile 0844.000
CALL SETVAL(DEBUGFN, 'S', IRET, 16, 0, 0, 0845.000
$ 'Debug output logfile specification', .TRUE.) 0846.000
IF (IRET .EQ. OK) THEN 0847.000
CALL AS2DPC(DEBUGFN, DBGFILE) 0848.000
IF (DBGFD .NE. 0) THEN 0849.000
CALL CLOSE(DBGFD) 0850.000
DBGFD = 0 0851.000
ENDIF 0852.000
GOTO 100 0853.000
ENDIF 0854.000
RETURN 0855.000
C 0856.000
30 CONTINUE !turn off all debugging 0857.000
DEBUG = .FALSE. 0858.000
RETURN 0859.000
C 0860.000
40 CONTINUE !toggle debug packets 0861.000
IF (.NOT. CONFIRM(INPUTFD))RETURN 0862.000
DEBUG(DBGPACK) = .NOT. DEBUG(DBGPACK) 0863.000
DEBUG(DBGON) = DEBUG(DBGPACK) .OR. DEBUG(DBGSTAT) 0864.000
DEBUG(DBGSTAT) = .NOT. DEBUG(DBGSTAT) 0865.000
DEBUG(DBGON) = DEBUG(DBGPACK) .OR. DEBUG(DBGSTAT) 0866.000
GOTO 100 0867.000
C 0868.000
100 CONTINUE !open the debug file in not done 0869.000
IF (DBGFD .EQ. 0) THEN 0870.000
DBGFD = OPEN(DBGFILE, 'W') 0871.000
ENDIF 0872.000
RETURN 0873.000
END 0874.000
SUBROUTINE SETPACK(ATTR) 0875.000
IMPLICIT NONE 0876.000
INTEGER ATTR(12) !attributes 0877.000
C 0878.000
C= Set packet send or receive attributes. 0879.000
C 0880.000
C Setpack will wet the attributes of the passed attribute list. 0881.000
C This subroutine will set the appropriate packet parameter. 0882.000
C The parameter to set is passed in an array and is very order 0883.000
C dependent. See common block /packet/ for the ordering. 0884.000
C Note that send and receive parameter ordering and storage 0885.000
C size in the common block are identical. Keep it that way! 0886.000
C 0887.000
INCLUDE K.KERMD 0888.000
C 0889.000
INTEGER TSIZE ;PARAMETER (TSIZE=7) 0890.000
CHARACTER*10 ATTRTYP(TSIZE) !commands 0891.000
$ /'EOL','PACKLEN','PADCHR','PADLEN','QUOTECHR', 0892.000
$ 'SYNCCHR','TIMEOUT'/ 0893.000
INTEGER INDX 0894.000
CHARACTER*63 HLPASCH/ 0895.000
$'Decimal, octal (O), or hexidecimal (H) code for ASCII character' 0896.000
$/ 0897.000
C 0898.000
INTEGER MATCH 0899.000
LOGICAL CONFIRM 0900.000
C 0901.000
INDX = MATCH(ATTRTYP, TSIZE, .FALSE.) 0902.000
IF (INDX .LE. 0) RETURN 0903.000
GOTO (10, 20, 30, 40, 50, 60, 70) INDX 0904.000
C 0905.000
10 CONTINUE !set eol character 0906.000
CALL SETVAL(ATTR(5), 'I',1,31,127,127,HLPASCH,.TRUE.) 0907.000
RETURN 0908.000
C 0909.000
20 CONTINUE !set maximum packet length 0910.000
CALL SETVAL(ATTR(1), 'I',20,1000,20,1000, 0911.000
$ 'Maximum packet length', .TRUE.) 0912.000
RETURN 0913.000
C 0914.000
30 CONTINUE !set pad character 0915.000
CALL SETVAL(ATTR(4), 'I', 0, 31, 127, 127, HLPASCH, .TRUE.) 0916.000
RETURN 0917.000
C 0918.000
40 CONTINUE !set pad length 0919.000
CALL SETVAL(ATTR(3), 'I', 0, 1000, 0, 1000, 0920.000
$ 'Number of pad characters to use', .TRUE.) 0921.000
RETURN 0922.000
C 0923.000
50 CONTINUE !set quote character 0924.000
CALL SETVAL(ATTR(6), 'I',33, 62, 97, 126, HLPASCH, .TRUE.) 0925.000
RETURN 0926.000
C 0927.000
60 CONTINUE !set sync character 0928.000
CALL SETVAL(ATTR(12),'I', 0,127, 0, 127, HLPASCH, .TRUE.) 0929.000
RETURN 0930.000
C 0931.000
70 CONTINUE !set timeout value 0932.000
CALL SETVAL(ATTR(2), 'I', 0, 1000, 0, 1000, 0933.000
$ 'Number of seconds to wait before timeout', .TRUE.) 0934.000
RETURN 0935.000
END 0936.000
SUBROUTINE PORTCMD 0937.000
IMPLICIT NONE 0938.000
C 0939.000
C= Selects the port to be used. 0940.000
C 0941.000
INCLUDE K.KERMD 0942.000
INCLUDE K.PROTC 0943.000
C 0944.000
INTEGER PORTSTR(7) !port string to read 0945.000
CHARACTER*6 PORTNM !char device name 0946.000
CHARACTER*6 PORTWR !write port 0947.000
INTEGER IRET !error code 0948.000
INTEGER INEW !new input 0949.000
INTEGER ONEW !new output 0950.000
C 0951.000
INTEGER OPEN !open port 0952.000
INTEGER XTOI !hex ascii to integer 0953.000
CHARACTER*4 ITOX !integer to hex ascii 0954.000
C 0955.000
CALL SETVAL(PORTSTR, 'S', IRET, 6, 0, 0, 0956.000
$ 'Select communication port', .TRUE.) 0957.000
IF (IRET .EQ. OK) THEN 0958.000
CALL AS2DPC(PORTSTR, PORTNM) 0959.000
C 0960.000
IF (PORTNM .EQ. COMPORT) THEN !ignore no change 0961.000
ELSE 0962.000
C 0963.000
C now open 0964.000
C 0965.000
IF (PORTNM .EQ. 'UT') THEN 0966.000
IF (IFD .NE. STDIN) CALL CLOSE(IFD) 0967.000
IF (OFD .NE. STDOUT) CALL CLOSE(OFD) 0968.000
IFD = STDIN 0969.000
OFD = STDOUT 0970.000
COMPORT = PORTNM 0971.000
ELSE 0972.000
INEW = OPEN('@'//PORTNM,'R') 0973.000
IF (INEW .LE. 0) THEN 0974.000
CALL PRINTL(STDOUT, 'Failed to open read channel, code= ')0975.000
CALL PUTINT(STDOUT, -INEW, 3) 0976.000
RETURN 0977.000
ENDIF 0978.000
PORTWR = PORTNM(1:2) 0979.000
PORTWR(3:6) = ITOX(XTOI(PORTNM(3:6))+8) 0980.000
ONEW = OPEN('@'//PORTWR,'W') 0981.000
IF (ONEW .LE. 0) THEN 0982.000
CALL CLOSE(INEW) 0983.000
CALL PRINTL(STDOUT,'Failed to open write channel,code= ') 0984.000
CALL PUTINT(STDOUT, -ONEW, 3) 0985.000
RETURN 0986.000
ENDIF 0987.000
IF (IFD .NE. STDIN) CALL CLOSE(IFD) 0988.000
IF (OFD .NE. STDOUT) CALL CLOSE(OFD) 0989.000
COMPORT = PORTNM 0990.000
IFD = INEW 0991.000
OFD = ONEW 0992.000
ENDIF 0993.000
ENDIF 0994.000
ENDIF 0995.000
RETURN 0996.000
END 0997.000
SUBROUTINE CONNECT 0998.000
IMPLICIT NONE 0999.000
C 1000.000
C= Connects stdin/stdout to in/out port 1001.000
C 1002.000
INCLUDE K.KERMD 1003.000
INCLUDE K.PROTC 1004.000
INCLUDE K.TIMEC 1005.000
C 1006.000
INTEGER BELL ;PARAMETER (BELL = X'07') 1007.000
INTEGER ZERO ;PARAMETER (ZERO = X'30') 1008.000
INTEGER BREAK ;PARAMETER (BREAK = X'42') 1009.000
INTEGER CLOSE ;PARAMETER (CLOSE = X'43') 1010.000
INTEGER QUIT ;PARAMETER (QUIT = X'51') 1011.000
INTEGER RESUME ;PARAMETER (RESUME=X'52') 1012.000
INTEGER LOWA ;PARAMETER (LOWA = X'61') 1013.000
INTEGER LOWZ ;PARAMETER (LOWZ = X'7A') 1014.000
INTEGER LOW2UP ;PARAMETER (LOW2UP = X'20') 1015.000
INTEGER INCHR !char from stdin 1016.000
INTEGER TTCHR !char from port 1017.000
CHARACTER*10 CNUM !character 1018.000
CHARACTER*10 CNUM2 1019.000
INTEGER STIME 1020.000
INTEGER FTIME 1021.000
CLT LOGICAL PAUSER !XXX 1022.000
CLT LOGICAL DUMPER !XXX 1023.000
C 1024.000
INTEGER GETC !get character 1025.000
LOGICAL CONFIRM !confirm connect 1026.000
INTEGER CTL !convert ctl to non-control 1027.000
CHARACTER*(*)ITOA 1028.000
CLT LOGICAL OPTION !XXX 1029.000
C 1030.000
IF (.NOT. CONFIRM(INPUTFD)) RETURN 1031.000
CLT PAUSER = OPTION (1) !XXX 1032.000
CLT DUMPER = OPTION (2) !XXX 1033.000
C 1034.000
IF (IFD .EQ. STDIN .OR. OFD .EQ. STDOUT) THEN 1035.000
CALL PRINTL(STDOUT, '?No external port selected.') 1036.000
RETURN 1037.000
ENDIF 1038.000
C 1039.000
CALL PUTC(STDOUT, NEL) 1040.000
CALL PRINT(STDOUT, '[Connecting to port, type ^') 1041.000
CALL PUTC(STDOUT, CTL(ESCCHR)) 1042.000
CALL PRINT(STDOUT, ' C to return to local]') 1043.000
CALL PUTC(STDOUT, NEL) 1044.000
CALL PUTC(STDOUT, NEL) 1045.000
C 1046.000
CALL STTY(STDIN, 'BINARY', ON) 1047.000
CALL STTY(STDIN, 'SIZE', 1) 1048.000
CALL STTY(STDOUT, 'SIZE', 1) 1049.000
CALL STTY(STDIN, 'NOWAIT', ON) 1050.000
CALL STTY(STDOUT, 'NOWAIT', ON) 1051.000
CALL STTY(IFD, 'BINARY', ON) 1052.000
CALL STTY(IFD, 'SIZE', 1) 1053.000
CALL STTY(OFD, 'SIZE', 1) 1054.000
CALL STTY(IFD, 'NOWAIT', ON) 1055.000
CALL STTY(OFD, 'NOWAIT', ON) 1056.000
GETIME = PUTIME = 0 1057.000
GETCOUNT = PUTCOUNT = 0 1058.000
WAITIME = WAITCNT = 0 1059.000
CALL MSEC(TOTIME) 1060.000
C 1061.000
DO BEGIN 1062.000
CLT IF (DUMPER) CALL DUMPF('BEGIN') !XXX 1063.000
CLT IF (PAUSER) PAUSE BEGIN !XXX 1064.000
CALL MSEC(STIME) 1065.000
INCHR = GETC(STDIN, INCHR) 1066.000
CALL MSEC(FTIME) 1067.000
CLT IF (DUMPER) CALL DUMPF('AFTER STDIN') !XXX 1068.000
GETCOUNT = GETCOUNT + 1 1069.000
GETIME = FTIME - STIME + GETIME 1070.000
CALL MSEC(STIME) 1071.000
TTCHR = GETC(IFD, TTCHR) 1072.000
CALL MSEC(FTIME) 1073.000
GETCOUNT = GETCOUNT + 1 1074.000
GETIME = FTIME - STIME + GETIME 1075.000
C 1076.000
CLT IF (INCHR .NE. ERROR .OR. TTCHR .NE. ERROR) THEN 1077.000
CLT CNUM = ITOA(INCHR) 1078.000
CLT CNUM2 = ITOA(TTCHR) 1079.000
CLT CALL DISPLAY('KERMIT/CONNECT - PARSE CHARACTER'//CNUM//CNUM2) 1080.000
CLT ENDIF 1081.000
IF (INCHR .EQ. EOF) THEN 1082.000
CLT CALL DISPLAY('KERMIT/CONNECT - EOF') 1083.000
LEAVE 1084.000
ELSE IF (INCHR .EQ. ERROR) THEN 1085.000
CONTINUE 1086.000
ELSE IF (INCHR .EQ. ESCCHR) THEN 1087.000
10 CONTINUE 1088.000
CLT CALL DISPLAY('KERMIT/CONNECT - WAIT FOR NON-ERROR') 1089.000
DO WHILE (GETC(STDIN, INCHR) .EQ. ERROR) 1090.000
CALL IOWAIT(50 ) 1091.000
ENDDO 1092.000
IF (INCHR .GE. LOWA .AND. INCHR .LE. LOWZ) 1093.000
$ INCHR = INCHR - LOW2UP 1094.000
CNUM = ITOA(INCHR) 1095.000
CLT CALL DISPLAY('KERMIT/CONNECT - NON-ERROR ='//CNUM) 1096.000
IF (INCHR .EQ. CLOSE) THEN 1097.000
LEAVE 1098.000
ELSE IF (INCHR .EQ. BREAK) THEN 1099.000
CALL SENDBRK(OFD) 1100.000
ELSE IF (INCHR .EQ. ZERO) THEN 1101.000
CALL PUTC(OFD, 0) 1102.000
ELSE IF (INCHR .EQ. QUIT) THEN 1103.000
LOG = .FALSE. 1104.000
ELSE IF (INCHR .EQ. RESUME) THEN 1105.000
IF (FFD .NE. 0) LOG = .TRUE. 1106.000
ELSE IF (INCHR .EQ. ESCCHR) THEN 1107.000
CALL PUTC(OFD, ESCCHR) 1108.000
ELSE IF (INCHR .EQ. QMARK) THEN 1109.000
CALL STTY(STDOUT, 'SIZE', -1) 1110.000
CALL STTY(STDOUT, 'NOWAIT', OFF) 1111.000
CALL PRINTL(STDOUT,'0 Send NULL') 1112.000
CALL PRINTL(STDOUT,'B Send BREAK') 1113.000
CALL PRINTL(STDOUT,'C Close connection') 1114.000
CALL PRINTL(STDOUT,'Q Quit logging') 1115.000
CALL PRINTL(STDOUT,'R Resume logging') 1116.000
CALL PUTC(STDOUT, NEL) 1117.000
CALL PRINT(STDOUT, '^') 1118.000
CALL PUTC(STDOUT, CTL(ESCCHR)) 1119.000
CALL PRINT(STDOUT,' Send this character') 1120.000
CALL PRINTL(STDOUT,'? This message') 1121.000
CALL PRINTL(STDOUT,'Command>') 1122.000
CALL STTY(STDOUT, 'NOWAIT', ON) 1123.000
CALL STTY(STDOUT, 'SIZE', 1) 1124.000
GOTO 10 1125.000
ELSE 1126.000
CALL PUTC(STDOUT, BELL) 1127.000
ENDIF 1128.000
ELSE 1129.000
CLT CALL DISPLAY('KERMIT/CONNECT - PUTC OFD') 1130.000
CALL MSEC(STIME) 1131.000
CALL PUTC(OFD, INCHR) 1132.000
CALL MSEC(FTIME) 1133.000
PUTCOUNT = PUTCOUNT + 1 1134.000
PUTIME = PUTIME + FTIME - STIME 1135.000
IF (ECHO) CALL PUTC(STDOUT, INCHR) 1136.000
ENDIF 1137.000
C 1138.000
IF (TTCHR .EQ. EOF) THEN 1139.000
CALL PRINTL(STDOUT, '?EOF on port connection') 1140.000
LEAVE 1141.000
ELSE IF (TTCHR .EQ. ERROR) THEN 1142.000
CONTINUE 1143.000
ELSE 1144.000
CLT CALL DISPLAY('KERMIT/CONNECT - PUTC STDOUT') 1145.000
CALL MSEC(STIME) 1146.000
CALL PUTC(STDOUT, TTCHR) 1147.000
CALL MSEC(FTIME) 1148.000
PUTIME = PUTIME + FTIME - STIME 1149.000
PUTCOUNT = PUTCOUNT + 1 1150.000
IF (LOG) THEN 1151.000
IF (TTCHR .GE. BLANK .AND. TTCHR .LT. DEL) THEN 1152.000
CALL PUTC(LFD, TTCHR) 1153.000
ELSE IF (TTCHR .EQ. CR) THEN 1154.000
CALL PUTC(LFD, NEL) 1155.000
ENDIF 1156.000
ENDIF 1157.000
ENDIF 1158.000
C 1159.000
CALL MSEC(STIME) 1160.000
IF (TTCHR .EQ. ERROR .AND. INCHR .EQ. ERROR) THEN 1161.000
CALL IOWAIT(50 ) 1162.000
ENDIF 1163.000
CALL MSEC(FTIME) 1164.000
WAITIME = WAITIME + FTIME - STIME 1165.000
WAITCNT = WAITCNT + 1 1166.000
C 1167.000
ENDDO 1168.000
CLT IF (DUMPER) CALL DUMPF('ENDDO') !XXX 1169.000
CLT IF (PAUSER) PAUSE ENDDO !XXX 1170.000
C 1171.000
CALL MSEC(FTIME) 1172.000
TOTIME = FTIME - TOTIME 1173.000
CALL FLUSH(IFD) 1174.000
CALL FLUSH(STDIN) 1175.000
CALL STTY(STDIN, 'BINARY', OFF) 1176.000
CALL STTY(STDIN, 'SIZE', 80) 1177.000
CALL STTY(STDOUT, 'SIZE', -1) 1178.000
CALL STTY(STDIN, 'NOWAIT', OFF) 1179.000
CALL STTY(STDOUT, 'NOWAIT', OFF) 1180.000
CALL STTY(IFD, 'BINARY', OFF) 1181.000
CALL STTY(IFD, 'SIZE', -1) 1182.000
CALL STTY(OFD, 'SIZE', -1) 1183.000
CALL STTY(IFD, 'NOWAIT', OFF) 1184.000
CALL STTY(OFD, 'NOWAIT', OFF) 1185.000
CLT IF (DUMPER) CALL DUMPF('EXIT CONNECT') !XXX 1186.000
C 1187.000
RETURN 1188.000
END 1189.000
SUBROUTINE LOGGER 1190.000
IMPLICIT NONE 1191.000
C 1192.000
C= Performs log command 1193.000
C 1194.000
INCLUDE K.KERMD 1195.000
INCLUDE K.PROTC 1196.000
C 1197.000
INTEGER NCMD ;PARAMETER (NCMD = 3) 1198.000
CHARACTER*8 CMD(NCMD) 1199.000
$ /'LOG-FILE', 'OFF', 'ON'/ 1200.000
INTEGER IRET 1201.000
INTEGER TSTR(17) !temp file string 1202.000
INTEGER INDX 1203.000
C 1204.000
INTEGER MATCH 1205.000
INTEGER OPEN !open file 1206.000
C 1207.000
INDX = MATCH(CMD, NCMD, .FALSE.) 1208.000
IF (INDX .LE. 0) RETURN 1209.000
C 1210.000
GOTO (10, 20, 30) INDX 1211.000
C 1212.000
10 CONTINUE 1213.000
CALL SETVAL(TSTR, 'S', IRET, 16, 0, 0, 1214.000
$ 'Session log filename', .TRUE.) 1215.000
IF (IRET .EQ. OK) THEN 1216.000
CALL AS2DPC(TSTR, LOGFILE) 1217.000
LFD = OPEN(LOGFILE, 'W') 1218.000
IF (LFD .LE. 0) THEN 1219.000
CALL PRINTL(STDOUT, '?Failed to open session log file ') 1220.000
CALL PUTINT(STDOUT, -LFD, 3) 1221.000
LOG = .FALSE. 1222.000
ELSE 1223.000
LOG = .TRUE. 1224.000
ENDIF 1225.000
ENDIF 1226.000
GOTO 100 1227.000
C 1228.000
20 CONTINUE 1229.000
LOG = .FALSE. 1230.000
IF (LFD .GT. 0) CALL CLOSE(LFD) 1231.000
GOTO 100 1232.000
C 1233.000
30 CONTINUE 1234.000
IF (LFD .EQ. 0) THEN 1235.000
LFD = OPEN(LOGFILE, 'W') 1236.000
IF (LFD .EQ. ERROR) 1237.000
$ CALL PRINTL(STDOUT, '?Failed to open session log file') 1238.000
ENDIF 1239.000
LOG = LFD .GT. 0 1240.000
GOTO 100 1241.000
C 1242.000
100 CONTINUE 1243.000
RETURN 1244.000
END 1245.000
SUBROUTINE FINISH 1246.000
IMPLICIT NONE 1247.000
C 1248.000
C= Sends finish command to target port 1249.000
C 1250.000
INCLUDE K.KERMD 1251.000
INCLUDE K.PROTC 1252.000
INCLUDE K.PACKC 1253.000
C 1254.000
INTEGER PTYP, LEN, NUM 1255.000
C 1256.000
LOGICAL CONFIRM 1257.000
INTEGER RDPACK 1258.000
C 1259.000
IF (.NOT. CONFIRM(INPUTFD)) RETURN 1260.000
C 1261.000
IF (IFD .EQ. STDIN ) THEN 1262.000
CALL PRINTL(STDOUT, '?No communication port selected.') 1263.000
RETURN 1264.000
ENDIF 1265.000
C 1266.000
CALL STTY(IFD, 'BINARY', ON) 1267.000
CALL STTY(IFD, 'TIMEOUT', TIMEOUT) 1268.000
CALL STTY(IFD, 'NOWAIT', ON) 1269.000
NUMTRY = 0 1270.000
PACKET(1) = F !f is constant , fort codes as halfw.1271.000
DO WHILE (NUMTRY .LE. MAXTRY) 1272.000
NUMTRY = NUMTRY + 1 1273.000
CALL SNDPACK(G, 0, 1, PACKET) 1274.000
PTYP = RDPACK(LEN, NUM, RECPACK) 1275.000
IF (PTYP .EQ. Y) LEAVE 1276.000
ENDDO 1277.000
CALL STTY(IFD, 'NOWAIT', OFF) 1278.000
CALL STTY(IFD, 'TIMEOUT', 0) 1279.000
CALL STTY(IFD, 'BINARY', OFF) 1280.000
RETURN 1281.000
END 1282.000
SUBROUTINE BYE 1283.000
IMPLICIT NONE 1284.000
C 1285.000
C= Sends bye to remote and exits kermit 1286.000
C 1287.000
INCLUDE K.KERMD 1288.000
INCLUDE K.PROTC 1289.000
INCLUDE K.PACKC 1290.000
C 1291.000
1292.000
INTEGER PTYP !packet type 1293.000
INTEGER LEN, NUM 1294.000
C 1295.000
LOGICAL CONFIRM 1296.000
INTEGER RDPACK 1297.000
C 1298.000
IF (.NOT. CONFIRM(INPUTFD)) RETURN 1299.000
C 1300.000
CALL STTY(IFD, 'BINARY', ON) 1301.000
CALL STTY(IFD, 'TIMEOUT', TIMEOUT) 1302.000
CALL STTY(IFD, 'NOWAIT', ON) 1303.000
IF (IFD .EQ. STDIN ) THEN 1304.000
CALL PRINTL(STDOUT, '?No communication port selected.') 1305.000
RETURN 1306.000
END IF 1307.000
C 1308.000
PACKET(1) = L 1309.000
NUMTRY = 0 1310.000
DO WHILE (NUMTRY .LE. MAXTRY) 1311.000
NUMTRY = NUMTRY + 1 1312.000
CALL SNDPACK(G, 0, 1, PACKET) 1313.000
PTYP = RDPACK(LEN, NUM, RECPACK) 1314.000
IF (PTYP .EQ. Y) LEAVE 1315.000
ENDDO 1316.000
CALL STTY(IFD, 'NOWAIT', OFF) 1317.000
CALL STTY(IFD, 'TIMEOUT', 0) 1318.000
CALL STTY(IFD, 'BINARY', OFF) 1319.000
CALL EXITPGM 1320.000
END 1321.000
SUBROUTINE GETFROM 1322.000
IMPLICIT NONE 1323.000
C 1324.000
C= Get file from remote server 1325.000
C 1326.000
INCLUDE K.KERMD 1327.000
INCLUDE K.PROTC 1328.000
INCLUDE K.PACKC 1329.000
C 1330.000
INTEGER IRET !return status 1331.000
INTEGER PTYP !packet type 1332.000
INTEGER LEN 1333.000
INTEGER NUM 1334.000
C 1335.000
INTEGER SLEN !length of string 1336.000
INTEGER RECEIVE 1337.000
INTRINSIC MOD 1338.000
INTEGER RDPACK !read packet 1339.000
INTEGER SNDPAR !pack send parameters 1340.000
C 1341.000
CALL SETVAL(FILESTR, 'S', IRET, 16, 0, 0, 1342.000
$ 'Filename to get', .TRUE.) 1343.000
IF (IRET .EQ. ERROR) RETURN 1344.000
C 1345.000
IF (IFD .EQ. STDIN) THEN 1346.000
CALL PRINTL(STDOUT, '?No communication port selected.') 1347.000
RETURN 1348.000
END IF 1349.000
C 1350.000
IF (INPUTFD .NE. STDIN .AND. OFD .NE. STDOUT) THEN 1351.000
CALL PRINTL(STDOUT, 'Getting file ') 1352.000
CALL PUTSTR(STDOUT, FILESTR) 1353.000
CALL FLUSH(STDOUT) 1354.000
ENDIF 1355.000
C 1356.000
CALL STTY(IFD, 'BINARY', ON) 1357.000
CALL STTY(IFD, 'TIMEOUT', TIMEOUT) 1358.000
CALL STTY(IFD, 'NOWAIT', ON) 1359.000
C 1360.000
NUMTRY = 0 1361.000
DO WHILE (NUMTRY .LE. MAXRINI) 1362.000
NUMTRY = NUMTRY + 1 1363.000
CALL SNDPACK(R, 0, SLEN(FILESTR), FILESTR) 1364.000
PTYP = RDPACK(LEN, NUM, RECPACK) 1365.000
IF (PTYP .EQ. S) THEN 1366.000
PACKNUM = NUM 1367.000
CALL RDPARAM(RECPACK) 1368.000
LEN = SNDPAR(PACKET) 1369.000
CALL SNDPACK(Y, PACKNUM, LEN, PACKET) 1370.000
NUMTRY = 0 1371.000
PACKNUM = MOD(PACKNUM+1, 64) 1372.000
IF (RECEIVE(F) .EQ. OK) THEN 1373.000
CALL PRINTL(STDOUT, 'Receive complete.') 1374.000
ELSE 1375.000
CALL PRINTL(STDOUT, 'Receive failed.') 1376.000
ENDIF 1377.000
LEAVE 1378.000
ENDIF 1379.000
ENDDO 1380.000
CALL STTY(IFD, 'NOWAIT', OFF) 1381.000
CALL STTY(IFD, 'TIMEOUT', 0) 1382.000
CALL STTY(IFD, 'BINARY', OFF) 1383.000
RETURN 1384.000
END 1385.000
SUBROUTINE TAKE 1386.000
IMPLICIT NONE 1387.000
C 1388.000
C Provides a means to redirect input to file. 1389.000
C 1390.000
INCLUDE K.KERMD 1391.000
INCLUDE K.PROTC 1392.000
C 1393.000
INTEGER TAKEFILE(17) !take file input name 1394.000
CHARACTER*8 CTAKEFIL !input file name 1395.000
INTEGER IRET !return code 1396.000
INTEGER TAKEFD !file desc to take from 1397.000
C 1398.000
LOGICAL ISFILE !check for file existence 1399.000
INTEGER OPEN 1400.000
C 1401.000
C 1402.000
CALL SETVAL(TAKEFILE, 'S', IRET, 16, 0, 0, 1403.000
$ 'Filename to take commands from',.TRUE.) 1404.000
IF (IRET .EQ. ERROR) RETURN 1405.000
C 1406.000
C check to make sure it's there 1407.000
C 1408.000
CALL AS2DPC(TAKEFILE, CTAKEFIL) 1409.000
IF (.NOT. ISFILE(CTAKEFIL)) THEN 1410.000
CALL PRINTL(STDOUT, '?File ') 1411.000
CALL PUTSTR(STDOUT, TAKEFILE) 1412.000
CALL PRINT(STDOUT, ' is not found.') 1413.000
CALL PUTC(STDOUT, NEL) 1414.000
RETURN 1415.000
ENDIF 1416.000
C 1417.000
C open file 1418.000
C 1419.000
IF (INSTACK .GE. MAXINSTK) THEN 1420.000
CALL PRINTL(STDOUT, '?Exceed input TAKE stack depth.') 1421.000
RETURN 1422.000
ENDIF 1423.000
TAKEFD = OPEN(CTAKEFIL, 'R') 1424.000
IF (TAKEFD .EQ. ERROR) THEN 1425.000
CALL PRINTL(STDOUT, '?Cannot open ') 1426.000
CALL PUTSTR(STDOUT, TAKEFILE) 1427.000
CALL PRINT(STDOUT, '.') 1428.000
CALL PUTC(STDOUT, NEL) 1429.000
RETURN 1430.000
ENDIF 1431.000
C 1432.000
C remember where was 1433.000
C 1434.000
INSTACK = INSTACK + 1 1435.000
INSTKFD(INSTACK) = INPUTFD 1436.000
C 1437.000
C redirect 1438.000
C 1439.000
INPUTFD = TAKEFD 1440.000
RETURN 1441.000
END 1442.000
SUBROUTINE TAKEDONE 1443.000
IMPLICIT NONE 1444.000
C 1445.000
C= Returns to next level of input file. 1446.000
C 1447.000
INCLUDE K.KERMD 1448.000
INCLUDE K.PROTC 1449.000
C 1450.000
IF (INPUTFD .NE. STDIN) CALL CLOSE(INPUTFD) 1451.000
IF (INSTACK .LE. 0) THEN 1452.000
INSTACK = 0 1453.000
INPUTFD = STDIN 1454.000
ELSE 1455.000
INPUTFD = INSTKFD(INSTACK) 1456.000
INSTACK = INSTACK - 1 1457.000
ENDIF 1458.000
RETURN 1459.000
END 1460.000
