home *** CD-ROM | disk | FTP | other *** search
/ kermit.columbia.edu / kermit.columbia.edu.tar / kermit.columbia.edu / archives / gould3.tar.gz / gould3.tar / kermit0 < prev    next >
Text File  |  2011-08-09  |  121KB  |  1,498 lines

  1. *     BASE -ULTLY-KERM -SFM-A2703 - 08/01/90  WJH     HEADER  SFMKERM   0001.000
  2.       PROGRAM KERMIT                                                    0001.100
  3.            IMPLICIT NONE                                                0002.000
  4. C                                                                       0003.000
  5. C= File transfer program using kermit protocol                          0004.000
  6. C                                                                       0005.000
  7. C                                                                       0006.000
  8. C                  REVISION LIST                                        0007.000
  9. C                                                                       0008.000
  10. C     1.0  This Kermit was the direct implemention of the Cyber-170     0009.000
  11. C          version, University of Texas.  L. Tate, SAI, Sept. 1985.     0010.000
  12. C                                                                       0011.000
  13. C     2.0  Added the CONNECT, GET, FINISH, BYE commands.  This required 0012.000
  14. C          significant changes to the io interface.  The local on/off   0013.000
  15. C          option was also part of this.  L. Tate, SAI, Nov. 1985.      0014.000
  16. C                                                                       0015.000
  17. C     2.1  Correct bug in SUDT.  When use the SVC 1,X'27' which         0016.000
  18. C          set full duplex on a terminal it previously used a trashed   0017.000
  19. C          file control block.  This had caused unpredicatable results  0018.000
  20. C          in alot of the io including 2 reads pending at once.         0019.000
  21. C          Correcting this problem allowed removal of HIOALL routine.   0020.000
  22. C          Files to be read are opened with OPENMODE='R' and files to   0021.000
  23. C          be written are opened with OPENMODE='U'.  Also added the     0022.000
  24. C          TAKE command.   L. Tate, SAI, Mar. 1986.                     0023.000
  25. C                                                                       0024.000
  26. C     2.2  Improved receive/get reliablity by moving the terminal       0025.000
  27. C          reporting to before the ACK/NAK is sent.  The problem seems  0026.000
  28. C          to have been during the reporting time, the sending flooded  0027.000
  29. C          the 8-line buffer and caused a break, losing data.  Also     0028.000
  30. C          corrected error in printl routine which wrote to stdout      0029.000
  31. C          instead of the parameter fd. L. Tate, SAI, Mar. 1986.        0030.000
  32. C                                                                       0031.000
  33. C     2.3  Added to SERVER the ability to recognize the I packet.       0032.000
  34. C          This packet is used by advanced Kermits (2.27 at least)      0033.000
  35. C          to initialize the Server.                                    0034.000
  36. C          Changed the method by which nowait is established so that    0035.000
  37. C          if ECHO was off for the terminal before kermit operation,    0036.000
  38. C          it will remain so afterwards.  Good for network operation.   0037.000
  39. C          Corrected the error reporting code such that now the error   0038.000
  40. C          messages are produced.  However, they can be very cryptic.   0039.000
  41. C          What is needed is a general method of handling text, like    0040.000
  42. C          help messages and error messages, such that memory is not    0041.000
  43. C          filled but ready access is available.                        0042.000
  44. C          L. TATE, SAI, MAY 1986.                                      0043.000
  45. C                                                                       0044.000
  46. C     AS IN TO LFC=UT                                                   0045.000
  47. C     AS OUT TO LFC=UT                                                  0046.000
  48. C                                                                       0047.000
  49. C                                                                       0048.000
  50. C     2.4  Modified to run on GOULD 32/77 machine using the MPX 1.5E    0049.000
  51. C          operating system.                                            0050.000
  52. C          B.WILSON, QEC, JANUARY 1989                                  0051.000
  53. C                                                                       0052.000
  54. C                                                                       0053.000
  55. C                                                                       0054.000
  56.       INCLUDE       K.KERMV                                             0055.000
  57.       INCLUDE       K.KERMD                                             0056.000
  58.       INCLUDE       K.PROTC                                             0057.000
  59.       INCLUDE       K.MSGCOM                                            0058.000
  60.       INCLUDE       K.DBUGC                                             0059.000
  61. C                                                                       0060.000
  62.       INTEGER      NCMD            ;PARAMETER (NCMD=15)                 0061.000
  63.       CHARACTER*10 CMD(NCMD)       !commands                            0062.000
  64.      $   /'BYE', 'CONNECT','EXIT','FINISH','GET','HELP',                0063.000
  65.      $    'QUIT','RECEIVE','SEND','SERVER',                             0064.000
  66.      $    'SET', 'SHOW', 'STATUS','TAKE', 'X'/                          0065.000
  67.       INTEGER      NNOLOCAL        ;PARAMETER (NNOLOCAL =  3)           0066.000
  68.       CHARACTER*63 NOLOCAL (NNOLOCAL)                                   0067.000
  69.      $/'This KERMIT does not support the following commands; BYE,',     0068.000
  70.      $ 'CONNECT, FINISH, SEND and GET.  These commands require KERMIT', 0069.000
  71.      $ 'to be installed on MPX3.2B or greater.'/                        0070.000
  72.       INTEGER      IDX             !current command                     0071.000
  73.       CHARACTER*80 CMDLIN          !command line that started program   0072.000
  74.       INTEGER      IOS                                                  0073.000
  75. C                                                                       0074.000
  76.       INTEGER      MATCH           !get and match command               0075.000
  77.       INTEGER      OPEN                                                 0076.000
  78. C                                                                       0077.000
  79.       INPUTFD = 0                                                       0077.100
  80.       CALL SLINE(CMDLIN)           !get startup command line            0078.000
  81.       CALL INIT(CMDLIN)            !pass to initialize                  0079.000
  82. C                                                                       0080.000
  83.       IOS = OPEN('STDIN','R')                                           0081.000
  84.       IF (IOS .NE. STDIN) THEN                                          0082.000
  85.         CALL PRTMSG(' Cannot open standard input', -IOS)                0083.000
  86.         STOP                                                            0084.000
  87.       ENDIF                                                             0085.000
  88.       IOS = OPEN('STDOUT','W')                                          0086.000
  89.       IF (IOS .NE. STDOUT) THEN                                         0087.000
  90.         CALL PRTMSG(' Cannot open standard output',-IOS)                0088.000
  91.         STOP                                                            0089.000
  92.       ENDIF                                                             0090.000
  93. C                                                                       0091.000
  94. C initializing program                                                  0092.000
  95. C                                                                       0093.000
  96. C     INPUTFD = OPEN('KERM.INI', 'R')                                   0094.000
  97.       IF (INPUTFD .LE. 0) INPUTFD = STDIN                               0095.000
  98. C                                                                       0096.000
  99.       CALL PRINTL(STDOUT, VERSION)                                      0097.000
  100.       DO  BEGIN                                                         0098.000
  101.         IF (INPUTFD .EQ. STDIN) THEN                                    0099.000
  102.           CALL PUTSTR(STDOUT, PROMPT)                                   0100.000
  103.           CALL FLUSH(STDOUT)                                            0101.000
  104.         ENDIF                                                           0102.000
  105.         CALL FLUSH(INPUTFD)                                             0103.000
  106.         IDX = MATCH(CMD, NCMD, .TRUE.)                                  0104.000
  107.         IF (IDX .EQ. ERROR .OR. IDX .EQ. 0) GOTO 200                    0105.000
  108.         IF (IDX .EQ. EOF) THEN                                          0106.000
  109.           IF (INPUTFD .NE. STDIN) THEN                                  0107.000
  110.             CALL TAKEDONE                                               0108.000
  111.             GOTO 200                                                    0109.000
  112.           ELSE                                                          0110.000
  113.             CALL EXITPGM                                                0111.000
  114.           ENDIF                                                         0112.000
  115.         ENDIF                                                           0113.000
  116.         GOTO (130, 40, 50, 140, 20, 90, 50, 30, 10, 80, 100,            0114.000
  117.      $        110, 120, 60, 50    ) IDX                                 0115.000
  118. C                                                                       0116.000
  119.  10     CONTINUE                   !send  - Not debugged yet            0117.000
  120. C         CALL SNDFILE                                                  0118.000
  121. C         GOTO 200                                                      0119.000
  122.           GO TO 190                                                     0120.000
  123.  20     CONTINUE                   !get                                 0121.000
  124.           IF (.NOT. LOCALON) GOTO 190                                   0122.000
  125.           CALL GETFROM                                                  0123.000
  126.           GOTO 200                                                      0124.000
  127.  30     CONTINUE                   !receive                             0125.000
  128.           CALL RCVFILE                                                  0126.000
  129.           GOTO 200                                                      0127.000
  130.  40     CONTINUE                   !connect                             0128.000
  131.           IF (.NOT. LOCALON) GOTO 190                                   0129.000
  132.           CALL CONNECT                                                  0130.000
  133.           GOTO 200                                                      0131.000
  134.  50     CONTINUE                   !exit                                0132.000
  135.           CALL EXITPGM                                                  0133.000
  136.  60     CONTINUE                   !take                                0134.000
  137.           CALL TAKE                                                     0135.000
  138.           GOTO 200                                                      0136.000
  139.  80     CONTINUE                   !server                              0137.000
  140.           CALL SERVER                                                   0138.000
  141.           CALL INIT(CMDLIN)                                             0138.100
  142.           GOTO 200                                                      0139.000
  143.  90     CONTINUE                   !help                                0140.000
  144.           CALL HELP                                                     0141.000
  145.           GOTO 200                                                      0142.000
  146.  100    CONTINUE                   !set                                 0143.000
  147.           CALL SET                                                      0144.000
  148.           GOTO 200                                                      0145.000
  149.  110    CONTINUE                   !show                                0146.000
  150.           CALL SHOW                                                     0147.000
  151.           GOTO 200                                                      0148.000
  152.  120    CONTINUE                   !status                              0149.000
  153.           CALL STATUS                                                   0150.000
  154.           GOTO 200                                                      0151.000
  155.  130    CONTINUE                   !bye                                 0152.000
  156.           IF (.NOT. LOCALON) GOTO 190                                   0153.000
  157.           CALL BYE                                                      0154.000
  158.           GOTO 200                                                      0155.000
  159.  140    CONTINUE                   !finish                              0156.000
  160.           IF (.NOT. LOCALON) GOTO 190                                   0157.000
  161.           CALL FINISH                                                   0158.000
  162.           GOTO 200                                                      0159.000
  163.  190    CONTINUE                   !no local                            0160.000
  164.           CALL OUTTBL(NOLOCAL, 1, NNOLOCAL)                             0161.000
  165.           GOTO 200                                                      0162.000
  166.  210      CONTINUE                                                      0162.100
  167.  200    CONTINUE                                                        0163.000
  168.       ENDDO                                                             0164.000
  169.       END                                                               0165.000
  170.       SUBROUTINE INIT(COMLIN)                                           0166.000
  171.            IMPLICIT NONE                                                0167.000
  172.            CHARACTER*80  COMLIN    !command line of program             0168.000
  173. C                                                                       0169.000
  174. C= initializes all kermit context                                       0170.000
  175. C                                                                       0171.000
  176.       INCLUDE      K.KERMV                                              0172.000
  177.       INCLUDE      K.KERMD                                              0173.000
  178.       INCLUDE      K.DBUGC                                              0174.000
  179.       INCLUDE      K.PROTC                                              0175.000
  180.       INCLUDE      K.PACKC                                              0176.000
  181.       INCLUDE      K.MSGCOM                                             0177.000
  182. C                                                                       0178.000
  183.       INTEGER      I               !index                               0179.000
  184.       CHARACTER*2  MACH            !machine type code                   0180.000
  185. C                                                                       0181.000
  186.       INTEGER      LASTCHR         !last non blank character            0182.000
  187.       INTRINSIC    ICHAR           !character to int                    0183.000
  188. C     INTEGER      ICHAR                                                0183.100
  189.       INTEGER      MATCH                                                0184.000
  190.       INTEGER      OPEN                                                 0185.000
  191. C                                                                       0186.000
  192. C dbugcom                                                               0187.000
  193. C                                                                       0188.000
  194. C     CALL M_UPRIV                                                      0189.000
  195.       CALL BREAKR                                                       0190.000
  196. C                                                                       0191.000
  197.       DEBUG = .FALSE.              !no debug on                         0192.000
  198.       DBGFD = 0                    !standoutput                         0193.000
  199.       DBGFILE = 'KERMLOG'          !standoutput                         0194.000
  200. C                                                                       0195.000
  201. C protcom                                                               0196.000
  202. C                                                                       0197.000
  203.       PACKET = 0                                                        0198.000
  204.       RECPACK = 0                                                       0199.000
  205.       FILESTR = 0                                                       0200.000
  206.       PSIZE = 0                                                         0201.000
  207.       PACKNUM = 0                                                       0202.000
  208.       NUMTRY = 0                                                        0203.000
  209.       MAXRTRY = MAXTRY                                                  0204.000
  210.       MAXRINI = MAXINIT                                                 0205.000
  211.       STATE = C                                                         0206.000
  212.       IFD = STDIN                                                       0207.000
  213.       OFD = STDOUT                                                      0208.000
  214.       COMPORT = 'UT'                                                    0209.000
  215.       FFD = 0                                                           0210.000
  216.       DELAYFP =  0                                                      0211.000
  217.       STARTIM = 0                                                       0212.000
  218.       ENDTIM = 0                                                        0213.000
  219.       SCHCNT = 0                                                        0214.000
  220.       RCHCNT = 0                                                        0215.000
  221.       SCHOVRH = 0                                                       0216.000
  222.       RCHOVRH = 0                                                       0217.000
  223.       ECHO = .FALSE.                                                    0218.000
  224.       ESCCHR = 29                  ! CONTROL-]                          0219.000
  225.       LOG = .FALSE.                                                     0220.000
  226.       LFD = 0                                                           0221.000
  227.       LOGFILE = 'KERMSESN'                                              0222.000
  228.       INSTACK = 0                  !initialize stack pointer            0223.000
  229.       INSTKFD = 0                  !zero stack for good measure         0224.000
  230. C                                                                       0225.000
  231. C packcom                                                               0226.000
  232. C                                                                       0227.000
  233.       SYNC = SNDSYNC = SOH                                              0228.000
  234.       PACKSIZ = SPKSIZ = MAXPACK                                        0229.000
  235.       TIMEOUT = STIMOUT = MYTIME                                        0230.000
  236.       NPAD = SPAD = MYPAD                                               0231.000
  237.       PADCH = SPADCH = MYPADCH                                          0232.000
  238.       EOLCH = SPEOL = MYEOL                                             0233.000
  239.       QUOTECH = SPQUOTE = MYQUOTE                                       0234.000
  240.       QUOTE8 = S8QUOTE = QUOT8CH                                        0235.000
  241.       CHKTYP = SCHKTYP = MYCKTYP                                        0236.000
  242.       RESERVE  = UNUSED = 0                                             0237.000
  243.       RPREFIX = SREPEAT = PREFXCH                                       0238.000
  244. C                                                                       0239.000
  245. C msgcom                                                                0240.000
  246. C                                                                       0241.000
  247.       IF (LOCALON) THEN                                                 0242.000
  248.         VERSION = 'Gould KERMIT version 2.3, Local/Remote enabled'      0243.000
  249.       ELSE                                                              0244.000
  250.         VERSION = 'Gould KERMIT version 2.3, Local/Remote disabled'     0245.000
  251.       ENDIF                                                             0246.000
  252.       CALL GETMACH(MACH)                                                0247.000
  253.       PROMPT(1) = NEL                                                   0248.000
  254.       CALL DPC2AS('kermit-'//MACH//'>', PROMPT(2), 19)                  0249.000
  255.       I = LASTCHR(COMLIN)                                               0250.000
  256.       IF (I .GT. 18  ) I = 18                                           0251.000
  257.       IF (I .GT. 0) CALL DPC2AS(COMLIN(:I)//'>', PROMPT(2), I+1)        0252.000
  258. CLT 2.3  FIXED THE LOGIC FOR LNAME                                      0253.000
  259.       I = 2                                                             0254.000
  260.       LNAME = 0                                                         0255.000
  261.       DO WHILE (PROMPT(I) .NE. ICHAR('>') .AND. I .LT. 21)              0256.000
  262.         LNAME = LNAME + 1                                               0257.000
  263.         NAME(LNAME) = PROMPT(I)                                         0258.000
  264.         I = I + 1                                                       0259.000
  265.       ENDDO                                                             0260.000
  266. C                                                                       0261.000
  267.       CALL BREAKR                                                       0262.000
  268.       CALL X:SYNCH                                                      0263.000
  269. C                                                                       0264.000
  270.       RETURN                                                            0265.000
  271.       END                                                               0266.000
  272.       SUBROUTINE EXITPGM                                                0267.000
  273.            IMPLICIT NONE                                                0268.000
  274. C                                                                       0269.000
  275. C= Exit kermit                                                          0270.000
  276. C                                                                       0271.000
  277.       INTEGER      I               !index                               0272.000
  278. C                                                                       0273.000
  279.       DO I=1, 10                                                        0274.000
  280.         CALL CLOSE(I)                                                   0275.000
  281.       ENDDO                                                             0276.000
  282.       CALL EXIT                                                         0277.000
  283.       END                                                               0278.000
  284.       SUBROUTINE RCVFILE                                                0279.000
  285.            IMPLICIT NONE                                                0280.000
  286. C                                                                       0281.000
  287. C= Top level subroutine to start receive state.                         0282.000
  288. C                                                                       0283.000
  289.       INCLUDE      K.KERMD                                              0284.000
  290.       INCLUDE      K.PROTC                                              0285.000
  291.       INCLUDE      K.PACKC                                              0286.000
  292. C                                                                       0287.000
  293.       INTEGER      RECEIVE         !receive file                        0288.000
  294.       INTEGER      GTTY            !get tty status                      0289.000
  295.       LOGICAL      CONFIRM         !confirm input                       0290.000
  296. C                                                                       0291.000
  297.       IF (.NOT. CONFIRM(INPUTFD)) RETURN                                0292.000
  298. C                                                                       0293.000
  299. C receive file                                                          0294.000
  300. C                                                                       0295.000
  301.       CALL STTY(IFD, 'BINARY', ON)                                      0296.000
  302.       CALL STTY(IFD, 'TIMEOUT', TIMEOUT)                                0297.000
  303.       CALL STTY(IFD, 'NOWAIT', ON)                                      0298.000
  304.       IF (INPUTFD .NE. STDIN .AND. OFD .NE. STDOUT) THEN                0299.000
  305.         CALL PRINTL(STDOUT, 'Receiving file ')                          0300.000
  306.         CALL PUTSTR(STDOUT, FILESTR)                                    0301.000
  307.         CALL FLUSH(STDOUT)                                              0302.000
  308.       ENDIF                                                             0303.000
  309.       IF (RECEIVE(R) .EQ. OK) THEN                                      0304.000
  310.         CALL PRINTL(STDOUT, 'Receive complete.')                        0305.000
  311.       ELSE                                                              0306.000
  312.         CALL PRINTL(STDOUT, 'Received failed.')                         0307.000
  313.       ENDIF                                                             0308.000
  314.       CALL STTY(IFD, 'NOWAIT', OFF)                                     0309.000
  315.       CALL STTY(IFD, 'TIMEOUT', 0)                                      0310.000
  316.       CALL STTY(IFD, 'BINARY', OFF)                                     0311.000
  317.       RETURN                                                            0312.000
  318.       END                                                               0313.000
  319.       SUBROUTINE SNDFILE                                                0314.000
  320.            IMPLICIT NONE                                                0315.000
  321. C                                                                       0316.000
  322. C= Sends a file to other kermit                                         0317.000
  323. C                                                                       0318.000
  324.       INCLUDE      K.KERMD                                              0319.000
  325.       INCLUDE      K.PROTC                                              0320.000
  326.       INCLUDE      K.PACKC                                              0321.000
  327. C                                                                       0322.000
  328.       CHARACTER*8  FNAME           !name of file to send                0323.000
  329.       INTEGER      IRET            !return status                       0324.000
  330. C                                                                       0325.000
  331.       LOGICAL      ISFILE                                               0326.000
  332.       INTEGER      SEND                                                 0327.000
  333. C                                                                       0328.000
  334. C pick up file name and save it for opening later                       0329.000
  335. C                                                                       0330.000
  336.       CALL SETVAL(FILESTR, 'S', IRET, 16, 0, 0,                         0331.000
  337.      $  'Filename to send', .TRUE.)                                     0332.000
  338.       IF (IRET .EQ. ERROR) RETURN                                       0333.000
  339. C                                                                       0334.000
  340. C check to make sure it's there to send                                 0335.000
  341. C                                                                       0336.000
  342.       CALL AS2DPC(FILESTR, FNAME)                                       0337.000
  343.       IF (.NOT. ISFILE(FNAME)) THEN                                     0338.000
  344.         CALL PRINTL(STDOUT, '?File ')                                   0339.000
  345.         CALL PUTSTR(STDOUT, FILESTR)                                    0340.000
  346.         CALL PRINT(STDOUT,' is not found.')                             0341.000
  347.         CALL PUTC(STDOUT, NEL)                                          0342.000
  348.         RETURN                                                          0343.000
  349.       ENDIF                                                             0344.000
  350. C                                                                       0345.000
  351.       CALL STTY(IFD, 'BINARY', ON)                                      0346.000
  352.       CALL STTY(IFD, 'TIMEOUT', TIMEOUT)                                0347.000
  353.       CALL STTY(IFD, 'NOWAIT', ON)                                      0348.000
  354. C                                                                       0349.000
  355. C delay the first packet                                                0350.000
  356. C                                                                       0351.000
  357.       IF (DELAYFP .GT. 0) CALL SLEEP(DELAYFP)                           0352.000
  358. C                                                                       0353.000
  359. C start sending packet                                                  0354.000
  360. C                                                                       0355.000
  361.       IF (INPUTFD .NE. STDIN .AND. OFD .NE. STDOUT) THEN                0356.000
  362.         CALL PRINTL(STDOUT, 'Sending file ')                            0357.000
  363.         CALL PUTSTR(STDOUT, FILESTR)                                    0358.000
  364.         CALL FLUSH(STDOUT)                                              0359.000
  365.       ENDIF                                                             0360.000
  366.       PACKNUM = 0                                                       0361.000
  367.       IF (SEND() .EQ. OK) THEN                                          0362.000
  368.         CALL PRINTL(STDOUT, 'Send complete.')                           0363.000
  369.       ELSE                                                              0364.000
  370.         CALL PRINTL(STDOUT, 'Send failed.')                             0365.000
  371.       ENDIF                                                             0366.000
  372.       CALL STTY(IFD, 'NOWAIT', OFF)                                     0367.000
  373.       CALL STTY(IFD, 'TIMEOUT', 0)                                      0368.000
  374.       CALL STTY(IFD, 'BINARY', OFF)                                     0369.000
  375.       RETURN                                                            0370.000
  376.       END                                                               0371.000
  377.       SUBROUTINE SERVER                                                 0372.000
  378.            IMPLICIT NONE                                                0373.000
  379. C                                                                       0374.000
  380. C= Start kermit server routine                                          0375.000
  381. C                                                                       0376.000
  382. C     The server currently knows about the send and receive packets     0377.000
  383. C     and also the generic kermit packets logout and finish.            0378.000
  384. C                                                                       0379.000
  385.       INCLUDE      K.KERMD                                              0380.000
  386.       INCLUDE      K.DBUGC                                              0381.000
  387.       INCLUDE      K.PROTC                                              0382.000
  388.       INCLUDE      K.PACKC                                              0383.000
  389. C                                                                       0384.000
  390.       INTEGER      PTYP                                                 0385.000
  391.       INTEGER      I                                                    0386.000
  392.       INTEGER      NUM             !packet number                       0387.000
  393.       INTEGER      RECSTAT         !receive status                      0388.000
  394.       INTEGER      SNDSTAT         !send status                         0389.000
  395.       CHARACTER*72 SRVMES (4 )                                          0390.000
  396.      $ /'[Kermit SERVER running on Gould host.  Please type your',      0391.000
  397.      $  'escape sequence ( altK ) to return to your local machine',     0392.000
  398.      $  'Use GET to request a file from the GOULD host.      ',         0393.000
  399.      $  'Use FINISH to return control to GOULD host.]'/                 0394.000
  400.       CHARACTER*56    FILENAME                                          0395.000
  401.       INTEGER*8     FINAME                                              0396.000
  402.       CHARACTER*8   FCNAME                                              0397.000
  403.       EQUIVALENCE  (FILENAME,FINAME,FCNAME)                             0398.000
  404. C                                                                       0399.000
  405.       LOGICAL CONFIRM                                                   0400.000
  406.       INTEGER      RDPACK          !read a packet                       0401.000
  407.       INTEGER      SNDPAR          !build init packet                   0402.000
  408.       INTEGER      GTTY            !get terminal stuff                  0403.000
  409.       INTEGER      RECEIVE         !receive file                        0404.000
  410.       INTEGER      SEND            !send file                           0405.000
  411.       INTEGER      LASTCHR         !last non-blank character            0406.000
  412.       INTEGER      MAX                                                  0407.000
  413.       INTEGER      SLEN            !string length                       0408.000
  414.       INTEGER      USCMD                                                0408.100
  415.       LOGICAL      ISFILE          !does file exist                     0409.000
  416.       INTEGER      M /'A'/                                              0409.010
  417. C                                                                       0409.100
  418.       INTRINSIC    MOD                                                  0409.200
  419. C                                                                       0410.000
  420.       IF (.NOT. CONFIRM(INPUTFD)) RETURN                                0411.000
  421. C                                                                       0412.000
  422. C initialize msg #, say no tries yet                                    0413.000
  423. C                                                                       0414.000
  424.       PACKNUM = 0                                                       0415.000
  425.       USCMD = 0                                                         0415.100
  426.       NUMTRY = 0                                                        0416.000
  427.       CALL OUTTBL(SRVMES, 1, 4)                                         0417.000
  428. C                                                                       0418.000
  429.       CALL STTY(IFD, 'BINARY', ON)                                      0419.000
  430.       CALL STTY(IFD, 'TIMEOUT', TIMEOUT)                                0420.000
  431.       CALL STTY(IFD, 'NOWAIT', ON)                                      0421.000
  432.       CALL STTY(IFD, 'SIZE'  ,768)                                      0421.100
  433. C                                                                       0422.000
  434.  10   CONTINUE                                                          0423.000
  435.       PTYP = RDPACK(LEN, NUM, RECPACK)                                  0424.000
  436. X      WRITE(19,1000)PTYP,LEN,NUM                                       0424.100
  437. X1000 FORMAT(' 4242**  ',8(1X,1Z8))                                     0424.200
  438.       IF (PTYP .EQ. S) THEN                                             0425.000
  439.         PACKNUM = NUM                                                   0426.000
  440.         CALL RDPARAM(RECPACK)                                           0427.000
  441.         I = SNDPAR(PACKET)                                              0428.000
  442. X       WRITE(19,1001)Y,PACKNUM,I,PACKET                                0428.100
  443. X1001   FORMAT(' 428.2**  ',8(1X,1Z8))                                  0428.200
  444.         CALL SNDPACK(Y, PACKNUM, I, PACKET)                             0429.000
  445.         NUMTRY = 0                                                      0430.000
  446.         PACKNUM = MOD(PACKNUM+1, 64)                                    0431.000
  447.         RECSTAT = RECEIVE(F)                                            0432.000
  448. X       WRITE(19,1002)RECSTAT                                           0432.100
  449. X1002   FORMAT(' 432.2**  ',1Z8)                                        0432.200
  450.         IF (DEBUG(DBGON)) THEN                                          0433.000
  451.           IF (RECSTAT .EQ. ERROR) THEN                                  0434.000
  452.             CALL PRINTL(DBGFD, 'Receive failed.')                       0435.000
  453.           ELSE                                                          0436.000
  454.             CALL PRINTL(DBGFD, 'Receive completed.')                    0437.000
  455.           ENDIF                                                         0438.000
  456.         ENDIF                                                           0439.000
  457.       ELSE IF (PTYP .EQ. M) THEN                                        0439.100
  458.           CALL SNDPACK(Y, NUM, 0, 0)                                    0439.200
  459.           CALL STTY(IFD, 'NOWAIT', OFF)                                 0439.300
  460.           CALL STTY(IFD, 'TIMEOUT', 0)                                  0439.400
  461.           CALL STTY(IFD, 'BINARY', OFF)                                 0439.500
  462.       ELSE IF (PTYP .EQ. R) THEN                                        0440.000
  463. C       IF (DEBUG(DBGON)) THEN                                          0441.000
  464. C         CALL PRINTL(DBGFD, 'SERVER: PACKET TYPE IS R     ')           0442.000
  465. C       ENDIF                                                           0443.000
  466.         I = 0                                                           0444.000
  467.         CALL STRCPY(RECPACK, FILESTR)                                   0445.000
  468.         CALL AS2DPC(FILESTR, FILENAME)                                  0446.000
  469.         CALL FILCHK(FCNAME)                                             0447.000
  470. X       WRITE(19,890)FILENAME                                           0447.100
  471. X890    FORMAT(' 890** ',1X,1A56)                                       0447.200
  472. C                                                                       0448.000
  473. CLT 2.3 5/12/86 CHECK TO SEE IF FILE EXISTS                             0449.000
  474. C                                                                       0450.000
  475.         IF (ISFILE(FINAME)) THEN                                        0451.000
  476.         IF (DEBUG(DBGON)) THEN                                          0452.000
  477.           CALL PRINTL(DBGFD, 'SERVER: FILE FOUND ')                     0453.000
  478.         ENDIF                                                           0454.000
  479.           CALL DPC2AS(FILENAME, FILESTR, MAX(1,LASTCHR(FILENAME)))      0455.000
  480. X         WRITE(19,900)                                                 0455.100
  481. X900      FORMAT(' SERVER : FILE FOUND ')                               0455.200
  482.           SNDSTAT = SEND()                                              0456.000
  483.           PACKNUM = 0                                                   0457.000
  484.           IF (DEBUG(DBGON)) THEN                                        0458.000
  485.             IF (SNDSTAT .EQ. ERROR) THEN                                0459.000
  486.               CALL PRINTL(DBGFD, 'Send failed.')                        0460.000
  487.             ELSE                                                        0461.000
  488.               CALL PRINTL(DBGFD, 'Send completed.')                     0462.000
  489.             ENDIF                                                       0463.000
  490.           ENDIF                                                         0464.000
  491. CLT 2.3 5/12/86 SEND ERROR PACKET IF NOT FOUND                          0465.000
  492.         ELSE                                                            0466.000
  493.           CALL DPC2AS('? FILE ', PACKET, 7)                             0467.000
  494.           I = LASTCHR(FILENAME)                                         0468.000
  495.           CALL DPC2AS(FILENAME, PACKET(8), I)                           0469.000
  496.           CALL DPC2AS(' NOT FOUND', PACKET(I+8), 10)                    0470.000
  497.           CALL SNDPACK(E, PACKNUM, SLEN(PACKET), PACKET)                0471.000
  498.         ENDIF                                                           0472.000
  499.       ELSE IF (PTYP .EQ. G) THEN                                        0473.000
  500.         IF (RECPACK(1) .EQ. L) THEN                                     0474.000
  501.           CALL SNDPACK(Y, NUM, 0, 0)                                    0475.000
  502.           CALL STTY(IFD, 'NOWAIT', OFF)                                 0476.000
  503.           CALL STTY(IFD, 'TIMEOUT', 0)                                  0477.000
  504.           CALL STTY(IFD, 'BINARY', OFF)                                 0478.000
  505. CCCCCCC   CALL EXITPGM   !LOGOUT                 WH JAN 90              0479.000
  506.           RETURN                                                        0479.100
  507.         ELSE IF (RECPACK(1) .EQ. F) THEN                                0480.000
  508.           CALL SNDPACK(Y, NUM, 0, 0)                                    0481.000
  509.           CALL STTY(IFD, 'NOWAIT', OFF)                                 0482.000
  510.           CALL STTY(IFD, 'TIMEOUT', 0)                                  0483.000
  511.           CALL STTY(IFD, 'BINARY', OFF)                                 0484.000
  512. CCCCCCC   CALL EXITPGM    !             WH JAN 90                       0485.000
  513.           RETURN                                                        0485.100
  514. C                                                                       0486.000
  515. CLT 2.3 5/12/86 SEND ERROR MESSAGE FOR UNSUPPORTED COMMAND              0487.000
  516. C                                                                       0488.000
  517.         ELSE                                                            0489.000
  518.           CALL DPC2AS('? UNSUPPORTED SERVER COMMAND', PACKET, 28)       0490.000
  519.           CALL SNDPACK(E, PACKNUM, SLEN(PACKET), PACKET)                0491.000
  520.         ENDIF                                                           0492.000
  521. C                                                                       0493.000
  522. CLT 2.3 5/8/86 RECEIVE SERVER INIT PACKET                               0494.000
  523. C                                                                       0495.000
  524.       ELSE IF (PTYP .EQ. ITYP) THEN                                     0496.000
  525.         PACKNUM = NUM                                                   0497.000
  526.         CALL RDPARAM(RECPACK)                                           0498.000
  527.         I = SNDPAR(PACKET)                                              0499.000
  528.         CALL SNDPACK(Y, PACKNUM, I, PACKET)                             0500.000
  529. C                                                                       0501.000
  530. CLT END                                                                 0502.000
  531. C                                                                       0503.000
  532.       ELSE                                                              0504.000
  533. CLT 2.3 5/12/86 Added error message for unrecognized packet             0505.000
  534.         CALL DPC2AS('? UNRECOGNIZED SERVER PACKET',PACKET,28)           0506.000
  535.         CALL SNDPACK(E,PACKNUM, SLEN(PACKET), PACKET)                   0507.000
  536.         IF (DEBUG(DBGON)) THEN                                          0508.000
  537.           CALL PRINTL(DBGFD, 'server: invalid packet type: ')           0509.000
  538.           CALL PUTINT(DBGFD, PTYP, 1)                                   0510.000
  539.           CALL FLUSH(DBGFD)                                             0511.000
  540.         ENDIF                                                           0512.000
  541.           CALL SNDPACK(Y, NUM, 0, 0)                                    0512.100
  542.           CALL STTY(IFD, 'NOWAIT', OFF)                                 0512.200
  543.           CALL STTY(IFD, 'TIMEOUT', 0)                                  0512.300
  544.           CALL STTY(IFD, 'BINARY', OFF)                                 0512.400
  545. CCCCCCC   CALL EXITPGM    !             WH JAN 90                       0512.500
  546.        USCMD = USCMD + 1                                                0512.510
  547.        IF (USCMD.LT.3)GO TO 10                                          0512.520
  548.           RETURN                                                        0512.600
  549. C                                                                       0512.700
  550.       ENDIF                                                             0513.000
  551.       GOTO 10                                                           0514.000
  552.       END                                                               0515.000
  553.       SUBROUTINE SET                                                    0516.000
  554.            IMPLICIT NONE                                                0517.000
  555. C                                                                       0518.000
  556. C= Set some attributes.                                                 0519.000
  557. C                                                                       0520.000
  558.       INCLUDE      K.KERMV                                              0521.000
  559.       INCLUDE      K.KERMD                                              0522.000
  560.       INCLUDE      K.PROTC                                              0523.000
  561.       INCLUDE      K.PACKC                                              0524.000
  562. C                                                                       0525.000
  563.       INTEGER      TSIZE           !set commands                        0526.000
  564.         PARAMETER (TSIZE = 10)                                          0527.000
  565.       CHARACTER*10 SETTYP(TSIZE)                                        0528.000
  566.      $ /'DEBUG','DELAY','ECHO', 'ESCAPE',                               0529.000
  567.      $          'INIT-RETRY','LOG','PORT','RECEIVE','RETRY','SEND'/     0530.000
  568.       INTEGER      NNOLOCAL        ;PARAMETER (NNOLOCAL = 3 )           0531.000
  569.       CHARACTER*63 NOLOCAL (NNOLOCAL)                                   0532.000
  570.      $/'This KERMIT does not support the following SET commands;',      0533.000
  571.      $ 'PORT and LOG.  These commands require KERMIT to be installed',  0534.000
  572.      $ 'on MPX3.2B or greater.'/                                        0535.000
  573.       INTEGER      INDX                                                 0536.000
  574.       INTEGER      ESIZE           ;PARAMETER (ESIZE = 2)               0537.000
  575.         CHARACTER*3 ECHOTYP(ESIZE) /'OFF','ON'/                         0538.000
  576.       CHARACTER*63 HLPASCH/                                             0539.000
  577.      $'Decimal, octal (O), or hexidecimal (H) code for ASCII character' 0540.000
  578.      $/                                                                 0541.000
  579. C                                                                       0542.000
  580.       INTEGER      MATCH                                                0543.000
  581. C                                                                       0544.000
  582.       INDX = MATCH (SETTYP, TSIZE, .FALSE.)                             0545.000
  583.       IF (INDX .LE. 0) RETURN                                           0546.000
  584.       GOTO (10, 20, 23, 27, 30, 80, 70, 40, 50, 60) INDX                0547.000
  585. C                                                                       0548.000
  586. C set debugging modes                                                   0549.000
  587. C                                                                       0550.000
  588.  10   CONTINUE                     !debug                               0551.000
  589.       CALL DBUGCMD                                                      0552.000
  590.       RETURN                                                            0553.000
  591. C                                                                       0554.000
  592.  20   CONTINUE                     !set first packet delay              0555.000
  593.       CALL SETVAL(DELAYFP,'I',0,60,0,60,                                0556.000
  594.      $ 'Number of seconds to delay first packet', .TRUE.)               0557.000
  595.       RETURN                                                            0558.000
  596. C                                                                       0559.000
  597.  23   CONTINUE                     !set echo on/off                     0560.000
  598.       INDX = MATCH(ECHOTYP, ESIZE, .TRUE.)                              0561.000
  599.       IF (INDX .LE. 0) RETURN                                           0562.000
  600.       ECHO = INDX .EQ. 2                                                0563.000
  601.       RETURN                                                            0564.000
  602. C                                                                       0565.000
  603.  27   CONTINUE                     !escape                              0566.000
  604.       CALL SETVAL(ESCCHR, 'I', 0, 31, 0, 31, HLPASCH, .TRUE.)           0567.000
  605.       RETURN                                                            0568.000
  606. C                                                                       0569.000
  607.  30   CONTINUE                     ! set initial packet retry count     0570.000
  608.       CALL SETVAL(MAXRINI,'I',1,50,1,50,                                0571.000
  609.      $   'Initial packet retry count', .TRUE.)                          0572.000
  610.       RETURN                                                            0573.000
  611. C                                                                       0574.000
  612.  40   CONTINUE                     !set receive packet attributes       0575.000
  613.       CALL SETPACK(PACKSIZ)                                             0576.000
  614.       RETURN                                                            0577.000
  615. C                                                                       0578.000
  616.  50   CONTINUE                     !set packet retry count              0579.000
  617.       CALL SETVAL(MAXRTRY, 'I',1,50,1,50,                               0580.000
  618.      $  'Packet retry count', .TRUE.)                                   0581.000
  619.       RETURN                                                            0582.000
  620. C                                                                       0583.000
  621.  60   CONTINUE                     !set send packet attributes          0584.000
  622.       CALL SETPACK(SPKSIZ)                                              0585.000
  623.       RETURN                                                            0586.000
  624. C                                                                       0587.000
  625.  70   CONTINUE                     !set port                            0588.000
  626.       IF (.NOT. LOCALON) GOTO 90                                        0589.000
  627.       CALL PORTCMD                                                      0590.000
  628.       RETURN                                                            0591.000
  629. C                                                                       0592.000
  630.  80   CONTINUE                     !set log                             0593.000
  631.       IF (.NOT. LOCALON) GOTO 90                                        0594.000
  632.       CALL LOGGER                                                       0595.000
  633.       RETURN                                                            0596.000
  634. C                                                                       0597.000
  635.  90   CONTINUE                     !no local                            0598.000
  636.       CALL OUTTBL(NOLOCAL, 1, NNOLOCAL)                                 0599.000
  637.       RETURN                                                            0600.000
  638.       END                                                               0601.000
  639.       SUBROUTINE SHOW                                                   0602.000
  640.            IMPLICIT NONE                                                0603.000
  641. C                                                                       0604.000
  642. C= Show the current program settings                                    0605.000
  643. C                                                                       0606.000
  644.       INCLUDE      K.KERMV                                              0607.000
  645.       INCLUDE      K.KERMD                                              0608.000
  646.       INCLUDE      K.PROTC                                              0609.000
  647.       INCLUDE      K.PACKC                                              0610.000
  648.       INCLUDE      K.DBUGC                                              0611.000
  649.       INCLUDE      K.MSGCOM                                             0612.000
  650. C                                                                       0613.000
  651.       INTEGER      MM,DD,YY,HR,MIN,SEC                                  0614.000
  652. C                                                                       0615.000
  653.       INTEGER      CTL                                                  0616.000
  654.       LOGICAL      CONFIRM                                              0617.000
  655. C                                                                       0618.000
  656.       IF (.NOT. CONFIRM(INPUTFD)) RETURN                                0619.000
  657.       CALL PRINTL(STDOUT, VERSION)                                      0620.000
  658. C                                                                       0621.000
  659. C display current date and time                                         0622.000
  660. C                                                                       0623.000
  661.       CALL GETNOW(MM, DD, YY, HR, MIN, SEC)                             0624.000
  662.       CALL PUTC(STDOUT, NEL)                                            0625.000
  663.       CALL PUTDAY(STDOUT, MM, DD, YY)                                   0626.000
  664.       CALL PRINT(STDOUT,', ')                                           0627.000
  665.       CALL PUTMNTH(STDOUT,MM)                                           0628.000
  666.       CALL PUTC(STDOUT,ICHAR(' '))                                      0629.000
  667.       CALL PUTINT(STDOUT,DD, 1)                                         0630.000
  668.       CALL PRINT(STDOUT,', ')                                           0631.000
  669.       CALL PUTINT(STDOUT,YY, 1)                                         0632.000
  670.       CALL PUTC(STDOUT,ICHAR(' '))                                      0633.000
  671.       IF (HR .LT. 10) CALL PRINT(STDOUT,'0')                            0634.000
  672.       CALL PUTINT(STDOUT,HR,1)                                          0635.000
  673.       CALL PUTC(STDOUT,ICHAR(':'))                                      0636.000
  674.       IF (MIN .LT. 10) CALL PRINT(STDOUT,'0')                           0637.000
  675.       CALL PUTINT(STDOUT,MIN,1)                                         0638.000
  676.       CALL PUTC(STDOUT,ICHAR(':'))                                      0639.000
  677.       IF (SEC .LT. 10) CALL PRINT(STDOUT,'0')                           0640.000
  678.       CALL PUTINT(STDOUT,SEC,1)                                         0641.000
  679. C                                                                       0642.000
  680. C display current debug modes                                           0643.000
  681. C                                                                       0644.000
  682.       CALL PRINTL(STDOUT,'Debugging: ')                                 0645.000
  683.       IF (DEBUG(DBGSTAT)) CALL PRINT(STDOUT,'States ')                  0646.000
  684.       IF (DEBUG(DBGPACK)) CALL PRINT(STDOUT,'Packets ')                 0647.000
  685.       IF (.NOT. DEBUG(DBGON)) CALL PRINT(STDOUT,'Off ')                 0648.000
  686.       IF (DEBUG(DBGON)) THEN                                            0649.000
  687.         CALL PRINT(STDOUT,'  Debug log file: '//DBGFILE)                0650.000
  688.       ENDIF                                                             0651.000
  689. C                                                                       0652.000
  690. C session log                                                           0653.000
  691. C                                                                       0654.000
  692.       IF (LOCALON) THEN                                                 0655.000
  693.         CALL PRINTL(STDOUT, 'Session log: ')                            0656.000
  694.         IF (LOG) THEN                                                   0657.000
  695.           CALL PRINT(STDOUT, 'ON')                                      0658.000
  696.         ELSE                                                            0659.000
  697.           CALL PRINT(STDOUT, 'OFF')                                     0660.000
  698.         ENDIF                                                           0661.000
  699.         IF (LOGFILE .NE. ' ') THEN                                      0662.000
  700.           CALL PRINT( STDOUT, '  Session log file: ')                   0663.000
  701.           CALL PRINT(STDOUT, LOGFILE)                                   0664.000
  702.         ENDIF                                                           0665.000
  703.       ENDIF                                                             0666.000
  704. C                                                                       0667.000
  705. C display current port                                                  0668.000
  706. C                                                                       0669.000
  707.       IF (LOCALON) THEN                                                 0670.000
  708.         CALL PRINTL(STDOUT, 'Selected Communications port: ')           0671.000
  709.         CALL PRINT (STDOUT, COMPORT)                                    0672.000
  710.         CALL PRINTL(STDOUT, 'Connection escape character: ^')           0673.000
  711.         CALL PUTC(STDOUT, CTL(ESCCHR))                                  0674.000
  712.         CALL PRINTL(STDOUT, 'Local echo: ')                             0675.000
  713.         IF (ECHO) THEN                                                  0676.000
  714.           CALL PRINT(STDOUT, 'ON')                                      0677.000
  715.         ELSE                                                            0678.000
  716.           CALL PRINT(STDOUT, 'OFF')                                     0679.000
  717.         ENDIF                                                           0680.000
  718.       ENDIF                                                             0681.000
  719. C                                                                       0682.000
  720. C display packet settings                                               0683.000
  721. C                                                                       0684.000
  722.       CALL PRINTL(STDOUT,'Packet Parameters')                           0685.000
  723.       CALL PRINTL(STDOUT,                                               0686.000
  724.      $   '                    Receive   Send')                          0687.000
  725.       CALL PRINTL(STDOUT,'  Size:             ')                        0688.000
  726.       CALL PUTINT(STDOUT,PACKSIZ,10)                                    0689.000
  727.       CALL PUTINT(STDOUT,SPKSIZ,10)                                     0690.000
  728.       CALL PRINTL(STDOUT,'  Timeout:          ')                        0691.000
  729.       CALL PUTINT(STDOUT,TIMEOUT,10)                                    0692.000
  730.       CALL PUTINT(STDOUT,STIMOUT,10)                                    0693.000
  731.       CALL PRINTL(STDOUT,'  Padding:          ')                        0694.000
  732.       CALL PUTINT(STDOUT,NPAD,10)                                       0695.000
  733.       CALL PUTINT(STDOUT,SPAD,10)                                       0696.000
  734.       CALL PRINTL(STDOUT,'  Pad character:    ')                        0697.000
  735.       CALL PUTC(STDOUT,ICHAR('^'))                                      0698.000
  736.       CALL PUTC(STDOUT,CTL(PADCH))                                      0699.000
  737.       CALL PRINT(STDOUT,'        ')                                     0700.000
  738.       CALL PUTC(STDOUT,ICHAR('^'))                                      0701.000
  739.       CALL PUTC(STDOUT,CTL(SPADCH))                                     0702.000
  740.       CALL PRINTL(STDOUT,'  End-of-Line:      ')                        0703.000
  741.       CALL PUTC(STDOUT,ICHAR('^'))                                      0704.000
  742.       CALL PUTC(STDOUT,CTL(EOLCH))                                      0705.000
  743.       CALL PRINT(STDOUT,'        ')                                     0706.000
  744.       CALL PUTC(STDOUT,ICHAR('^'))                                      0707.000
  745.       CALL PUTC(STDOUT,CTL(SPEOL))                                      0708.000
  746.       CALL PRINTL(STDOUT,'  Control quote:    ')                        0709.000
  747.       CALL PUTC(STDOUT,QUOTECH)                                         0710.000
  748.       CALL PRINT(STDOUT,'         ')                                    0711.000
  749.       CALL PUTC(STDOUT,SPQUOTE)                                         0712.000
  750.       CALL PRINTL(STDOUT,'  Start-of-Packet:  ')                        0713.000
  751.       CALL PUTC(STDOUT,ICHAR('^'))                                      0714.000
  752.       CALL PUTC(STDOUT,CTL(SYNC))                                       0715.000
  753.       CALL PRINT(STDOUT,'        ')                                     0716.000
  754.       CALL PUTC(STDOUT,ICHAR('^'))                                      0717.000
  755.       CALL PUTC(STDOUT,CTL(SNDSYNC))                                    0718.000
  756. C                                                                       0719.000
  757. C display protocol stuff                                                0720.000
  758. C                                                                       0721.000
  759.       CALL PRINTL(STDOUT,'Delay before sending first packet: ')         0722.000
  760.       CALL PUTINT(STDOUT,DELAYFP,1)                                     0723.000
  761.       CALL PRINTL(STDOUT,'Init packet retry count: ')                   0724.000
  762.       CALL PUTINT(STDOUT,MAXRINI,1)                                     0725.000
  763.       CALL PRINTL(STDOUT,'Packet retry count: ')                        0726.000
  764.       CALL PUTINT(STDOUT,MAXRTRY,1)                                     0727.000
  765.       CALL PUTC(STDOUT,NEL)                                             0728.000
  766.       RETURN                                                            0729.000
  767.       END                                                               0730.000
  768.       SUBROUTINE STATUS                                                 0731.000
  769.            IMPLICIT NONE                                                0732.000
  770. C                                                                       0733.000
  771. C= Tell how long last transfer took.                                    0734.000
  772. C                                                                       0735.000
  773.       INCLUDE      K.KERMV                                              0736.000
  774.       INCLUDE      K.KERMD                                              0737.000
  775.       INCLUDE      K.PROTC                                              0738.000
  776.       INCLUDE      K.PACKC                                              0739.000
  777.       INCLUDE      K.TIMEC                                              0740.000
  778. C                                                                       0741.000
  779.       INTEGER      HR,MIN,SEC                                           0742.000
  780.       INTEGER      NSEC                                                 0743.000
  781. C                                                                       0744.000
  782.       LOGICAL      CONFIRM                                              0745.000
  783. C                                                                       0746.000
  784. C confirm the command                                                   0747.000
  785. C                                                                       0748.000
  786.       IF (.NOT. CONFIRM(INPUTFD)) RETURN                                0749.000
  787. C                                                                       0750.000
  788.       CALL PRINTL(STDOUT,'Max characters in packet: ')                  0751.000
  789.       CALL PUTINT(STDOUT, PACKSIZ, 1)                                   0752.000
  790.       CALL PRINT(STDOUT,' received; ')                                  0753.000
  791.       CALL PUTINT(STDOUT, SPKSIZ, 1)                                    0754.000
  792.       CALL PRINT(STDOUT,' sent')                                        0755.000
  793.       CALL PUTC(STDOUT,NEL)                                             0756.000
  794.       IF (ENDTIM .LT. STARTIM) ENDTIM = ENDTIM + 86400                  0757.000
  795.       NSEC = ENDTIM - STARTIM                                           0758.000
  796.       HR = NSEC / 3600                                                  0759.000
  797.       NSEC = NSEC - (HR * 3600)                                         0760.000
  798.       MIN = NSEC / 60                                                   0761.000
  799.       NSEC = NSEC - (MIN * 60)                                          0762.000
  800.       CALL PRINTL(STDOUT,'Number of characters transmitted in ')        0763.000
  801.       IF (HR .GT. 0) THEN                                               0764.000
  802.         CALL PUTINT(STDOUT,HR,1)                                        0765.000
  803.         CALL PRINT(STDOUT,' hours ')                                    0766.000
  804.       ENDIF                                                             0767.000
  805.       IF (MIN .GT. 0 .OR. HR .GT. 0) THEN                               0768.000
  806.         CALL PUTINT(STDOUT,MIN,1)                                       0769.000
  807.         CALL PRINT(STDOUT,' minutes ')                                  0770.000
  808.       ENDIF                                                             0771.000
  809.       CALL PUTINT(STDOUT,NSEC,1)                                        0772.000
  810.       CALL PRINT(STDOUT,' seconds')                                     0773.000
  811.       CALL PRINTL(STDOUT,'             Sent:  ')                        0774.000
  812.       CALL PUTINT(STDOUT, SCHCNT, 20)                                   0775.000
  813.       CALL PRINT(STDOUT,' Overhead:  ')                                 0776.000
  814.       CALL PUTINT(STDOUT, SCHOVRH, 1)                                   0777.000
  815.       CALL PRINTL(STDOUT,'         Received:  ')                        0778.000
  816.       CALL PUTINT(STDOUT, RCHCNT, 20)                                   0779.000
  817.       CALL PRINT(STDOUT,' Overhead:  ')                                 0780.000
  818.       CALL PUTINT(STDOUT, RCHOVRH, 1)                                   0781.000
  819.       CALL PRINTL(STDOUT,'Total Transmitted:  ')                        0782.000
  820.       CALL PUTINT(STDOUT, RCHCNT+SCHCNT, 20)                            0783.000
  821.       CALL PRINT(STDOUT,' Overhead:  ')                                 0784.000
  822.       CALL PUTINT(STDOUT, RCHOVRH+SCHOVRH, 1)                           0785.000
  823.       CALL PUTC(STDOUT, NEL)                                            0786.000
  824.       CALL PRINTL(STDOUT,'Total characters transmitted per sec: ')      0787.000
  825.       CALL PUTINT(STDOUT,(SCHCNT+RCHCNT)/(ENDTIM-STARTIM),1)            0788.000
  826.       CALL PRINTL(STDOUT,'Effective data rate: ')                       0789.000
  827.       CALL PUTINT(STDOUT,((SCHCNT+RCHCNT)-(SCHOVRH+RCHOVRH)) /          0790.000
  828.      $                    (ENDTIM-STARTIM) * 10, 1)                     0791.000
  829.       CALL PRINT(STDOUT,' baud')                                        0792.000
  830.       CALL FLUSH(STDOUT)                                                0793.000
  831.       IF (STATE .NE. C) THEN                                            0794.000
  832.         CALL GETEMSG(PACKET)                                            0795.000
  833.         CALL PRINTL(STDOUT,'?Kermit:  ')                                0796.000
  834.         CALL PUTSTR(STDOUT, PACKET)                                     0797.000
  835.         CALL FLUSH(STDOUT)                                              0798.000
  836.       ENDIF                                                             0799.000
  837. C                                                                       0800.000
  838. C timing                                                                0801.000
  839. C                                                                       0802.000
  840.       IF (LOCALON) THEN                                                 0803.000
  841.         CALL PRINTL(STDOUT, 'Connect timing averages: ')                0804.000
  842.         CALL PRINT(STDOUT, 'GETC ')                                     0805.000
  843.         CALL PUTINT(STDOUT, GETIME/GETCOUNT, 5)                         0806.000
  844.         CALL PRINT(STDOUT, ' PUTC ')                                    0807.000
  845.         CALL PUTINT(STDOUT, PUTIME/PUTCOUNT, 5)                         0808.000
  846.         CALL PRINT(STDOUT, ' WAIT ')                                    0809.000
  847.         CALL PUTINT(STDOUT, WAITIME/WAITCNT, 5)                         0810.000
  848.         CALL PRINT(STDOUT, ' TOTAL ')                                   0811.000
  849.         CALL PUTINT(STDOUT, TOTIME, 5)                                  0812.000
  850.       ENDIF                                                             0813.000
  851.       RETURN                                                            0814.000
  852.       END                                                               0815.000
  853.       SUBROUTINE DBUGCMD                                                0816.000
  854.            IMPLICIT NONE                                                0817.000
  855. C                                                                       0818.000
  856. C= Set the debugging modes.                                             0819.000
  857. C                                                                       0820.000
  858.       INCLUDE      K.KERMD                                              0821.000
  859.       INCLUDE      K.PROTC                                              0822.000
  860.       INCLUDE      K.DBUGC                                              0823.000
  861. C                                                                       0824.000
  862.       INTEGER      DEBUGFN(17)     !file name                           0825.000
  863.       INTEGER      TSIZE           ;PARAMETER (TSIZE = 5)               0826.000
  864.       CHARACTER*10 DBGTYP(TSIZE)                                        0827.000
  865.      $ /'ALL','LOG-FILE','OFF','PACKETS','STATES'/                      0828.000
  866.       INTEGER      INDX                                                 0829.000
  867.       INTEGER      IRET                                                 0830.000
  868. C                                                                       0831.000
  869.       INTEGER      MATCH                                                0832.000
  870.       LOGICAL      CONFIRM                                              0833.000
  871.       INTEGER      OPEN                                                 0834.000
  872. C                                                                       0835.000
  873.       INDX = MATCH(DBGTYP, TSIZE, .FALSE.)                              0836.000
  874.       IF (INDX .LE. 0) RETURN                                           0837.000
  875.       GOTO (10, 20, 30, 40    ) INDX                                    0838.000
  876. C                                                                       0839.000
  877.  10   CONTINUE                     !set all debug modes                 0840.000
  878.       DEBUG = .TRUE.                                                    0841.000
  879.       GOTO 100                                                          0842.000
  880. C                                                                       0843.000
  881.  20   CONTINUE                     !set logfile                         0844.000
  882.       CALL SETVAL(DEBUGFN, 'S', IRET, 16, 0, 0,                         0845.000
  883.      $       'Debug output logfile specification', .TRUE.)              0846.000
  884.       IF (IRET .EQ. OK) THEN                                            0847.000
  885.         CALL AS2DPC(DEBUGFN, DBGFILE)                                   0848.000
  886.         IF (DBGFD .NE. 0) THEN                                          0849.000
  887.           CALL CLOSE(DBGFD)                                             0850.000
  888.           DBGFD = 0                                                     0851.000
  889.         ENDIF                                                           0852.000
  890.         GOTO 100                                                        0853.000
  891.       ENDIF                                                             0854.000
  892.       RETURN                                                            0855.000
  893. C                                                                       0856.000
  894.  30   CONTINUE                     !turn off all debugging              0857.000
  895.         DEBUG = .FALSE.                                                 0858.000
  896.         RETURN                                                          0859.000
  897. C                                                                       0860.000
  898.  40   CONTINUE                     !toggle debug packets                0861.000
  899.         IF (.NOT. CONFIRM(INPUTFD))RETURN                               0862.000
  900.         DEBUG(DBGPACK) = .NOT. DEBUG(DBGPACK)                           0863.000
  901.         DEBUG(DBGON) = DEBUG(DBGPACK) .OR. DEBUG(DBGSTAT)               0864.000
  902.         DEBUG(DBGSTAT) = .NOT. DEBUG(DBGSTAT)                           0865.000
  903.         DEBUG(DBGON) = DEBUG(DBGPACK) .OR. DEBUG(DBGSTAT)               0866.000
  904.         GOTO 100                                                        0867.000
  905. C                                                                       0868.000
  906.  100  CONTINUE                     !open the debug file in not done     0869.000
  907.         IF (DBGFD .EQ. 0) THEN                                          0870.000
  908.           DBGFD = OPEN(DBGFILE, 'W')                                    0871.000
  909.         ENDIF                                                           0872.000
  910.       RETURN                                                            0873.000
  911.       END                                                               0874.000
  912.       SUBROUTINE SETPACK(ATTR)                                          0875.000
  913.            IMPLICIT NONE                                                0876.000
  914.            INTEGER  ATTR(12)       !attributes                          0877.000
  915. C                                                                       0878.000
  916. C= Set packet send or receive attributes.                               0879.000
  917. C                                                                       0880.000
  918. C  Setpack will wet the attributes of the passed attribute list.        0881.000
  919. C  This subroutine will set the appropriate packet parameter.           0882.000
  920. C  The parameter to set is passed in an array and is very order         0883.000
  921. C  dependent.  See common block /packet/ for the ordering.              0884.000
  922. C  Note that send and receive parameter ordering and storage            0885.000
  923. C  size in the common block are identical.  Keep it that way!           0886.000
  924. C                                                                       0887.000
  925.       INCLUDE      K.KERMD                                              0888.000
  926. C                                                                       0889.000
  927.       INTEGER      TSIZE           ;PARAMETER (TSIZE=7)                 0890.000
  928.       CHARACTER*10 ATTRTYP(TSIZE)  !commands                            0891.000
  929.      $ /'EOL','PACKLEN','PADCHR','PADLEN','QUOTECHR',                   0892.000
  930.      $  'SYNCCHR','TIMEOUT'/                                            0893.000
  931.       INTEGER      INDX                                                 0894.000
  932.       CHARACTER*63 HLPASCH/                                             0895.000
  933.      $'Decimal, octal (O), or hexidecimal (H) code for ASCII character' 0896.000
  934.      $/                                                                 0897.000
  935. C                                                                       0898.000
  936.       INTEGER      MATCH                                                0899.000
  937.       LOGICAL      CONFIRM                                              0900.000
  938. C                                                                       0901.000
  939.       INDX = MATCH(ATTRTYP, TSIZE, .FALSE.)                             0902.000
  940.       IF (INDX .LE. 0) RETURN                                           0903.000
  941.       GOTO (10, 20, 30, 40, 50, 60, 70) INDX                            0904.000
  942. C                                                                       0905.000
  943.  10   CONTINUE                     !set eol character                   0906.000
  944.       CALL SETVAL(ATTR(5), 'I',1,31,127,127,HLPASCH,.TRUE.)             0907.000
  945.       RETURN                                                            0908.000
  946. C                                                                       0909.000
  947.  20   CONTINUE                     !set maximum packet length           0910.000
  948.       CALL SETVAL(ATTR(1), 'I',20,1000,20,1000,                         0911.000
  949.      $ 'Maximum packet length', .TRUE.)                                 0912.000
  950.       RETURN                                                            0913.000
  951. C                                                                       0914.000
  952.  30   CONTINUE                     !set pad character                   0915.000
  953.       CALL SETVAL(ATTR(4), 'I', 0, 31, 127, 127, HLPASCH, .TRUE.)       0916.000
  954.       RETURN                                                            0917.000
  955. C                                                                       0918.000
  956.  40   CONTINUE                     !set pad length                      0919.000
  957.       CALL SETVAL(ATTR(3), 'I', 0, 1000, 0, 1000,                       0920.000
  958.      $    'Number of pad characters to use', .TRUE.)                    0921.000
  959.       RETURN                                                            0922.000
  960. C                                                                       0923.000
  961.  50   CONTINUE                     !set quote character                 0924.000
  962.       CALL SETVAL(ATTR(6), 'I',33, 62,  97, 126, HLPASCH, .TRUE.)       0925.000
  963.       RETURN                                                            0926.000
  964. C                                                                       0927.000
  965.  60   CONTINUE                     !set sync character                  0928.000
  966.       CALL SETVAL(ATTR(12),'I', 0,127,   0, 127, HLPASCH, .TRUE.)       0929.000
  967.       RETURN                                                            0930.000
  968. C                                                                       0931.000
  969.  70   CONTINUE                     !set timeout value                   0932.000
  970.       CALL SETVAL(ATTR(2), 'I', 0, 1000, 0, 1000,                       0933.000
  971.      $    'Number of seconds to wait before timeout', .TRUE.)           0934.000
  972.       RETURN                                                            0935.000
  973.       END                                                               0936.000
  974.       SUBROUTINE PORTCMD                                                0937.000
  975.            IMPLICIT NONE                                                0938.000
  976. C                                                                       0939.000
  977. C= Selects the port to be used.                                         0940.000
  978. C                                                                       0941.000
  979.       INCLUDE      K.KERMD                                              0942.000
  980.       INCLUDE      K.PROTC                                              0943.000
  981. C                                                                       0944.000
  982.       INTEGER      PORTSTR(7)      !port string to read                 0945.000
  983.       CHARACTER*6  PORTNM          !char device name                    0946.000
  984.       CHARACTER*6  PORTWR          !write port                          0947.000
  985.       INTEGER      IRET            !error code                          0948.000
  986.       INTEGER      INEW            !new input                           0949.000
  987.       INTEGER      ONEW            !new output                          0950.000
  988. C                                                                       0951.000
  989.       INTEGER      OPEN            !open port                           0952.000
  990.       INTEGER      XTOI            !hex ascii to integer                0953.000
  991.       CHARACTER*4  ITOX            !integer to hex ascii                0954.000
  992. C                                                                       0955.000
  993.       CALL SETVAL(PORTSTR, 'S', IRET, 6, 0, 0,                          0956.000
  994.      $       'Select communication port', .TRUE.)                       0957.000
  995.       IF (IRET .EQ. OK) THEN                                            0958.000
  996.         CALL AS2DPC(PORTSTR, PORTNM)                                    0959.000
  997. C                                                                       0960.000
  998.         IF (PORTNM .EQ. COMPORT) THEN      !ignore no change            0961.000
  999.         ELSE                                                            0962.000
  1000. C                                                                       0963.000
  1001. C now open                                                              0964.000
  1002. C                                                                       0965.000
  1003.           IF (PORTNM .EQ. 'UT') THEN                                    0966.000
  1004.             IF (IFD .NE. STDIN) CALL CLOSE(IFD)                         0967.000
  1005.             IF (OFD .NE. STDOUT) CALL CLOSE(OFD)                        0968.000
  1006.             IFD = STDIN                                                 0969.000
  1007.             OFD = STDOUT                                                0970.000
  1008.             COMPORT = PORTNM                                            0971.000
  1009.           ELSE                                                          0972.000
  1010.             INEW = OPEN('@'//PORTNM,'R')                                0973.000
  1011.             IF (INEW .LE. 0) THEN                                       0974.000
  1012.               CALL PRINTL(STDOUT, 'Failed to open read channel, code= ')0975.000
  1013.               CALL PUTINT(STDOUT, -INEW, 3)                             0976.000
  1014.               RETURN                                                    0977.000
  1015.             ENDIF                                                       0978.000
  1016.             PORTWR = PORTNM(1:2)                                        0979.000
  1017.             PORTWR(3:6) = ITOX(XTOI(PORTNM(3:6))+8)                     0980.000
  1018.             ONEW = OPEN('@'//PORTWR,'W')                                0981.000
  1019.             IF (ONEW .LE. 0) THEN                                       0982.000
  1020.               CALL CLOSE(INEW)                                          0983.000
  1021.               CALL PRINTL(STDOUT,'Failed to open write channel,code= ') 0984.000
  1022.               CALL PUTINT(STDOUT, -ONEW, 3)                             0985.000
  1023.               RETURN                                                    0986.000
  1024.             ENDIF                                                       0987.000
  1025.             IF (IFD .NE. STDIN) CALL CLOSE(IFD)                         0988.000
  1026.             IF (OFD .NE. STDOUT) CALL CLOSE(OFD)                        0989.000
  1027.             COMPORT = PORTNM                                            0990.000
  1028.             IFD = INEW                                                  0991.000
  1029.             OFD = ONEW                                                  0992.000
  1030.           ENDIF                                                         0993.000
  1031.         ENDIF                                                           0994.000
  1032.       ENDIF                                                             0995.000
  1033.       RETURN                                                            0996.000
  1034.       END                                                               0997.000
  1035.       SUBROUTINE CONNECT                                                0998.000
  1036.            IMPLICIT NONE                                                0999.000
  1037. C                                                                       1000.000
  1038. C= Connects stdin/stdout to in/out port                                 1001.000
  1039. C                                                                       1002.000
  1040.       INCLUDE      K.KERMD                                              1003.000
  1041.       INCLUDE      K.PROTC                                              1004.000
  1042.       INCLUDE      K.TIMEC                                              1005.000
  1043. C                                                                       1006.000
  1044.       INTEGER      BELL            ;PARAMETER (BELL = X'07')            1007.000
  1045.       INTEGER      ZERO            ;PARAMETER (ZERO = X'30')            1008.000
  1046.       INTEGER      BREAK           ;PARAMETER (BREAK = X'42')           1009.000
  1047.       INTEGER      CLOSE           ;PARAMETER (CLOSE = X'43')           1010.000
  1048.       INTEGER      QUIT            ;PARAMETER (QUIT = X'51')            1011.000
  1049.       INTEGER      RESUME          ;PARAMETER (RESUME=X'52')            1012.000
  1050.       INTEGER      LOWA            ;PARAMETER (LOWA = X'61')            1013.000
  1051.       INTEGER      LOWZ            ;PARAMETER (LOWZ = X'7A')            1014.000
  1052.       INTEGER      LOW2UP          ;PARAMETER (LOW2UP = X'20')          1015.000
  1053.       INTEGER      INCHR           !char from stdin                     1016.000
  1054.       INTEGER      TTCHR           !char from port                      1017.000
  1055.       CHARACTER*10 CNUM            !character                           1018.000
  1056.       CHARACTER*10 CNUM2                                                1019.000
  1057.       INTEGER      STIME                                                1020.000
  1058.       INTEGER      FTIME                                                1021.000
  1059. CLT   LOGICAL      PAUSER                                          !XXX 1022.000
  1060. CLT   LOGICAL      DUMPER                                          !XXX 1023.000
  1061. C                                                                       1024.000
  1062.       INTEGER      GETC            !get character                       1025.000
  1063.       LOGICAL      CONFIRM         !confirm connect                     1026.000
  1064.       INTEGER      CTL             !convert ctl to non-control          1027.000
  1065.       CHARACTER*(*)ITOA                                                 1028.000
  1066. CLT   LOGICAL      OPTION                                          !XXX 1029.000
  1067. C                                                                       1030.000
  1068.       IF (.NOT. CONFIRM(INPUTFD)) RETURN                                1031.000
  1069. CLT   PAUSER = OPTION (1)                                          !XXX 1032.000
  1070. CLT   DUMPER = OPTION (2)                                          !XXX 1033.000
  1071. C                                                                       1034.000
  1072.       IF (IFD .EQ. STDIN .OR. OFD .EQ. STDOUT) THEN                     1035.000
  1073.         CALL PRINTL(STDOUT, '?No external port selected.')              1036.000
  1074.         RETURN                                                          1037.000
  1075.       ENDIF                                                             1038.000
  1076. C                                                                       1039.000
  1077.       CALL PUTC(STDOUT, NEL)                                            1040.000
  1078.       CALL PRINT(STDOUT, '[Connecting to port, type ^')                 1041.000
  1079.       CALL PUTC(STDOUT, CTL(ESCCHR))                                    1042.000
  1080.       CALL PRINT(STDOUT, ' C to return to local]')                      1043.000
  1081.       CALL PUTC(STDOUT, NEL)                                            1044.000
  1082.       CALL PUTC(STDOUT, NEL)                                            1045.000
  1083. C                                                                       1046.000
  1084.       CALL STTY(STDIN, 'BINARY', ON)                                    1047.000
  1085.       CALL STTY(STDIN, 'SIZE', 1)                                       1048.000
  1086.       CALL STTY(STDOUT, 'SIZE', 1)                                      1049.000
  1087.       CALL STTY(STDIN, 'NOWAIT', ON)                                    1050.000
  1088.       CALL STTY(STDOUT, 'NOWAIT', ON)                                   1051.000
  1089.       CALL STTY(IFD, 'BINARY', ON)                                      1052.000
  1090.       CALL STTY(IFD, 'SIZE', 1)                                         1053.000
  1091.       CALL STTY(OFD, 'SIZE', 1)                                         1054.000
  1092.       CALL STTY(IFD, 'NOWAIT', ON)                                      1055.000
  1093.       CALL STTY(OFD, 'NOWAIT', ON)                                      1056.000
  1094.       GETIME = PUTIME = 0                                               1057.000
  1095.       GETCOUNT = PUTCOUNT = 0                                           1058.000
  1096.       WAITIME = WAITCNT = 0                                             1059.000
  1097.       CALL MSEC(TOTIME)                                                 1060.000
  1098. C                                                                       1061.000
  1099.       DO  BEGIN                                                         1062.000
  1100. CLT     IF (DUMPER) CALL DUMPF('BEGIN')                            !XXX 1063.000
  1101. CLT     IF (PAUSER) PAUSE BEGIN                                    !XXX 1064.000
  1102.         CALL MSEC(STIME)                                                1065.000
  1103.         INCHR = GETC(STDIN, INCHR)                                      1066.000
  1104.         CALL MSEC(FTIME)                                                1067.000
  1105. CLT     IF (DUMPER) CALL DUMPF('AFTER STDIN')                      !XXX 1068.000
  1106.         GETCOUNT = GETCOUNT + 1                                         1069.000
  1107.         GETIME = FTIME - STIME + GETIME                                 1070.000
  1108.         CALL MSEC(STIME)                                                1071.000
  1109.         TTCHR = GETC(IFD, TTCHR)                                        1072.000
  1110.         CALL MSEC(FTIME)                                                1073.000
  1111.         GETCOUNT = GETCOUNT + 1                                         1074.000
  1112.         GETIME = FTIME - STIME + GETIME                                 1075.000
  1113. C                                                                       1076.000
  1114. CLT     IF (INCHR .NE. ERROR .OR. TTCHR .NE. ERROR) THEN                1077.000
  1115. CLT       CNUM = ITOA(INCHR)                                            1078.000
  1116. CLT       CNUM2 = ITOA(TTCHR)                                           1079.000
  1117. CLT       CALL DISPLAY('KERMIT/CONNECT - PARSE CHARACTER'//CNUM//CNUM2) 1080.000
  1118. CLT     ENDIF                                                           1081.000
  1119.         IF (INCHR .EQ. EOF) THEN                                        1082.000
  1120. CLT       CALL DISPLAY('KERMIT/CONNECT - EOF')                          1083.000
  1121.           LEAVE                                                         1084.000
  1122.         ELSE IF (INCHR .EQ. ERROR) THEN                                 1085.000
  1123.           CONTINUE                                                      1086.000
  1124.         ELSE IF (INCHR .EQ. ESCCHR) THEN                                1087.000
  1125.  10       CONTINUE                                                      1088.000
  1126. CLT       CALL DISPLAY('KERMIT/CONNECT - WAIT FOR NON-ERROR')           1089.000
  1127.           DO WHILE (GETC(STDIN, INCHR) .EQ. ERROR)                      1090.000
  1128.             CALL IOWAIT(50 )                                            1091.000
  1129.           ENDDO                                                         1092.000
  1130.           IF (INCHR .GE. LOWA .AND. INCHR .LE. LOWZ)                    1093.000
  1131.      $       INCHR = INCHR - LOW2UP                                     1094.000
  1132.           CNUM = ITOA(INCHR)                                            1095.000
  1133. CLT       CALL DISPLAY('KERMIT/CONNECT - NON-ERROR ='//CNUM)            1096.000
  1134.           IF (INCHR .EQ. CLOSE) THEN                                    1097.000
  1135.             LEAVE                                                       1098.000
  1136.           ELSE IF (INCHR .EQ. BREAK) THEN                               1099.000
  1137.             CALL SENDBRK(OFD)                                           1100.000
  1138.           ELSE IF (INCHR .EQ. ZERO) THEN                                1101.000
  1139.             CALL PUTC(OFD, 0)                                           1102.000
  1140.           ELSE IF (INCHR .EQ. QUIT) THEN                                1103.000
  1141.             LOG = .FALSE.                                               1104.000
  1142.           ELSE IF (INCHR .EQ. RESUME) THEN                              1105.000
  1143.             IF (FFD .NE. 0) LOG = .TRUE.                                1106.000
  1144.           ELSE IF (INCHR .EQ. ESCCHR) THEN                              1107.000
  1145.             CALL PUTC(OFD, ESCCHR)                                      1108.000
  1146.           ELSE IF (INCHR .EQ. QMARK) THEN                               1109.000
  1147.             CALL STTY(STDOUT, 'SIZE', -1)                               1110.000
  1148.             CALL STTY(STDOUT, 'NOWAIT', OFF)                            1111.000
  1149.             CALL PRINTL(STDOUT,'0   Send NULL')                         1112.000
  1150.             CALL PRINTL(STDOUT,'B   Send BREAK')                        1113.000
  1151.             CALL PRINTL(STDOUT,'C   Close connection')                  1114.000
  1152.             CALL PRINTL(STDOUT,'Q   Quit logging')                      1115.000
  1153.             CALL PRINTL(STDOUT,'R   Resume logging')                    1116.000
  1154.             CALL PUTC(STDOUT, NEL)                                      1117.000
  1155.             CALL PRINT(STDOUT, '^')                                     1118.000
  1156.             CALL PUTC(STDOUT, CTL(ESCCHR))                              1119.000
  1157.             CALL PRINT(STDOUT,'  Send this character')                  1120.000
  1158.             CALL PRINTL(STDOUT,'?   This message')                      1121.000
  1159.             CALL PRINTL(STDOUT,'Command>')                              1122.000
  1160.             CALL STTY(STDOUT, 'NOWAIT', ON)                             1123.000
  1161.             CALL STTY(STDOUT, 'SIZE', 1)                                1124.000
  1162.             GOTO 10                                                     1125.000
  1163.           ELSE                                                          1126.000
  1164.             CALL PUTC(STDOUT, BELL)                                     1127.000
  1165.           ENDIF                                                         1128.000
  1166.         ELSE                                                            1129.000
  1167. CLT       CALL DISPLAY('KERMIT/CONNECT - PUTC OFD')                     1130.000
  1168.           CALL MSEC(STIME)                                              1131.000
  1169.           CALL PUTC(OFD, INCHR)                                         1132.000
  1170.           CALL MSEC(FTIME)                                              1133.000
  1171.           PUTCOUNT = PUTCOUNT + 1                                       1134.000
  1172.           PUTIME = PUTIME + FTIME - STIME                               1135.000
  1173.           IF (ECHO) CALL PUTC(STDOUT, INCHR)                            1136.000
  1174.         ENDIF                                                           1137.000
  1175. C                                                                       1138.000
  1176.         IF (TTCHR .EQ. EOF) THEN                                        1139.000
  1177.           CALL PRINTL(STDOUT, '?EOF on port connection')                1140.000
  1178.           LEAVE                                                         1141.000
  1179.         ELSE IF (TTCHR .EQ. ERROR) THEN                                 1142.000
  1180.           CONTINUE                                                      1143.000
  1181.         ELSE                                                            1144.000
  1182. CLT       CALL DISPLAY('KERMIT/CONNECT - PUTC STDOUT')                  1145.000
  1183.           CALL MSEC(STIME)                                              1146.000
  1184.           CALL PUTC(STDOUT, TTCHR)                                      1147.000
  1185.           CALL MSEC(FTIME)                                              1148.000
  1186.           PUTIME = PUTIME + FTIME - STIME                               1149.000
  1187.           PUTCOUNT = PUTCOUNT + 1                                       1150.000
  1188.           IF (LOG) THEN                                                 1151.000
  1189.             IF (TTCHR .GE. BLANK .AND. TTCHR .LT. DEL) THEN             1152.000
  1190.               CALL PUTC(LFD, TTCHR)                                     1153.000
  1191.             ELSE IF (TTCHR .EQ. CR) THEN                                1154.000
  1192.               CALL PUTC(LFD, NEL)                                       1155.000
  1193.             ENDIF                                                       1156.000
  1194.           ENDIF                                                         1157.000
  1195.         ENDIF                                                           1158.000
  1196. C                                                                       1159.000
  1197.         CALL MSEC(STIME)                                                1160.000
  1198.         IF (TTCHR .EQ. ERROR .AND. INCHR .EQ. ERROR) THEN               1161.000
  1199.           CALL IOWAIT(50 )                                              1162.000
  1200.         ENDIF                                                           1163.000
  1201.         CALL MSEC(FTIME)                                                1164.000
  1202.         WAITIME = WAITIME + FTIME - STIME                               1165.000
  1203.         WAITCNT = WAITCNT + 1                                           1166.000
  1204. C                                                                       1167.000
  1205.       ENDDO                                                             1168.000
  1206. CLT   IF (DUMPER) CALL DUMPF('ENDDO')                              !XXX 1169.000
  1207. CLT   IF (PAUSER) PAUSE ENDDO                                      !XXX 1170.000
  1208. C                                                                       1171.000
  1209.       CALL MSEC(FTIME)                                                  1172.000
  1210.       TOTIME = FTIME - TOTIME                                           1173.000
  1211.       CALL FLUSH(IFD)                                                   1174.000
  1212.       CALL FLUSH(STDIN)                                                 1175.000
  1213.       CALL STTY(STDIN, 'BINARY', OFF)                                   1176.000
  1214.       CALL STTY(STDIN, 'SIZE', 80)                                      1177.000
  1215.       CALL STTY(STDOUT, 'SIZE', -1)                                     1178.000
  1216.       CALL STTY(STDIN, 'NOWAIT', OFF)                                   1179.000
  1217.       CALL STTY(STDOUT, 'NOWAIT', OFF)                                  1180.000
  1218.       CALL STTY(IFD, 'BINARY', OFF)                                     1181.000
  1219.       CALL STTY(IFD, 'SIZE', -1)                                        1182.000
  1220.       CALL STTY(OFD, 'SIZE', -1)                                        1183.000
  1221.       CALL STTY(IFD, 'NOWAIT', OFF)                                     1184.000
  1222.       CALL STTY(OFD, 'NOWAIT', OFF)                                     1185.000
  1223. CLT   IF (DUMPER) CALL DUMPF('EXIT CONNECT')                       !XXX 1186.000
  1224. C                                                                       1187.000
  1225.       RETURN                                                            1188.000
  1226.       END                                                               1189.000
  1227.       SUBROUTINE LOGGER                                                 1190.000
  1228.            IMPLICIT NONE                                                1191.000
  1229. C                                                                       1192.000
  1230. C= Performs log command                                                 1193.000
  1231. C                                                                       1194.000
  1232.       INCLUDE      K.KERMD                                              1195.000
  1233.       INCLUDE      K.PROTC                                              1196.000
  1234. C                                                                       1197.000
  1235.       INTEGER      NCMD            ;PARAMETER (NCMD = 3)                1198.000
  1236.       CHARACTER*8  CMD(NCMD)                                            1199.000
  1237.      $   /'LOG-FILE', 'OFF', 'ON'/                                      1200.000
  1238.       INTEGER      IRET                                                 1201.000
  1239.       INTEGER      TSTR(17)     !temp file string                       1202.000
  1240.       INTEGER      INDX                                                 1203.000
  1241. C                                                                       1204.000
  1242.       INTEGER      MATCH                                                1205.000
  1243.       INTEGER      OPEN            !open file                           1206.000
  1244. C                                                                       1207.000
  1245.       INDX = MATCH(CMD, NCMD, .FALSE.)                                  1208.000
  1246.       IF (INDX .LE. 0) RETURN                                           1209.000
  1247. C                                                                       1210.000
  1248.       GOTO (10, 20, 30) INDX                                            1211.000
  1249. C                                                                       1212.000
  1250.  10   CONTINUE                                                          1213.000
  1251.         CALL SETVAL(TSTR, 'S', IRET, 16, 0, 0,                          1214.000
  1252.      $       'Session log filename', .TRUE.)                            1215.000
  1253.         IF (IRET .EQ. OK) THEN                                          1216.000
  1254.           CALL AS2DPC(TSTR, LOGFILE)                                    1217.000
  1255.           LFD = OPEN(LOGFILE, 'W')                                      1218.000
  1256.           IF (LFD .LE. 0) THEN                                          1219.000
  1257.             CALL PRINTL(STDOUT, '?Failed to open session log file ')    1220.000
  1258.             CALL PUTINT(STDOUT, -LFD, 3)                                1221.000
  1259.             LOG = .FALSE.                                               1222.000
  1260.           ELSE                                                          1223.000
  1261.             LOG = .TRUE.                                                1224.000
  1262.           ENDIF                                                         1225.000
  1263.         ENDIF                                                           1226.000
  1264.         GOTO 100                                                        1227.000
  1265. C                                                                       1228.000
  1266.  20   CONTINUE                                                          1229.000
  1267.         LOG = .FALSE.                                                   1230.000
  1268.         IF (LFD .GT. 0) CALL CLOSE(LFD)                                 1231.000
  1269.         GOTO 100                                                        1232.000
  1270. C                                                                       1233.000
  1271.  30   CONTINUE                                                          1234.000
  1272.         IF (LFD .EQ. 0) THEN                                            1235.000
  1273.           LFD = OPEN(LOGFILE, 'W')                                      1236.000
  1274.           IF (LFD .EQ. ERROR)                                           1237.000
  1275.      $      CALL PRINTL(STDOUT, '?Failed to open session log file')     1238.000
  1276.         ENDIF                                                           1239.000
  1277.         LOG = LFD .GT. 0                                                1240.000
  1278.         GOTO 100                                                        1241.000
  1279. C                                                                       1242.000
  1280.  100  CONTINUE                                                          1243.000
  1281.       RETURN                                                            1244.000
  1282.       END                                                               1245.000
  1283.       SUBROUTINE FINISH                                                 1246.000
  1284.           IMPLICIT NONE                                                 1247.000
  1285. C                                                                       1248.000
  1286. C= Sends finish command to target port                                  1249.000
  1287. C                                                                       1250.000
  1288.       INCLUDE      K.KERMD                                              1251.000
  1289.       INCLUDE      K.PROTC                                              1252.000
  1290.       INCLUDE      K.PACKC                                              1253.000
  1291. C                                                                       1254.000
  1292.       INTEGER      PTYP, LEN, NUM                                       1255.000
  1293. C                                                                       1256.000
  1294.       LOGICAL      CONFIRM                                              1257.000
  1295.       INTEGER      RDPACK                                               1258.000
  1296. C                                                                       1259.000
  1297.       IF (.NOT. CONFIRM(INPUTFD)) RETURN                                1260.000
  1298. C                                                                       1261.000
  1299.       IF (IFD .EQ. STDIN ) THEN                                         1262.000
  1300.         CALL PRINTL(STDOUT, '?No communication port selected.')         1263.000
  1301.         RETURN                                                          1264.000
  1302.       ENDIF                                                             1265.000
  1303. C                                                                       1266.000
  1304.       CALL STTY(IFD, 'BINARY', ON)                                      1267.000
  1305.       CALL STTY(IFD, 'TIMEOUT', TIMEOUT)                                1268.000
  1306.       CALL STTY(IFD, 'NOWAIT', ON)                                      1269.000
  1307.       NUMTRY = 0                                                        1270.000
  1308.       PACKET(1) = F                !f is constant , fort codes as halfw.1271.000
  1309.       DO WHILE (NUMTRY .LE. MAXTRY)                                     1272.000
  1310.         NUMTRY = NUMTRY + 1                                             1273.000
  1311.         CALL SNDPACK(G, 0, 1, PACKET)                                   1274.000
  1312.         PTYP = RDPACK(LEN, NUM, RECPACK)                                1275.000
  1313.         IF (PTYP .EQ. Y) LEAVE                                          1276.000
  1314.       ENDDO                                                             1277.000
  1315.       CALL STTY(IFD, 'NOWAIT', OFF)                                     1278.000
  1316.       CALL STTY(IFD, 'TIMEOUT', 0)                                      1279.000
  1317.       CALL STTY(IFD, 'BINARY', OFF)                                     1280.000
  1318.       RETURN                                                            1281.000
  1319.       END                                                               1282.000
  1320.       SUBROUTINE BYE                                                    1283.000
  1321.            IMPLICIT NONE                                                1284.000
  1322. C                                                                       1285.000
  1323. C= Sends bye to remote and exits kermit                                 1286.000
  1324. C                                                                       1287.000
  1325.       INCLUDE      K.KERMD                                              1288.000
  1326.       INCLUDE      K.PROTC                                              1289.000
  1327.       INCLUDE      K.PACKC                                              1290.000
  1328. C                                                                       1291.000
  1329.                                                                         1292.000
  1330.       INTEGER      PTYP            !packet type                         1293.000
  1331.       INTEGER      LEN, NUM                                             1294.000
  1332. C                                                                       1295.000
  1333.       LOGICAL      CONFIRM                                              1296.000
  1334.       INTEGER      RDPACK                                               1297.000
  1335. C                                                                       1298.000
  1336.       IF (.NOT. CONFIRM(INPUTFD)) RETURN                                1299.000
  1337. C                                                                       1300.000
  1338.       CALL STTY(IFD, 'BINARY', ON)                                      1301.000
  1339.       CALL STTY(IFD, 'TIMEOUT', TIMEOUT)                                1302.000
  1340.       CALL STTY(IFD, 'NOWAIT', ON)                                      1303.000
  1341.       IF (IFD .EQ. STDIN ) THEN                                         1304.000
  1342.         CALL PRINTL(STDOUT, '?No communication port selected.')         1305.000
  1343.         RETURN                                                          1306.000
  1344.       END IF                                                            1307.000
  1345. C                                                                       1308.000
  1346.       PACKET(1) = L                                                     1309.000
  1347.       NUMTRY = 0                                                        1310.000
  1348.       DO WHILE (NUMTRY .LE. MAXTRY)                                     1311.000
  1349.         NUMTRY = NUMTRY + 1                                             1312.000
  1350.         CALL SNDPACK(G, 0, 1, PACKET)                                   1313.000
  1351.         PTYP = RDPACK(LEN, NUM, RECPACK)                                1314.000
  1352.         IF (PTYP .EQ. Y) LEAVE                                          1315.000
  1353.       ENDDO                                                             1316.000
  1354.       CALL STTY(IFD, 'NOWAIT', OFF)                                     1317.000
  1355.       CALL STTY(IFD, 'TIMEOUT', 0)                                      1318.000
  1356.       CALL STTY(IFD, 'BINARY', OFF)                                     1319.000
  1357.       CALL EXITPGM                                                      1320.000
  1358.       END                                                               1321.000
  1359.       SUBROUTINE GETFROM                                                1322.000
  1360.            IMPLICIT NONE                                                1323.000
  1361. C                                                                       1324.000
  1362. C= Get file from remote server                                          1325.000
  1363. C                                                                       1326.000
  1364.       INCLUDE      K.KERMD                                              1327.000
  1365.       INCLUDE      K.PROTC                                              1328.000
  1366.       INCLUDE      K.PACKC                                              1329.000
  1367. C                                                                       1330.000
  1368.       INTEGER      IRET            !return status                       1331.000
  1369.       INTEGER      PTYP            !packet type                         1332.000
  1370.       INTEGER      LEN                                                  1333.000
  1371.       INTEGER      NUM                                                  1334.000
  1372. C                                                                       1335.000
  1373.       INTEGER      SLEN            !length of string                    1336.000
  1374.       INTEGER      RECEIVE                                              1337.000
  1375.       INTRINSIC    MOD                                                  1338.000
  1376.       INTEGER      RDPACK          !read packet                         1339.000
  1377.       INTEGER      SNDPAR          !pack send parameters                1340.000
  1378. C                                                                       1341.000
  1379.       CALL SETVAL(FILESTR, 'S', IRET, 16, 0, 0,                         1342.000
  1380.      $   'Filename to get', .TRUE.)                                     1343.000
  1381.       IF (IRET .EQ. ERROR) RETURN                                       1344.000
  1382. C                                                                       1345.000
  1383.       IF (IFD .EQ. STDIN) THEN                                          1346.000
  1384.         CALL PRINTL(STDOUT, '?No communication port selected.')         1347.000
  1385.         RETURN                                                          1348.000
  1386.       END IF                                                            1349.000
  1387. C                                                                       1350.000
  1388.       IF (INPUTFD .NE. STDIN .AND. OFD .NE. STDOUT) THEN                1351.000
  1389.         CALL PRINTL(STDOUT, 'Getting file ')                            1352.000
  1390.         CALL PUTSTR(STDOUT, FILESTR)                                    1353.000
  1391.         CALL FLUSH(STDOUT)                                              1354.000
  1392.       ENDIF                                                             1355.000
  1393. C                                                                       1356.000
  1394.       CALL STTY(IFD, 'BINARY', ON)                                      1357.000
  1395.       CALL STTY(IFD, 'TIMEOUT', TIMEOUT)                                1358.000
  1396.       CALL STTY(IFD, 'NOWAIT', ON)                                      1359.000
  1397. C                                                                       1360.000
  1398.       NUMTRY = 0                                                        1361.000
  1399.       DO WHILE (NUMTRY .LE. MAXRINI)                                    1362.000
  1400.         NUMTRY = NUMTRY + 1                                             1363.000
  1401.         CALL SNDPACK(R, 0, SLEN(FILESTR), FILESTR)                      1364.000
  1402.         PTYP = RDPACK(LEN, NUM, RECPACK)                                1365.000
  1403.         IF (PTYP .EQ. S) THEN                                           1366.000
  1404.           PACKNUM = NUM                                                 1367.000
  1405.           CALL RDPARAM(RECPACK)                                         1368.000
  1406.           LEN = SNDPAR(PACKET)                                          1369.000
  1407.           CALL SNDPACK(Y, PACKNUM, LEN, PACKET)                         1370.000
  1408.           NUMTRY = 0                                                    1371.000
  1409.           PACKNUM = MOD(PACKNUM+1, 64)                                  1372.000
  1410.           IF (RECEIVE(F) .EQ. OK) THEN                                  1373.000
  1411.             CALL PRINTL(STDOUT, 'Receive complete.')                    1374.000
  1412.           ELSE                                                          1375.000
  1413.             CALL PRINTL(STDOUT, 'Receive failed.')                      1376.000
  1414.           ENDIF                                                         1377.000
  1415.           LEAVE                                                         1378.000
  1416.         ENDIF                                                           1379.000
  1417.       ENDDO                                                             1380.000
  1418.       CALL STTY(IFD, 'NOWAIT', OFF)                                     1381.000
  1419.       CALL STTY(IFD, 'TIMEOUT', 0)                                      1382.000
  1420.       CALL STTY(IFD, 'BINARY', OFF)                                     1383.000
  1421.       RETURN                                                            1384.000
  1422.       END                                                               1385.000
  1423.       SUBROUTINE TAKE                                                   1386.000
  1424.            IMPLICIT NONE                                                1387.000
  1425. C                                                                       1388.000
  1426. C Provides a means to redirect input to file.                           1389.000
  1427. C                                                                       1390.000
  1428.       INCLUDE      K.KERMD                                              1391.000
  1429.       INCLUDE      K.PROTC                                              1392.000
  1430. C                                                                       1393.000
  1431.       INTEGER      TAKEFILE(17)    !take file input name                1394.000
  1432.       CHARACTER*8  CTAKEFIL        !input file name                     1395.000
  1433.       INTEGER      IRET            !return code                         1396.000
  1434.       INTEGER      TAKEFD          !file desc to take from              1397.000
  1435. C                                                                       1398.000
  1436.       LOGICAL      ISFILE          !check for file existence            1399.000
  1437.       INTEGER      OPEN                                                 1400.000
  1438. C                                                                       1401.000
  1439. C                                                                       1402.000
  1440.       CALL SETVAL(TAKEFILE, 'S', IRET, 16, 0, 0,                        1403.000
  1441.      $    'Filename to take commands from',.TRUE.)                      1404.000
  1442.       IF (IRET .EQ. ERROR) RETURN                                       1405.000
  1443. C                                                                       1406.000
  1444. C check to make sure it's there                                         1407.000
  1445. C                                                                       1408.000
  1446.       CALL AS2DPC(TAKEFILE, CTAKEFIL)                                   1409.000
  1447.       IF (.NOT. ISFILE(CTAKEFIL)) THEN                                  1410.000
  1448.         CALL PRINTL(STDOUT, '?File ')                                   1411.000
  1449.         CALL PUTSTR(STDOUT, TAKEFILE)                                   1412.000
  1450.         CALL PRINT(STDOUT, ' is not found.')                            1413.000
  1451.         CALL PUTC(STDOUT, NEL)                                          1414.000
  1452.         RETURN                                                          1415.000
  1453.       ENDIF                                                             1416.000
  1454. C                                                                       1417.000
  1455. C open file                                                             1418.000
  1456. C                                                                       1419.000
  1457.       IF (INSTACK .GE. MAXINSTK) THEN                                   1420.000
  1458.         CALL PRINTL(STDOUT, '?Exceed input TAKE stack depth.')          1421.000
  1459.         RETURN                                                          1422.000
  1460.       ENDIF                                                             1423.000
  1461.       TAKEFD = OPEN(CTAKEFIL, 'R')                                      1424.000
  1462.       IF (TAKEFD .EQ. ERROR) THEN                                       1425.000
  1463.         CALL PRINTL(STDOUT, '?Cannot open ')                            1426.000
  1464.         CALL PUTSTR(STDOUT, TAKEFILE)                                   1427.000
  1465.         CALL PRINT(STDOUT, '.')                                         1428.000
  1466.         CALL PUTC(STDOUT, NEL)                                          1429.000
  1467.         RETURN                                                          1430.000
  1468.       ENDIF                                                             1431.000
  1469. C                                                                       1432.000
  1470. C remember where was                                                    1433.000
  1471. C                                                                       1434.000
  1472.       INSTACK = INSTACK + 1                                             1435.000
  1473.       INSTKFD(INSTACK) = INPUTFD                                        1436.000
  1474. C                                                                       1437.000
  1475. C redirect                                                              1438.000
  1476. C                                                                       1439.000
  1477.       INPUTFD = TAKEFD                                                  1440.000
  1478.       RETURN                                                            1441.000
  1479.       END                                                               1442.000
  1480.       SUBROUTINE TAKEDONE                                               1443.000
  1481.            IMPLICIT NONE                                                1444.000
  1482. C                                                                       1445.000
  1483. C= Returns to next level of input file.                                 1446.000
  1484. C                                                                       1447.000
  1485.       INCLUDE      K.KERMD                                              1448.000
  1486.       INCLUDE      K.PROTC                                              1449.000
  1487. C                                                                       1450.000
  1488.       IF (INPUTFD .NE. STDIN) CALL CLOSE(INPUTFD)                       1451.000
  1489.       IF (INSTACK .LE. 0) THEN                                          1452.000
  1490.         INSTACK = 0                                                     1453.000
  1491.         INPUTFD = STDIN                                                 1454.000
  1492.       ELSE                                                              1455.000
  1493.         INPUTFD = INSTKFD(INSTACK)                                      1456.000
  1494.         INSTACK = INSTACK - 1                                           1457.000
  1495.       ENDIF                                                             1458.000
  1496.       RETURN                                                            1459.000
  1497.       END                                                               1460.000
  1498.