home *** CD-ROM | disk | FTP | other *** search
/ kermit.columbia.edu / kermit.columbia.edu.tar / kermit.columbia.edu / tandem / tandem.src < prev    next >
Text File  |  1997-11-12  |  40KB  |  1,412 lines

  1. ?NOCODE
  2. ?symbols
  3. ?INSPECT
  4. DEFINE VERSTRING = "Tandem KERMIT server - Version 1.0"#;
  5. !*****************************************************************************!
  6. !*                                                                           *!
  7. !*                     TANDEM KERMIT SERVER                                  *!
  8. !*                     VERSION 1.0                                           *!
  9. !*                     MARCH 6, 1986                                         *!
  10. !*                                                                           *!
  11. !*      PROGRAMMER: CHARLES J. CANTOR                                        *!
  12. !*                  CANTOR CONSULTING                                        *!
  13. !*                  116 DICKERMAN RD.                                        *!
  14. !*                  NEWTON, MA 02161                                         *!
  15. !*                                                                           *!
  16. !*      Revision history (newest to oldest):                                 *!
  17. !*      VERSION  DATE      BY/DESCRIPTION                                    *!
  18. !*        2.0    ??/??/9?  CAIL / John Deere Corp.                           *!
  19. !*                                                                           *!
  20. !*        1.0    03/06/86  A. G. Camas (Bedford, MA) - Added "[NO]BREAK"     *!
  21. !*                         option.  Added handling for "I" (initialize)      *!
  22. !*                         packet now used before server is asked to send.   *!
  23. !*                         Made fancier "banner" with version number.        *!
  24. !*                                                                           *!
  25. !*        0.0    11/01/84  Charles J. Cantor (Cantor Consulting, Newton, MA) *!
  26. !*                         - Original version of software.                   *!
  27. !*                                                                           *!
  28. !*                                                                           *!
  29. !*      This server will send and receive ASCII files only.                  *!
  30. !*      The output file will be an EDIT file.                                *!
  31. !*                                                                           *!
  32. !*      THE FOLLOWING HAVE NOT BEEN IMPLEMENTED:                             *!
  33. !*      Generic commands other than LOGOFF (Hangs up Modem).                 *!
  34. !*      Host commands.                                                       *!
  35. !*      Wild carding.                                                        *!
  36. !*                                                                           *!
  37. !*      Repeat counts have only been unit tested.                            *!
  38. !*                                                                           *!
  39. !*      Eight bit quoting is implemented in the send and receive procs.      *!
  40. !*      The EDIT file implementation appends <cr><lf> to output              *!
  41. !*      lines and strips them on input, rendering the issue moot;            *!
  42. !*      therefore, it has been defaulted out and also butchered out in       *!
  43. !*      PROC PROCESS^SEND^INIT                                               *!
  44. !*                                                                           *!
  45. !*      COMPILATION:                                                         *!
  46. !*      TAL /IN KERMITS,OUT $S.#KERM/KERMIT                                  *!
  47. !*                                                                           *!
  48. !*      USAGE:                                                               *!
  49. !*                                                                           *!
  50. !*      RUN KERMIT <option-list>                                             *!
  51. !*                                                                           *!
  52. !*      Where <option-list> consists of a series of options separated        *!
  53. !*      by commas.                                                           *!
  54. !*                                                                           *!
  55. !*          OPTION:              DEFAULT:                                    *!
  56. !*                                                                           *!
  57. !*          [NO]DEBUG            NODEBUG                                     *!
  58. !*          [NO]TABS             TABS                                        *!
  59. !*          [NO]TRUNC            NOTRUNC                                     *!
  60. !*          [NO]FLIP             NOFLIP                                      *!
  61. !*          [NO]PURGE            NOPURGE                                     *!
  62. !*          [NO]BREAK            BREAK                                       *!
  63. !*                                                                           *!
  64. !*      Specifying DEBUG allows non-protocol interaction at a                *!
  65. !*      terminal, i. e. no <soh>'s are sent or expected and no               *!
  66. !*      checksumming of input is done.                                       *!
  67. !*                                                                           *!
  68. !*      Unless NOTABS is specified, tabs will be expanded to spaces          *!
  69. !*      on input. Tab stops are the usual every 8'th column. No tab          *!
  70. !*      expansion is done on output.                                         *!
  71. !*                                                                           *!
  72. !*      TRUNC will truncate file-specs at the first decimal point on         *!
  73. !*      send requests, e. g. SEND KERMIT.A86 will go to TANDEM file          *!
  74. !*      KERMIT.                                                              *!
  75. !*                                                                           *!
  76. !*      FLIP will flip file.ext in send requests.                            *!
  77. !*      SEND KERMIT.A86 will go to TANDEM file  <vol>.A86.KERMIT.            *!
  78. !*                                                                           *!
  79. !*      PURGE will purge existing files on send requests.                    *!
  80. !*                                                                           *!
  81. !*      If you specify NOBREAK, interruption by the BREAK key is             *!
  82. !*      disabled.  On some noisy lines, this can help since line             *!
  83. !*      noise is sometimes seen as BREAK, which interrupts the server.       *!
  84. !*      NOBREAK should not be a problem, since ctrl/Y stops KERMIT.          *!
  85. !*                                                                           *!
  86. !*      THE SERVER WILL ACCEPT AND PARSE FILE SPECS GENERATED BY:            *!
  87. !*                                                                           *!
  88. !*      SEND local-file-spec[~tandem-file-spec]                              *!
  89. !*      GET tandem-file-spec[~local-file-spec]                               *!
  90. !*                                                                           *!
  91. !*      The SERVER will return the local-file-spec on a receive              *!
  92. !*      (default is tandem-file-spec), e.g.                                  *!
  93. !*      KERMIT-86>GET DOCUMENT.KERPROTO~KERPROTO.DOC                         *!
  94. !*                                                                           *!
  95. !*      Changes would have to be made to local KERMITs to implement          *!
  96. !*      the augmentation of the SEND command.                                *!
  97. !*                                                                           *!
  98. !*      IDIOSYNCRACIES:                                                      *!
  99. !*      Trailing blanks are trimmed on input.                                *!
  100. !*      It is a good idea to run the server from a command file:             *!
  101. !*          :RUN KERMIT                                                      *!
  102. !*          :INITTERM                                                        *!
  103. !*      as the SETMODES leave the terminal in a strange state if             *!
  104. !*      it aborts.                                                           *!
  105. !*                                                                           *!
  106. !*      RUNNING ON LINES GENNED FOR 6530's WITHOUT 6530 EMULATION:           *!
  107. !*      The TANDEM generates "go into conversational mode" sequences         *!
  108. !*      (<soh>C<etx><LRC>) from time to time. ACK (<ctrl-F>) them.           *!
  109. !*                                                                           *!
  110. !*      It also generates an <enq> (<ctrl-E>) from time to time when         *!
  111. !*      sending large amounts of data to the terminal. Any character         *!
  112. !*      takes care of them; however, an ACK is expected and will not be      *!
  113. !*      echoed. The TANDEM will eventually time out and continue output      *!
  114. !*      in any case.                                                         *!
  115. !*                                                                           *!
  116. !*      Avoid block mode (e.g. XVS) like the plague.                         *!
  117. !*                                                                           *!
  118. !*      EXITING THE SERVER:                                                  *!
  119. !*      <ctry-y> at terminal emulation level exits the server.               *!
  120. !*                                                                           *!
  121. !*****************************************************************************!
  122.  
  123. ?PAGE "GLOBALS"
  124. ?NOLIST,SOURCE $SYSTEM.SYSTEM.GPLDEFS
  125. ?LIST
  126. ?PAGE
  127. LITERAL SOH = 1,
  128.         ETX = 3,
  129.         TAB = %11,
  130.         CR  = %15,
  131.         LF  = %12,
  132.         CTRL^Y = %31,
  133.         TRUE = -1,
  134.         FALSE = 0;
  135.  
  136. DEFINE  LEGAL^PACKETS^D(INIT) =
  137.             STRING  LEGAL^PACKETS ='P' := [INIT,0];
  138.             STRING  .POINTER;
  139.             INT N#,
  140.  
  141.        CHECK^LEGAL^D =
  142.             SCAN LEGAL^PACKETS UNTIL PACKET^TYPE -> @POINTER;
  143.             N := @POINTER '-' @LEGAL^PACKETS#,
  144.  
  145.         BAD^PACKET^D =
  146.             BEGIN
  147.             PACKET^TYPE := -1;
  148.             RETURN;
  149.             END#,
  150.  
  151.         CLOSE^FILE^D(FCB) =
  152.             BEGIN
  153.             IF FILE^OPEN^FLAG THEN
  154.                 BEGIN
  155.                 CALL CLOSE^FILE(FCB);
  156.                 FILE^OPEN^FLAG := FALSE;
  157.                 END;
  158.             END#,
  159.  
  160.         ERROR^MESSAGE^D(A) =
  161.             BEGIN
  162.             IN^BUF^S ':=' A & 0;
  163.             CALL ERROR^PACKET(,IN^BUF^S);
  164.             END#,
  165.  
  166.         NOT^IMPL^D = ERROR^MESSAGE^D("Command not implemented")#,
  167.  
  168.         NO^PROC(A) =
  169.             PROC A;
  170.             BEGIN
  171.             END#,
  172.  
  173.         I^NO^PROC(A) =
  174.             INT PROC A;
  175.             BEGIN
  176.             RETURN TRUE;
  177.             END#;
  178.  
  179. STRUCT PARAMS(*);
  180.     BEGIN
  181.     STRING BUFSIZ;
  182.     STRING TIMOUT;
  183.     STRING NPAD;
  184.     STRING PAD^CHAR;
  185.     STRING EOL;
  186.     STRING QUOTE^CHAR;
  187.     STRING EIGHT^BIT;
  188.     STRING CHECK^TYPE;
  189.     STRING REPEAT^CHAR;
  190.    !STRING RESERVED[0:1];
  191.     STRING RESERVED[0:3];
  192.     END;
  193.  
  194. DEFINE CHAR(X) = ((X) + " ")#,
  195.        UNCHAR(X) = ((X) - " ")#,
  196.        CTL(X) = ((X) XOR %100)#,
  197.        CHKSUM(X) = (((X) + ((X) '>>' 6)) LAND %77)#,
  198.        SIX^BIT(X) = ((X) LAND %77)#,
  199.        MARK =  SOH#;
  200.  
  201. STRING .IN^BUF^S[0:511],  !LINE BUFFER!
  202.        .FILE^BUF^S[0:4095];  !FILE BLOCK BUFFER!
  203.  
  204. STRING .OUT^PACKET[0:99],SAVE^SUM;
  205.  
  206. INT OUT^PACKET^LENGTH,IN^PACKET^LENGTH;
  207.  
  208. INT .IN^BUF := @IN^BUF^S '>>' 1,
  209.     .FILE^BUF := @FILE^BUF^S '>>' 1;
  210.  
  211. INT DEBUG^FLAG := FALSE, REPEAT^FLAG, MAX^DATA^CHARS, TABS^FLAG := TRUE;
  212. INT FLIP^FLAG := FALSE, INIT^FAILED := FALSE, TRUNC^FLAG := FALSE;
  213. INT PURGE^FLAG := FALSE;
  214. INT BREAK^FLAG := TRUE;
  215. INT FILE^OPEN^FLAG := FALSE;
  216.  
  217. INT .OLD^BREAK[0:1];   !SAVES PREVIOUS BREAK DATA IF NOBREAK MODE!
  218.  
  219. STRING .SBUF[0:511];   !SCRATCH BUFFER AND FILE I/O BUFFER!
  220. INT .BUF := @SBUF '>>' 1;
  221. LITERAL OUT^BLKLEN = 4096;
  222.  
  223. ALLOCATE^CBS(RUCB,COMMON^FCB,3);
  224. ALLOCATE^FCB(IN^FCB,"        #IN             ");
  225. ALLOCATE^FCB(FILE^FCB,"                JUNK    ");   !PICK UP DEFAULT!
  226. ALLOCATE^FCB(ERR^FCB,"        #TERM           ");
  227. INT .DEFAULT^VOL[0:7];
  228. INT .FILE^NAME;
  229. INT .TERM^NAME;
  230. INT .ERR^NAME;
  231. INT TERMNUM;
  232. INT .FILENUM;
  233.  
  234. STRING PACKET^TYPE;
  235.  
  236. STRING .DEFAUL[0:$LEN(PARAMS) - 1] := [
  237.                                        CHAR(94), !MAX BUFSIZE!
  238.                                        CHAR(5),  !TIME OUT!
  239.                                        CHAR(0),  !NUMBER OF PAD CHARS!
  240.                                        CTL(0),   !PAD CHARACTER!
  241.                                        CHAR(CR), !END OF LINE CHARACTER!
  242.                                        "#",      !CONTROL QUOTE!
  243.                                       !"N",     !!8 BIT QUOTE!
  244.                                        "Y",      !8 BIT QUOTE!
  245.                                        "1",      !CHKSUM TYPE!
  246.                                        "~",      !REPEAT QUOTER!
  247.                                        "    "];  !RESERVED!
  248. STRING .MY^PARAM^STRING[0:$LEN(PARAMS) - 1];
  249. STRING .HIS^PARAM^STRING[0:$LEN(PARAMS) - 1];
  250. STRING .MY^PARAMS(PARAMS) := @MY^PARAM^STRING;
  251. STRING .HIS^PARAMS(PARAMS) := @HIS^PARAM^STRING;
  252.  
  253. INT WAIT^FOREVER,
  254.     MAX^RETRIES := 5,
  255.     NUM^RETRIES := 0;
  256.  
  257. INT(32) TIME^OUT;
  258. STRING  PACKET^NUMBER := 0,
  259.         INPUT^PACKET^NUMBER := 0;
  260.  
  261. STRUCT START^MSG^DEF(*);
  262.     BEGIN
  263.     INT  MSGCODE;
  264.     STRUCT DEFAULT;
  265.          BEGIN
  266.          INT VOLUME[0:3];
  267.          INT SUBVOL[0:3];
  268.          END;
  269.     STRUCT INFILE;
  270.          BEGIN
  271.          INT VOLUME[0:3];
  272.          INT SUBVOL[0:3];
  273.          INT DNAME[0:3];
  274.          END;
  275.     STRUCT OUTFILE;
  276.          BEGIN
  277.          INT VOLUME[0:3];
  278.          INT SUBVOL[0:3];
  279.          INT DNAME[0:3];
  280.          END;
  281.     STRING PARAM[0:596];
  282.     END;
  283. ?NOLIST,SOURCE $SYSTEM.SYSTEM.EXTDECS
  284. ?LIST
  285.  
  286. ?PAGE "FORWARDS"
  287. PROC GET^PACKET(RETRIES) VARIABLE;
  288. INT RETRIES;
  289. FORWARD;
  290. PROC ERROR^PACKET(ERROR,MESSAGE) VARIABLE;
  291. INT ERROR;
  292. STRING .MESSAGE;
  293. FORWARD;
  294. ?PAGE "START^PROC"
  295. PROC START^PROC (RUCB,PASSTHRU,MESSAGE,MESLEN,MATCH) VARIABLE;
  296.  
  297. ! THIS PROC PARSES THE PARAMS PORTION OF THE START UP MESSAGE!
  298.  
  299. INT .RUCB,.PASSTHRU,MESLEN,MATCH;
  300. STRUCT .MESSAGE(START^MSG^DEF);
  301. BEGIN
  302. INT DONE := FALSE,MATCHED;
  303. STRING .MES^S,.TEMP;
  304.  
  305. DEFINE MATCH^IT(A,FLAG) =
  306. BEGIN
  307. IF MES^S = "NO" AND MES^S[2] = A THEN
  308.            BEGIN
  309.            MATCHED := TRUE;
  310.            FLAG := FALSE;
  311.            END;
  312. IF MES^S = A THEN
  313.            BEGIN
  314.            MATCHED := TRUE;
  315.            FLAG := TRUE;
  316.            END;
  317. END#;
  318.  
  319. @MES^S := @MESSAGE '<<' 1;
  320.  
  321. MES^S[MESLEN] := 0;
  322. @MES^S := @MES^S[$OFFSET(MESSAGE.PARAM)];
  323. CALL SHIFTSTRING(MES^S,MESLEN - $OFFSET(MESSAGE.PARAM),0);   !UPPER CASE!
  324.  
  325. WHILE NOT DONE DO
  326.     BEGIN
  327.     SCAN MES^S WHILE " " -> @MES^S; !STRIP LEADING BLANKS!
  328.     SCAN MES^S UNTIL "," -> @TEMP;
  329.     IF $CARRY THEN
  330.         BEGIN
  331.         DONE := TRUE;
  332.         IF @MES^S = @TEMP THEN RETURN;
  333.         MATCHED := FALSE;
  334.         END;
  335.  
  336.     MATCH^IT("TABS",TABS^FLAG);
  337.     MATCH^IT("DEBUG",DEBUG^FLAG);
  338.     MATCH^IT("PURGE",PURGE^FLAG);
  339.     MATCH^IT("TRUNC",TRUNC^FLAG);
  340.     MATCH^IT("FLIP",FLIP^FLAG);
  341.     MATCH^IT("BREAK",BREAK^FLAG);
  342.     IF NOT MATCHED THEN
  343.         BEGIN
  344.         INIT^FAILED := TRUE;
  345.         DONE := TRUE;
  346.         END;
  347.     @MES^S := @TEMP[1];
  348.   END;
  349. RETURN;
  350.  
  351. END;
  352. ?PAGE "MISCELLANEOUS SERVICE PROCS"
  353. INT PROC CHECKSUMMER(POINTER,LENGTH);
  354.  
  355. ! THIS PROC COMPUTES THE CHECKSUMS FOR BOTH INBOUND AND OUT BOUND PACKETS!
  356. ! IT RETURNS THE LENGTH OF THE PACKET !
  357. ! LENGTH ON INPUT IS THE ACTUAL LENGTH: SOH -> CHECKSUM!
  358. STRING .POINTER;
  359. INT LENGTH;
  360. BEGIN
  361. INT N,TEMP,TEMP1 := 0;
  362.  
  363. SAVE^SUM := POINTER[LENGTH - 1];
  364. TEMP := 0;
  365.  
  366. FOR N := 1 TO LENGTH - 2 DO
  367.     BEGIN
  368.     TEMP1.<8:15> := POINTER[N].<8:15>;
  369.     TEMP := TEMP + TEMP1;
  370.     END;
  371.  
  372. POINTER[LENGTH - 1] := CHAR(CHKSUM(TEMP.<8:15>));
  373.  
  374. POINTER[LENGTH] := UNCHAR(HIS^PARAMS.EOL);
  375. IF POINTER[LENGTH] = 0 THEN RETURN LENGTH
  376.                        ELSE RETURN LENGTH + 1;
  377. END;
  378.  
  379.  
  380.  
  381.  
  382. PROC FINISH^AND^SHIP(LENGTH,RETRIES) VARIABLE;
  383.  
  384. ! THIS PROC WILL COMPLETE THE SENDING OF A GENERAL DATA PACKET AND RETRIEVE
  385. ! THE REPLY. THE PACKET IS EXPECTED IN OUT^PACKET.
  386. ! LENGTH IS THE LENGTH OF THE DATA IN THE PACKET, I.E. THE CHARACTERS AFTER
  387. ! PACKET TYPE BYTE.
  388.  
  389. INT LENGTH,RETRIES;
  390. BEGIN
  391. IF NOT $PARAM(LENGTH) THEN LENGTH := 0;
  392. IF NOT $PARAM(RETRIES) THEN RETRIES := MAX^RETRIES;
  393. LENGTH := LENGTH + 3;
  394.  
  395. OUT^PACKET[1] := CHAR(LENGTH);
  396. LENGTH := LENGTH + 2;
  397.  
  398. PACKET^NUMBER := SIX^BIT(INPUT^PACKET^NUMBER + 1);
  399. OUT^PACKET[2] := CHAR(PACKET^NUMBER);
  400.  
  401. OUT^PACKET^LENGTH := CHECKSUMMER(OUT^PACKET,LENGTH);
  402. CALL GET^PACKET;
  403. RETURN;
  404. END;
  405. ?PAGE
  406. PROC ERROR^PACKET(ERROR,MESSAGE) VARIABLE;
  407.  
  408. ! THIS PROC SENDS AN ERROR PACKET. IF IT IS CALLED WITH AN ERROR PARAMETER,
  409. ! IT ASSUMES A FILE ERROR AND FORMATS AN APPROPRIATE MESSAGE
  410. ! IF ITS IS CALLED WITH A MESSAGE, IT ASSUMES THAT SHOULD BE SENT
  411.  
  412. INT ERROR;
  413. STRING .MESSAGE;
  414. BEGIN
  415. INT LENGTH;
  416. STRING .FILE^ERROR[0:19] := "  FILE ERROR:       ";
  417.  
  418. OUT^PACKET ':=' [MARK,"LNE"];
  419. LENGTH := 0;
  420. IF $PARAM(ERROR) THEN
  421.     BEGIN
  422.     CALL NUMOUT(FILE^ERROR[14],ERROR,10,3);
  423.     OUT^PACKET[4] ':=' FILE^ERROR FOR 20;
  424.     LENGTH := 20;
  425.     END;
  426.  
  427. IF $PARAM(MESSAGE) THEN
  428.     BEGIN
  429.     SCAN MESSAGE UNTIL 0 -> LENGTH;
  430.     LENGTH := LENGTH '-' @MESSAGE;
  431.     OUT^PACKET[4] ':=' MESSAGE FOR LENGTH;
  432.     END;
  433.  
  434. INPUT^PACKET^NUMBER := 77;
  435. CALL FINISH^AND^SHIP(LENGTH,2);
  436. PACKET^TYPE := -1;
  437. END;
  438.  
  439.  
  440.  
  441.  
  442.  
  443. INT PROC OPEN^INPUT^FILE;
  444. BEGIN
  445. INT ERROR;
  446. CALL SET^FILE(FILE^FCB,ASSIGN^OPENACCESS, READ^ACCESS);
  447. ERROR := OPEN^FILE(COMMON^FCB,FILE^FCB,FILE^BUF,OUT^BLKLEN,
  448.          ,ABORT^OPENERR+ABORT^XFERERR+AUTO^CREATE);
  449. IF ERROR = 0 THEN
  450.     BEGIN
  451.     FILE^OPEN^FLAG := TRUE;
  452.  
  453.     ! 4/3/95 - do not trim for binary files
  454.     CALL SET^FILE(FILE^FCB,SET^READ^TRIM,0);
  455.     RETURN TRUE;
  456.     END;
  457. CALL ERROR^PACKET(ERROR);
  458. RETURN FALSE;
  459. END;
  460.  
  461.  
  462.  
  463. INT PROC OPEN^OUTPUT^FILE;
  464. BEGIN
  465. INT ERROR;
  466. INT(32) FLAGS := AUTO^CREATE;
  467.  
  468. IF PURGE^FLAG THEN FLAGS := FLAGS + PURGE^DATA
  469.               ELSE FLAGS := FLAGS + MUSTBENEW;
  470.  
  471. CALL SET^FILE(FILE^FCB,ASSIGN^OPENACCESS, WRITE^ACCESS);
  472. CALL SET^FILE(FILE^FCB,ASSIGN^FILECODE,0);
  473. ERROR := OPEN^FILE(COMMON^FCB,FILE^FCB,FILE^BUF,OUT^BLKLEN,
  474.          FLAGS,
  475.          ABORT^OPENERR+ABORT^XFERERR+AUTO^CREATE+PURGE^DATA+MUSTBENEW);
  476. IF ERROR = 0 THEN
  477.     BEGIN
  478.     FILE^OPEN^FLAG := TRUE;
  479.     CALL SET^FILE(FILE^FCB,SET^WRITE^PAD,0);
  480.  
  481.     ! 4/3/95 - do not trim for binary files
  482.     CALL SET^FILE(FILE^FCB,SET^WRITE^TRIM,0);
  483.     RETURN TRUE;
  484.     END;
  485. CALL ERROR^PACKET(ERROR);
  486. RETURN FALSE;
  487. END;
  488.  
  489.  
  490.  
  491.  
  492. INT PROC WRITE^OUTPUT^FILE(LENGTH);
  493. INT LENGTH;
  494. BEGIN
  495. INT ERROR;
  496. ERROR := WRITE^FILE(FILE^FCB,BUF,LENGTH);
  497. IF ERROR = 0 THEN RETURN TRUE;
  498. CALL ERROR^PACKET(ERROR);
  499. RETURN FALSE;
  500. END;
  501.  
  502.  
  503.  
  504.  
  505. PROC GIVE^IT^UP(HANG^UP) VARIABLE;
  506.  
  507. INT HANG^UP;
  508.  
  509. ! THIS IS THE CLEAN UP AND EXIT PROC.
  510. ! IT IS CALLED WHEN THE MAX RETRY COUNT IS EXCEEDED OR AN UNRECOVERABLE
  511. ! ERROR OCCURS ON THE LINE
  512. ! IF THE HANG UP IS INCLUDED, IT ALSO HANGS UP THE MODEM
  513.  
  514. BEGIN
  515. CLOSE^FILE^D(FILE^FCB);
  516. CALL CLOSE(TERMNUM);
  517. CALL OPEN(TERM^NAME,TERMNUM);  !REOPEN  WAITED!
  518. CALL SETMODE(TERMNUM,28,0);
  519. IF NOT BREAK^FLAG THEN CALL SETMODE(TERMNUM,11,OLD^BREAK[0],
  520.                                     OLD^BREAK[1]);  !RESET BREAK TO CI!
  521. IF $PARAM(HANG^UP) THEN CALL CONTROL(TERMNUM,12);   !HANG UP!
  522. CALL STOP;
  523. END;
  524.  
  525. ?PAGE "PROC INITIALIZE"
  526. PROC INITIALIZE;
  527. BEGIN
  528. INT FLAG := 0,ERROR;
  529.  
  530. SBUF ':=' [5,"INPUT"];
  531. CALL SET^FILE(IN^FCB,ASSIGN^LOGICALFILENAME,@BUF);
  532. SBUF ':=' [6,"OUTPUT"];
  533. CALL SET^FILE(FILE^FCB,ASSIGN^LOGICALFILENAME,@BUF);
  534. SBUF ':=' [5,"ERROR"];
  535. CALL SET^FILE(ERR^FCB,ASSIGN^LOGICALFILENAME,@BUF);
  536. CALL INITIALIZER(RUCB,,START^PROC);
  537.  
  538. @TERM^NAME := CHECK^FILE( IN^FCB, FILE^FILENAME^ADDR);
  539. @FILE^NAME := CHECK^FILE(FILE^FCB, FILE^FILENAME^ADDR);
  540. @ERR^NAME := CHECK^FILE(ERR^FCB, FILE^FILENAME^ADDR);
  541. DEFAULT^VOL ':=' FILE^NAME FOR 8;
  542.  
  543.  
  544. FLAG.<3:5> := 0;        !READ WRITE!
  545. FLAG.<8> := 1;          !NOWAIT!
  546. FLAG.<12:15> := 7;      !MAX-CONCURRENT NOWAIT IO!
  547.  
  548.  
  549. CALL SET^FILE(ERR^FCB,ASSIGN^OPENACCESS, WRITE^ACCESS);
  550. CALL OPEN^FILE(COMMON^FCB,ERR^FCB,,,
  551.         PURGE^DATA !FLAGS!,PURGE^DATA !MASK!,!LEN!,!PROMPT!,ERR^FCB);
  552. CALL OPEN(TERM^NAME,TERMNUM);     !OPEN WAITED TO DO THE SETMODES!
  553. IF <> THEN CALL DEBUG;
  554.  
  555. IF INIT^FAILED THEN
  556.     BEGIN
  557.     SBUF ':=' "PARAMETER ERROR, KERMIT ABORTED" -> ERROR;
  558.     CALL WRITE(TERMNUM,BUF,ERROR - @SBUF);
  559.     CALL STOP;
  560.     END;
  561. SBUF ':=' VERSTRING -> ERROR;
  562. CALL WRITE(TERMNUM,BUF,ERROR - @SBUF);
  563. SBUF ':=' "Use CTRL/Y to exit" -> ERROR;
  564. CALL WRITE(TERMNUM,BUF,ERROR - @SBUF);
  565.  
  566. MY^PARAMS ':=' DEFAUL FOR $LEN(PARAMS);
  567. HIS^PARAMS ':=' MY^PARAMS FOR $LEN(PARAMS);
  568. MY^PARAMS.TIMOUT := CHAR(0);
  569.  
  570. ERROR := 0;
  571. ERROR.<8:15> := UNCHAR(HIS^PARAMS.TIMOUT);
  572. TIME^OUT := $DBLL(0,100*ERROR);
  573.  
  574. IF DEBUG^FLAG THEN RETURN;
  575.  
  576. SBUF ':=' [CTRL^Y,CTRL^Y,CTRL^Y,CR];   !EOF & CR ONLY INTERRUPT CHARACTERS!
  577. CALL SETMODE(TERMNUM,9,BUF,BUF[1]);   !SET LINE TERMINATION!
  578. CALL SETMODE(TERMNUM,10,0);     !NO-PARITY CHECKING!
  579. CALL SETMODE(TERMNUM,6,0);      !NO SPACE!
  580. CALL SETMODE(TERMNUM,7,0);      !NO LINE FEED AFTER CR!
  581. CALL SETMODE(TERMNUM,20,0);     !NO-ECHO!
  582. !If NOBREAK mode, disable break and save old break parameters
  583. IF NOT BREAK^FLAG THEN CALL SETMODE(TERMNUM,11,0,0,OLD^BREAK);
  584.  
  585. CALL CLOSE(TERMNUM);                 !CLOSE AND
  586. CALL OPEN(TERM^NAME,TERMNUM,FLAG);   !RE-OPEN NO WAIT!
  587. IF <> THEN CALL DEBUG;
  588.  
  589. RETURN;
  590. END;
  591. ?PAGE "ACK AND NAK FORMATTING PROCS"
  592. PROC FORMAT^ACK;
  593. BEGIN
  594. PACKET^NUMBER := INPUT^PACKET^NUMBER;
  595. OUT^PACKET ':=' [MARK,CHAR(3),0,"Y",0];
  596. OUT^PACKET[2] := CHAR(PACKET^NUMBER);
  597. OUT^PACKET^LENGTH := CHECKSUMMER(OUT^PACKET,5);
  598. RETURN;
  599. END;
  600.  
  601.  
  602.  
  603.  
  604.  
  605. PROC FORMAT^NAK;
  606. BEGIN
  607. OUT^PACKET ':=' [MARK,CHAR(3),0,"N",0];
  608. OUT^PACKET[2] := CHAR(PACKET^NUMBER);
  609. OUT^PACKET^LENGTH := CHECKSUMMER(OUT^PACKET,5);
  610. RETURN;
  611. END;
  612.  
  613.  
  614.  
  615. ?PAGE  "PROC GET^PACKET"
  616. PROC GET^PACKET(RETRIES) VARIABLE;
  617.  
  618. ! THIS IS THE LOW LEVEL LINE MANAGEMENT PROTOCOL PROC !
  619.  
  620.  
  621. INT RETRIES;
  622. BEGIN
  623. STRING NON^FATALS = 'P' := [40,120,140,0];
  624. INT COUNT,ERROR,MODEM^TRIES := 0;
  625.  
  626.  
  627.  
  628.  
  629.  
  630.  
  631. INT SUBPROC PAD^PACKET;
  632.  
  633. ! THIS PADS AND MOVES THE OUTPUT PACKET FORM OUT^PACKET TO THE
  634. ! LINE BUFFER
  635.  
  636. BEGIN
  637. STRING PAD^CHAR;
  638. INT N;
  639. PAD^CHAR := UNCHAR(HIS^PARAMS.PAD^CHAR);
  640. N := UNCHAR(HIS^PARAMS.NPAD);
  641. IF N <> 0 THEN IN^BUF^S ':=' PAD^CHAR FOR 1 & IN^BUF^S FOR N - 1;
  642.  
  643. IF DEBUG^FLAG THEN
  644.     BEGIN
  645.     OUT^PACKET^LENGTH := OUT^PACKET^LENGTH;
  646.     OUT^PACKET ':=' OUT^PACKET[1]
  647.                       FOR OUT^PACKET^LENGTH - 1 & LF;  !STRIP MARK!
  648.     END;
  649.  
  650. IN^BUF^S[N] ':=' OUT^PACKET FOR OUT^PACKET^LENGTH;
  651. RETURN N + OUT^PACKET^LENGTH;
  652. END;
  653.  
  654. INT SUBPROC VALID^MESSAGE;
  655.  
  656. BEGIN
  657. INT LENGTH := 0;
  658.  
  659. !THIS SUBPROC VALIDITY CHECKS THE INCOMING MESSAGE!
  660.  
  661. !  SCAN FOR MARK AND SHIFT MESSAGE TO BEGINNING OF BUFFER!
  662.  
  663. IF DEBUG^FLAG THEN   !ACCEPT INPUT FROM TERMINAL FOR DEBUGGING!
  664.     BEGIN
  665.     PACKET^TYPE := IN^BUF^S;
  666.     IN^PACKET^LENGTH := COUNT - 1;
  667.     IN^BUF^S ':=' IN^BUF^S[1] FOR IN^PACKET^LENGTH & 0;
  668.     IF PACKET^TYPE <> "Y" AND PACKET^TYPE <> "N" THEN
  669.         INPUT^PACKET^NUMBER := PACKET^NUMBER + 1
  670.     ELSE
  671.         INPUT^PACKET^NUMBER := PACKET^NUMBER;
  672.     RETURN TRUE;
  673.     END;
  674.  
  675. WHILE LENGTH < COUNT AND IN^BUF^S[LENGTH] <> MARK DO LENGTH := LENGTH + 1;
  676. COUNT := COUNT - LENGTH;
  677. IF COUNT < 5 THEN RETURN FALSE;   !MARK & LENGTH & SEQ & TYPE & CHECKSUM!
  678. IF LENGTH <> 0 THEN IN^BUF^S ':=' IN^BUF^S[LENGTH] FOR COUNT;
  679.  
  680. LENGTH := 0;
  681. LENGTH.<8:15> := UNCHAR(IN^BUF^S[1]) + 2;
  682.  
  683. IF LENGTH > COUNT THEN RETURN FALSE;
  684.  
  685. CALL CHECKSUMMER(IN^BUF^S,LENGTH);
  686.  
  687. IF SAVE^SUM <> IN^BUF^S[LENGTH - 1] THEN  RETURN FALSE;
  688.  
  689. INPUT^PACKET^NUMBER := UNCHAR(IN^BUF^S[2]);
  690. PACKET^TYPE := IN^BUF^S[3];
  691. IN^PACKET^LENGTH := LENGTH - 5;   !TYPE, SEQ, CHECKSUM, MARK, LENGTH
  692. IN^BUF^S ':=' IN^BUF^S[4] FOR IN^PACKET^LENGTH & 0;
  693. RETURN TRUE;
  694. END;
  695. ?PAGE
  696.  
  697. IF $PARAM(RETRIES)THEN NUM^RETRIES := RETRIES
  698.                   ELSE NUM^RETRIES := MAX^RETRIES;
  699.  
  700.  
  701. WHILE WAIT^FOREVER OR NUM^RETRIES <> 0 DO
  702.     BEGIN
  703.     CALL WRITEREAD(TERMNUM,IN^BUF,PAD^PACKET,512,COUNT);
  704.     IF NOT DEBUG^FLAG THEN CALL AWAITIO(TERMNUM,!BUFFER!,COUNT,,TIME^OUT);
  705.     CALL FILEINFO(TERMNUM,ERROR);
  706.     IF ERROR = 120 THEN ERROR := 0;  !PARITY!
  707.  
  708.     IF ERROR <> 0 THEN
  709.          BEGIN
  710.  
  711.          IF ERROR = 40 THEN   !TIME^OUT!
  712.               BEGIN
  713.               IF NOT WAIT^FOREVER THEN NUM^RETRIES := NUM^RETRIES - 1;
  714.               END;
  715.  
  716.          IF ERROR = 140 THEN  !MODEM ERROR!
  717.               BEGIN
  718.               MODEM^TRIES := MODEM^TRIES + 1;
  719.               IF MODEM^TRIES > MAX^RETRIES THEN
  720.                   BEGIN
  721.                   CALL CONTROL(TERMNUM,12);     !DISCONNECT MODEM!
  722.                   CALL GIVE^IT^UP;
  723.                   END
  724.               ELSE CALL DELAY(100D);     !WAIT 1!
  725.               END;
  726.  
  727.          SCAN NON^FATALS UNTIL ERROR.<8:15>;
  728.          IF $CARRY THEN CALL GIVE^IT^UP; !FATAL!
  729.          END ! I/O ERROR!
  730.  
  731.     ELSE    !NO I/O ERROR!
  732.         BEGIN
  733.         IF VALID^MESSAGE THEN
  734.             IF PACKET^TYPE <> "Y" THEN
  735.                 BEGIN
  736.                 IF PACKET^TYPE <> "N" THEN RETURN;
  737.  
  738.                 ! GOT A NAK, SEE IF IT WAS FOR NEXT PACKET!
  739.                 IF SIX^BIT(PACKET^NUMBER + 1) =
  740.                           INPUT^PACKET^NUMBER THEN
  741.                     !NAK FOR PACKET N + 1 IS EQUIVALENT TO ACK OF N!
  742.                     BEGIN
  743.                     PACKET^TYPE := "Y";
  744.                     INPUT^PACKET^NUMBER := PACKET^NUMBER;
  745.                     RETURN;
  746.                     END;
  747.                 END
  748.             ELSE !ACK!
  749.                 IF INPUT^PACKET^NUMBER = PACKET^NUMBER THEN RETURN;
  750.         IF NOT WAIT^FOREVER THEN NUM^RETRIES := NUM^RETRIES - 1;
  751.         END;
  752.     END; !LOOP!
  753.  
  754. PACKET^TYPE := -1;
  755. RETURN;
  756. END;
  757. ?PAGE "PROC PROCESS^SEND^INIT"
  758. PROC PROCESS^SEND^INIT(IN^PARAMS,TYPE,LENGTH);
  759.  
  760. ! THIS PROC DOES THE HOUSEKEEPING ASSOCIATED WITH SEND INIT MESSAGES
  761. ! AND SEND INIT ACKS
  762. ! IT WILL FORMAT THE MESSAGE INTO OUT^PACKET WITH TYPE "Y" OR "S"
  763. ! DEPENDING ON THE INPUT PARAMETER
  764. !
  765.  
  766. STRING .IN^PARAMS(PARAMS),TYPE;
  767. INT LENGTH;
  768. BEGIN
  769. INT N;
  770. STRING .OUT^PARAMS(PARAMS) := @OUT^PACKET[4];
  771. STRING SAVE^REPEAT;
  772.  
  773. CALL FORMAT^ACK;
  774. OUT^PACKET[3] := TYPE;
  775. IN^PARAMS.CHECK^TYPE := "1";
  776.  
  777. IN^PARAMS.EIGHT^BIT := "N";
  778. OUT^PARAMS ':=' IN^PARAMS FOR LENGTH &
  779.                        DEFAUL[LENGTH] FOR $LEN(PARAMS) - LENGTH;
  780.  
  781. SAVE^REPEAT := OUT^PARAMS.REPEAT^CHAR;
  782. FOR N := 0 TO $LEN(PARAMS) - 1 DO
  783.     IF OUT^PACKET[N + 4] = " " THEN OUT^PACKET[N + 4] := DEFAUL[N];
  784. OUT^PARAMS.REPEAT^CHAR := SAVE^REPEAT;
  785.  
  786. HIS^PARAMS ':=' OUT^PARAMS FOR $LEN(PARAMS);
  787. IF HIS^PARAMS.EIGHT^BIT <> "Y" THEN
  788.     BEGIN
  789.     OUT^PARAMS.EIGHT^BIT := "Y";
  790.    !OUT^PARAMS.EIGHT^BIT := "N";   !!REMOVE IF YOUR KERMIT WORKS!
  791.     END
  792. ELSE
  793.     BEGIN
  794.     OUT^PARAMS.EIGHT^BIT := MY^PARAMS.EIGHT^BIT;
  795.     HIS^PARAMS.EIGHT^BIT := MY^PARAMS.EIGHT^BIT;
  796.     END;
  797.  
  798. REPEAT^FLAG := (HIS^PARAMS.REPEAT^CHAR <> " ");
  799. MAX^DATA^CHARS := 91;
  800. IF HIS^PARAMS.BUFSIZ <> " " THEN
  801.             MAX^DATA^CHARS := UNCHAR(HIS^PARAMS.BUFSIZ) - 3;
  802.  
  803. ! 12/16/94 - trun off 'a' packet capability
  804. ! didn't seem to have any qffect on procomm - still got a packet
  805. ! accept 'A' packets
  806. !OUT^PARAMS.RESERVED[0] := %h28 ;
  807.  
  808. ! no capabilities
  809. OUT^PARAMS.RESERVED[0] := %h20 ;
  810.  
  811. ! sliding windows size
  812. OUT^PARAMS.RESERVED[1] := %h20 ;
  813.  
  814. ! extended packet size
  815. OUT^PARAMS.RESERVED[2] := %h20 ;
  816. OUT^PARAMS.RESERVED[3] := %h20 ;
  817.  
  818. !LENGTH := $LEN(PARAMS) + 5;
  819. !LENGTH := $LEN(PARAMS) + 4;
  820.  
  821. ! try 1 byte capabilities mask only
  822. LENGTH := $LEN(PARAMS) + 5 - 3 ;
  823. OUT^PACKET[1] := CHAR(LENGTH - 2);
  824. OUT^PACKET^LENGTH := CHECKSUMMER(OUT^PACKET,LENGTH);
  825. RETURN;
  826. END;
  827. ?PAGE "NON IMPLEMENTED"
  828. PROC COMMAND^PROC;
  829. BEGIN
  830. NOT^IMPL^D;
  831. RETURN;
  832. END;
  833. INT PROC GENERIC^PROC;
  834. BEGIN
  835. IF IN^BUF^S = "L" THEN
  836.     BEGIN
  837.     MAX^RETRIES := 2;
  838.     CALL FORMAT^ACK;
  839.     CALL GET^PACKET;
  840.     CALL GIVE^IT^UP(TRUE);
  841.     END;
  842.  
  843. ! swallow change directory command
  844. IF IN^BUF^S = "C" THEN
  845.     BEGIN
  846.     CALL FORMAT^ACK;
  847.     RETURN -1;
  848.     END;
  849. NOT^IMPL^D;
  850. RETURN 0;
  851. END;
  852. ?PAGE "PROC RECEIVE PROC"
  853. INT PROC RECEIVE^PROC;
  854.  
  855. ! IN BOUND FILE PROC !
  856.  
  857.  
  858. BEGIN
  859. LEGAL^PACKETS^D("BSFDZ");
  860. INT OUT^COUNT,            !INPUT PARSING STUFF!
  861.     LF^WAIT := FALSE,
  862.     WRITE^IT^OUT := FALSE;
  863. STRING CHRSAV,CHR;
  864. LITERAL MAX^BUF^SIZE = 132;
  865.  
  866.  
  867.  
  868. SUBPROC PARSE^FILE^HEADER;
  869. BEGIN
  870. INT NAME^LENGTH;
  871. STRING .IN^POINTER;
  872.  
  873. RSCAN IN^BUF^S[IN^PACKET^LENGTH -1] WHILE "~" -> @IN^POINTER;
  874.  
  875. IN^PACKET^LENGTH := @IN^POINTER[1] '-' @IN^BUF^S;
  876.  
  877. IF IN^PACKET^LENGTH <= 0 THEN
  878.     BEGIN
  879.     CALL ERROR^PACKET(999);    !ERROR!
  880.     RETURN;
  881.     END;
  882.  
  883. IN^POINTER[1] := 0;
  884.  
  885. SCAN IN^BUF^S UNTIL "~" -> @IN^POINTER;
  886.  
  887. IF NOT $CARRY THEN
  888.     BEGIN
  889.     NAME^LENGTH := IN^PACKET^LENGTH '-'
  890.                           (@IN^POINTER[1] '-' @IN^BUF^S);
  891.     IN^BUF^S ':=' IN^POINTER[1] FOR NAME^LENGTH & 0;
  892.     END
  893. ELSE
  894.     BEGIN     !NOT A SUPPLIED NAME, PLAY WITH REMOTE NAME!
  895.     NAME^LENGTH := IN^PACKET^LENGTH;
  896.     SCAN IN^BUF^S UNTIL "."  -> @IN^POINTER;
  897.     IF NOT $CARRY THEN
  898.          BEGIN
  899.          IF TRUNC^FLAG OR IN^POINTER[1] = 0 THEN IN^POINTER := 0;
  900.          IF FLIP^FLAG AND IN^POINTER <> 0 THEN
  901.               BEGIN
  902.               IN^POINTER := 0;
  903.               SBUF ':=' IN^BUF^S FOR NAME^LENGTH;
  904.               IN^BUF^S ':=' IN^POINTER[1] FOR NAME^LENGTH;
  905.               SCAN IN^BUF^S UNTIL 0 -> @IN^POINTER;
  906.               IN^POINTER ':=' "." & SBUF FOR NAME^LENGTH;
  907.               END;
  908.            END;
  909.          END;
  910.  
  911. CALL FNAMEEXPAND(IN^BUF,FILE^NAME,DEFAULT^VOL);
  912.  
  913. RETURN;
  914. END;    !SUBPROC!
  915.  
  916.  
  917. SUBPROC GET^NEXT^CHAR;
  918. BEGIN
  919. CHRSAV := 0;
  920. IF IN^BUF^S[N] = HIS^PARAMS.EIGHT^BIT AND HIS^PARAMS.EIGHT^BIT <> "N" THEN
  921.     BEGIN    !EIGHT BIT!
  922.     N := N + 1;
  923.     CHRSAV := %200;
  924.     END;
  925. IF IN^BUF^S[N] = HIS^PARAMS.QUOTE^CHAR THEN
  926.     BEGIN
  927.     N := N + 1;
  928.     CHR := IN^BUF^S[N];
  929.     IF (CHR = HIS^PARAMS.EIGHT^BIT AND HIS^PARAMS.EIGHT^BIT <> "N") OR
  930.         (REPEAT^FLAG AND CHR = HIS^PARAMS.REPEAT^CHAR) OR
  931.         CHR = HIS^PARAMS.QUOTE^CHAR THEN !TAKE IT AS LITERAL!
  932.         CHRSAV := CHRSAV + CHR
  933.         ELSE CHRSAV := CTL(CHRSAV + CHR);
  934.     END
  935. ELSE CHRSAV := CHRSAV + IN^BUF^S[N];
  936.  
  937. N := N + 1;
  938.  
  939. RETURN;
  940.  
  941. END;
  942.  
  943.  
  944. INT SUBPROC PROCESS^OUTPUT^DATA;
  945.  
  946. BEGIN
  947.  
  948. INT  REPEAT^COUNT := 0;
  949.  
  950. N := 0;
  951. WHILE N < IN^PACKET^LENGTH OR REPEAT^COUNT <> 0 DO
  952.     BEGIN
  953.     IF OUT^COUNT >= MAX^BUF^SIZE OR WRITE^IT^OUT THEN
  954.         IF NOT WRITE^OUTPUT^FILE(OUT^COUNT) THEN RETURN FALSE
  955.         ELSE
  956.             BEGIN
  957.             OUT^COUNT := 0;
  958.             WRITE^IT^OUT := FALSE;
  959.             END;
  960.  
  961.     IF REPEAT^COUNT <> 0 THEN
  962.         BEGIN
  963.         SBUF[OUT^COUNT] := CHRSAV;
  964.         OUT^COUNT := OUT^COUNT + 1;
  965.         REPEAT^COUNT := REPEAT^COUNT - 1;
  966.         END
  967.  
  968.     ELSE
  969.         BEGIN  !REPEAT COUNT EXHAUSTED, GET ANOTHER CHARACTER!
  970.         CHR := IN^BUF^S[N];
  971.         IF NOT REPEAT^FLAG OR CHR <> HIS^PARAMS.REPEAT^CHAR THEN
  972.             REPEAT^COUNT := 1
  973.         ELSE
  974.             BEGIN
  975.             REPEAT^COUNT := UNCHAR(IN^BUF^S[N+1]);
  976.             N := N + 2;
  977.             END;
  978.  
  979.         CALL GET^NEXT^CHAR;
  980.  
  981. ! 12/15/94 - only for text files
  982. !       IF CHRSAV = LF AND LF^WAIT THEN
  983. !           BEGIN
  984. !           LF^WAIT := FALSE;
  985. !           REPEAT^COUNT := REPEAT^COUNT - 1;
  986. !           WRITE^IT^OUT := TRUE;
  987. !           END;
  988. !       IF LF^WAIT AND CHRSAV <> LF THEN
  989. !           BEGIN
  990. !           SBUF[OUT^COUNT] := CR;
  991. !           OUT^COUNT := OUT^COUNT + 1;
  992. !           LF^WAIT := FALSE;
  993. !           END;
  994. !       IF CHRSAV = CR THEN
  995. !           BEGIN
  996. !           REPEAT^COUNT := REPEAT^COUNT - 1;
  997. !           LF^WAIT := TRUE;
  998. !           END;
  999. !       IF CHRSAV = TAB AND TABS^FLAG THEN
  1000. !           BEGIN
  1001. !           REPEAT^COUNT := 8 * REPEAT^COUNT - (OUT^COUNT LAND 7);
  1002. !           CHRSAV := " ";
  1003. !           END;
  1004.         END; !NEW CHARACTER, REPEAT COUNT = 0!
  1005.  
  1006.     END; !LOOP!
  1007.  
  1008. RETURN TRUE;
  1009. END; !SUBPROC!
  1010.  
  1011. SUBPROC RECEIVE^FILE^HEADER;
  1012. BEGIN
  1013. ! LEGAL^PACKETS^D("SZBF");
  1014. LEGAL^PACKETS^D("SZBFA");
  1015. WHILE 1 DO
  1016.     BEGIN
  1017.     CHECK^LEGAL^D;
  1018.     CASE N OF
  1019.         BEGIN
  1020. !0!     BEGIN
  1021.         CALL PROCESS^SEND^INIT(IN^BUF^S,"YY",IN^PACKET^LENGTH);
  1022.         CALL GET^PACKET;
  1023.         END;
  1024.  
  1025. !1!     BEGIN  !EOF!
  1026.         CALL FORMAT^ACK;
  1027.         CALL GET^PACKET;
  1028.         END;
  1029.  
  1030. !2!     RETURN; !BREAK!
  1031.  
  1032. !3!     BEGIN   !FILE HEADER!
  1033.         CALL PARSE^FILE^HEADER;
  1034.         IF NOT OPEN^OUTPUT^FILE THEN BAD^PACKET^D;
  1035.         OUT^COUNT := 0;
  1036.         RETURN;
  1037.         END;
  1038.  
  1039. !4!     BEGIN  !FILE ATTRIBUTES|
  1040.         CALL FORMAT^ACK;
  1041.         CALL GET^PACKET;
  1042.         END;
  1043.  
  1044.         OTHERWISE BAD^PACKET^D;
  1045.  
  1046.         END; !CASE!
  1047.     END; !LOOP!
  1048. END;    !SUBPROC!
  1049.  
  1050.  
  1051. SUBPROC RECEIVE^DATA;
  1052. BEGIN
  1053. LEGAL^PACKETS^D("FZDA");
  1054. WHILE 1 DO
  1055.     BEGIN
  1056.     CHECK^LEGAL^D;
  1057.     CASE N OF
  1058.         BEGIN
  1059. !0!     BEGIN  !FILE HEADER!
  1060.         CALL FORMAT^ACK;
  1061.         CALL GET^PACKET;
  1062.         END;
  1063.  
  1064. !1!     BEGIN   !EOF!
  1065.         IF OUT^COUNT <> 0 AND NOT WRITE^OUTPUT^FILE(OUT^COUNT)
  1066.             THEN BAD^PACKET^D;
  1067.         OUT^COUNT := 0;
  1068.         CLOSE^FILE^D(FILE^FCB);
  1069.         RETURN;
  1070.         END;
  1071.  
  1072. !2!     BEGIN   !DATA PACKET!
  1073.         IF INPUT^PACKET^NUMBER <> PACKET^NUMBER THEN
  1074.             BEGIN   !IF INCREMENT > 1, THINGS ARE FUBAR, SO PROCEED WITH DATA!
  1075.             IF NOT PROCESS^OUTPUT^DATA THEN BAD^PACKET^D; !HANDLES OWN ERRORS!
  1076.             END;
  1077.         CALL FORMAT^ACK;
  1078.         CALL GET^PACKET;
  1079.         RETURN;
  1080.         END;
  1081.  
  1082. !3!     BEGIN  !FILE ATTRIBUTES!
  1083.         CALL FORMAT^ACK;
  1084.         CALL GET^PACKET;
  1085.         END;
  1086.  
  1087.         OTHERWISE BAD^PACKET^D;
  1088.  
  1089.         END; !CASE!
  1090.     END; !LOOP!
  1091. END;    !SUBPROC!
  1092.  
  1093.  
  1094.  
  1095.  
  1096.  
  1097.  
  1098.  
  1099. WHILE 1 DO
  1100.     BEGIN
  1101.     CHECK^LEGAL^D;
  1102.     CASE N OF
  1103.         BEGIN
  1104.         !CASE 0 COMPLETE (BREAK)!
  1105.            BEGIN
  1106.            IF OUT^COUNT <> 0 THEN CALL WRITE^OUTPUT^FILE(OUT^COUNT);
  1107.            OUT^COUNT := 0;
  1108.            CLOSE^FILE^D(FILE^FCB);
  1109.            CALL FORMAT^ACK;
  1110.            CALL GET^PACKET;
  1111.            RETURN TRUE;
  1112.            END;
  1113.  
  1114.         !CASE 1! !SEND  INIT!       CALL RECEIVE^FILE^HEADER;
  1115.         !CASE 2! !FILE HEADER!      CALL RECEIVE^DATA;
  1116.         !CASE 3! !DATA!             CALL RECEIVE^DATA;
  1117.         !CASE 4! !EOF!              CALL RECEIVE^FILE^HEADER;
  1118.  
  1119.         !ABORT! OTHERWISE           RETURN FALSE;
  1120.         END; !CASE!
  1121.     END; !LOOP!
  1122. END;  !PROC!
  1123. ?PAGE "PROC SEND^PROC"
  1124. PROC SEND^PROC;
  1125.  
  1126. !THIS PROC HANDLES OUT BOUND FILE TRANSFERS!
  1127.  
  1128.  
  1129. BEGIN
  1130.  
  1131. INT ERROR,.COUNT^READ[0:0],OUT^COUNT,MAX^COUNT,SHIP^FLAG;
  1132.  
  1133. INT OUT^OF^INPUT := TRUE,DONE := FALSE;
  1134.  
  1135. INT REPEAT^COUNT, EIGHT^BIT, CONTROL^CHAR, NEED^QUOTE, TOTAL^COUNT;
  1136. STRING CHR;
  1137.  
  1138. STRING .IN^POINTER,.OUT^POINTER;
  1139.  
  1140. STRING .ECHO^FILE^NAME[0:39],.TEMP^NAME[0:39];
  1141.  
  1142. INT ECHO^NAME^LENGTH;
  1143. INT REMAINING^CHARS,IN^COUNT;
  1144.  
  1145.  
  1146. DEFINE CHECK^PACKET^D =
  1147.     IF PACKET^TYPE <> "Y" THEN
  1148.         BEGIN
  1149.         ERROR^MESSAGE^D("Gave up waiting for ACK");
  1150.         RETURN;
  1151.         END#;
  1152.  
  1153.  
  1154.  
  1155. INT SUBPROC PARSE^FILE^HEADER;
  1156. BEGIN
  1157.  
  1158. RSCAN IN^BUF^S[IN^PACKET^LENGTH -1] WHILE "~" -> @IN^POINTER;
  1159.  
  1160. IN^PACKET^LENGTH := @IN^POINTER[1] '-' @IN^BUF^S;
  1161.  
  1162. IF IN^PACKET^LENGTH <= 0 THEN
  1163.     BEGIN
  1164.     CALL ERROR^PACKET(11);    !FILE NO EXIST!
  1165.     RETURN FALSE;
  1166.     END;
  1167.  
  1168. IN^POINTER[1] := 0;
  1169.  
  1170. SCAN IN^BUF^S UNTIL "~" -> @IN^POINTER;
  1171.  
  1172. IF NOT $CARRY THEN
  1173.     BEGIN
  1174.     ECHO^NAME^LENGTH := IN^PACKET^LENGTH '-'
  1175.                           (@IN^POINTER[1] '-' @IN^BUF^S);
  1176.     ECHO^FILE^NAME ':=' IN^POINTER[1] FOR ECHO^NAME^LENGTH;
  1177.     END
  1178. ELSE
  1179.     BEGIN
  1180.     ECHO^NAME^LENGTH := IN^PACKET^LENGTH;
  1181.     ECHO^FILE^NAME ':=' IN^BUF^S FOR ECHO^NAME^LENGTH;
  1182.     END;
  1183.  
  1184. CALL FNAMEEXPAND(IN^BUF,FILE^NAME,DEFAULT^VOL);
  1185.  
  1186. RETURN TRUE;
  1187. END;    !SUBPROC!
  1188.  
  1189.  
  1190. SUBPROC SET^UP^DATA;
  1191. BEGIN
  1192. OUT^COUNT := 0;
  1193. OUT^PACKET ':=' [MARK,"LND"];
  1194. @OUT^POINTER := @OUT^PACKET[4];
  1195. SHIP^FLAG := FALSE;
  1196. REMAINING^CHARS := MAX^DATA^CHARS;
  1197. RETURN;
  1198. END;    !SUBPROC!
  1199.  
  1200. SUBPROC GET^REPEAT(POINTER);
  1201. STRING .POINTER;
  1202. BEGIN
  1203. STRING .LOCAL^POINTER;
  1204. STRING CHR1;
  1205. IF TOTAL^COUNT + 2 > REMAINING^CHARS THEN RETURN;
  1206. IF COUNT^READ - IN^COUNT < 4 THEN RETURN;
  1207. @LOCAL^POINTER := @POINTER[1];
  1208. CHR1 := POINTER;
  1209. IN^COUNT := IN^COUNT + 1;    !MUST SUBTRACT OFF LATER!
  1210. WHILE CHR1 = LOCAL^POINTER[REPEAT^COUNT] AND IN^COUNT < COUNT^READ DO
  1211.     BEGIN
  1212.     IN^COUNT := IN^COUNT + 1;
  1213.     REPEAT^COUNT := REPEAT^COUNT + 1;
  1214.     END;
  1215.  
  1216. IF REPEAT^COUNT < 3 THEN
  1217.     BEGIN  !DON'T BOTHER!
  1218.     IN^COUNT := IN^COUNT - REPEAT^COUNT;
  1219.     REPEAT^COUNT := 0;
  1220.     END
  1221. ELSE REPEAT^COUNT := REPEAT^COUNT + 1;
  1222.  
  1223. IN^COUNT := IN^COUNT - 1;   !COMPENSATE!
  1224. END;
  1225.  
  1226.  
  1227. INT SUBPROC FILL^IN^DATA;
  1228.  
  1229. ! THIS IS THE MAIN INPUT AND OUTPUT BUFFERING SUBPROC !
  1230.  
  1231. BEGIN
  1232.  
  1233. STRING REPEAT;
  1234.  
  1235. WHILE REMAINING^CHARS > 0 DO
  1236.     BEGIN
  1237.     IF IN^COUNT = COUNT^READ THEN
  1238.         BEGIN
  1239.         OUT^OF^INPUT := TRUE;
  1240.         RETURN FALSE;
  1241.         END;
  1242.  
  1243.     REPEAT^COUNT := 0;
  1244.     EIGHT^BIT := 0;
  1245.     CONTROL^CHAR := 0;
  1246.     NEED^QUOTE := 0;
  1247.  
  1248.     CHR := SBUF[IN^COUNT];
  1249.  
  1250.     IF ((CHR LAND %200) <> 0) AND HIS^PARAMS.EIGHT^BIT <> "N" THEN
  1251.         EIGHT^BIT := 1;
  1252.  
  1253.     CHR := CHR LAND %177;
  1254.  
  1255.     IF CHR < " " THEN
  1256.         BEGIN
  1257.         CHR := CTL(CHR);
  1258.         CONTROL^CHAR := 1;
  1259.         END;
  1260.  
  1261.     IF (REPEAT^FLAG AND CHR = HIS^PARAMS.REPEAT^CHAR) OR
  1262.         CHR = HIS^PARAMS.QUOTE^CHAR OR
  1263.         (HIS^PARAMS.EIGHT^BIT <> "N" AND CHR = HIS^PARAMS.EIGHT^BIT) THEN
  1264.         NEED^QUOTE := 1;
  1265.  
  1266.     TOTAL^COUNT := NEED^QUOTE + CONTROL^CHAR + EIGHT^BIT + 1;
  1267.  
  1268.     IF TOTAL^COUNT > REMAINING^CHARS THEN RETURN TRUE;  !SHIP IT!
  1269.  
  1270.     IF REPEAT^FLAG THEN CALL GET^REPEAT(SBUF[IN^COUNT]);
  1271.  
  1272.     IF REPEAT^COUNT <> 0 THEN
  1273.         BEGIN
  1274.         REPEAT := CHAR(REPEAT^COUNT.<8:15>);
  1275.         TOTAL^COUNT := TOTAL^COUNT + 2;
  1276.         OUT^POINTER ':=' HIS^PARAMS.REPEAT^CHAR FOR 1
  1277.                           & REPEAT FOR 1 -> @OUT^POINTER;
  1278.         END;
  1279.  
  1280.     IF EIGHT^BIT <> 0 THEN
  1281.         OUT^POINTER ':=' HIS^PARAMS.EIGHT^BIT FOR 1 -> @OUT^POINTER;
  1282.  
  1283.     IF CONTROL^CHAR <> 0 THEN
  1284.         OUT^POINTER ':=' HIS^PARAMS.QUOTE^CHAR FOR 1 -> @OUT^POINTER;
  1285.  
  1286.     IF NEED^QUOTE <> 0 THEN
  1287.         OUT^POINTER ':=' HIS^PARAMS.QUOTE^CHAR FOR 1 -> @OUT^POINTER;
  1288.  
  1289.     !AND FINALLY THE CHARACTER!
  1290.     OUT^POINTER ':=' CHR FOR 1 -> @OUT^POINTER;
  1291.  
  1292.     IN^COUNT := IN^COUNT + 1;
  1293.  
  1294.     REMAINING^CHARS := REMAINING^CHARS - TOTAL^COUNT;
  1295.  
  1296.     OUT^COUNT := OUT^COUNT + TOTAL^COUNT;
  1297.  
  1298.     END; !WHILE LOOP ON FULL OUTPUT BUFFER!
  1299.  
  1300. RETURN TRUE;   !GO SHIP IT!
  1301. END;    !SUBPROC!
  1302.  
  1303.  
  1304. IF NOT PARSE^FILE^HEADER THEN RETURN;
  1305.  
  1306. IF NOT OPEN^INPUT^FILE THEN RETURN;
  1307.  
  1308. CALL PROCESS^SEND^INIT(MY^PARAMS,"SS",$LEN(PARAMS));
  1309. MY^PARAMS ':=' DEFAUL FOR $LEN(PARAMS);         !RESET DEFAULTS!
  1310. CALL GET^PACKET;
  1311.  
  1312. CHECK^PACKET^D;
  1313.  
  1314. ! GOT SEND INIT REPLY, PROCESS IT. !
  1315. CALL PROCESS^SEND^INIT(IN^BUF^S,"YY",IN^PACKET^LENGTH);
  1316.  
  1317.  
  1318. ! SET UP FILE HEADER !
  1319.  
  1320. OUT^PACKET ':=' [MARK,"LNF"] & ECHO^FILE^NAME FOR ECHO^NAME^LENGTH;
  1321. CALL FINISH^AND^SHIP(ECHO^NAME^LENGTH);
  1322.  
  1323. CHECK^PACKET^D;
  1324.  
  1325. CALL SET^UP^DATA;   !INITIALIZE OUTPUT STRUCTURE!
  1326.  
  1327. WHILE NOT DONE DO
  1328.     BEGIN
  1329.     IF OUT^OF^INPUT THEN
  1330.         BEGIN
  1331.         ERROR := READ^FILE(FILE^FCB,BUF,COUNT^READ);
  1332.         IF ERROR = 1 THEN  !EOF!
  1333.             BEGIN
  1334.             DONE := TRUE;
  1335.             IF OUT^COUNT <> 0 THEN SHIP^FLAG := TRUE;
  1336.             END
  1337.         ELSE
  1338.             IF ERROR <> 0 THEN
  1339.             BEGIN
  1340.             CALL ERROR^PACKET(ERROR);
  1341.             RETURN;
  1342.             END;
  1343.         IF ERROR = 0 THEN @IN^POINTER := @IN^BUF^S;
  1344.  
  1345.         OUT^OF^INPUT := FALSE;
  1346.         ! only for text files
  1347.        !SBUF[COUNT^READ] ':=' [CR,LF];
  1348.        !COUNT^READ := COUNT^READ + 2;
  1349.         IN^COUNT := 0;
  1350.     END;
  1351.  
  1352.     WHILE NOT OUT^OF^INPUT DO IF SHIP^FLAG OR FILL^IN^DATA THEN
  1353.         BEGIN
  1354.         CALL FINISH^AND^SHIP(OUT^COUNT);
  1355.         CHECK^PACKET^D;
  1356.         CALL SET^UP^DATA;
  1357.         END;
  1358.  
  1359.     IF ERROR = 1 THEN
  1360.         BEGIN
  1361.         CLOSE^FILE^D(FILE^FCB);
  1362.  
  1363.         OUT^PACKET ':=' [MARK,"LNZ"];           !EOF PACKET!
  1364.         CALL FINISH^AND^SHIP(0);
  1365.         CHECK^PACKET^D;
  1366.  
  1367.         OUT^PACKET ':=' [MARK,"LNB"];           !BREAK PACKET!
  1368.         CALL FINISH^AND^SHIP(0);
  1369.         CHECK^PACKET^D;
  1370.  
  1371.         END;
  1372.  
  1373.  
  1374.     END; !LOOP!
  1375. END;  !PROC!
  1376. ?PAGE "MAIN PROC"
  1377. PROC KERMIT^SERVER MAIN;
  1378.  
  1379. BEGIN
  1380. LEGAL^PACKETS^D("SIRGCNYE");
  1381. INT DONT^NAK;
  1382.  
  1383. CALL INITIALIZE;
  1384. DONT^NAK := FALSE;
  1385.  
  1386.  
  1387. WHILE 1 DO BEGIN
  1388.     IF DONT^NAK THEN DONT^NAK := FALSE ELSE CALL FORMAT^NAK;
  1389.     WAIT^FOREVER := TRUE;
  1390.     CALL GET^PACKET;
  1391.     CHECK^LEGAL^D;
  1392.     WAIT^FOREVER := FALSE;
  1393.     CASE N OF
  1394.         BEGIN
  1395. !S!     CALL RECEIVE^PROC;
  1396. !I!     BEGIN
  1397.             CALL PROCESS^SEND^INIT(IN^BUF^S,"YY",IN^PACKET^LENGTH);
  1398.             DONT^NAK := TRUE;
  1399.         END;
  1400. !R!     CALL SEND^PROC;
  1401. !G!     DONT^NAK := GENERIC^PROC;
  1402. !C!     CALL COMMAND^PROC;
  1403. !NAK!   ;
  1404. !ACK!   ;
  1405. !ERROR! ;
  1406.         OTHERWISE
  1407.             ERROR^MESSAGE^D("Unexpected Packet Received");
  1408.         END; !CASE!
  1409.         CLOSE^FILE^D(FILE^FCB);
  1410.     END; !FOREVER LOOP!
  1411. END;!MAIN!
  1412.