home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / intelmdsb / mdssvc.p80 < prev    next >
Text File  |  2020-01-01  |  8KB  |  302 lines
  1. $TITLE ('SRVCTL - PROCESS MISCELLANEOUS REMOTE SERVER COMMANDS')
  2. srvctl$module:
  3.  
  4. /* COPYRIGHT (C) 1985, Trustees of Columbia University in the City of New */
  5. /* York.  Permission is granted to any individual or institution to use,  */
  6. /* copy, or redistribute this software so long as it is not sold for      */
  7. /* profit, provided this copyright notice is retained. /*
  8.  
  9. /* Contains the following public routines: */
  10. /*    bye, byehelp, cwd, cwdhelp, finhelp, finish, loghelp, and logout */
  11. do;
  12.  
  13. declare true literally '0FFH';
  14. declare false literally '00H';
  15. declare null literally '000H';
  16. declare cr literally '0DH';
  17. declare lf literally '0AH';
  18. declare bel literally '007H';
  19. declare del literally '07FH';
  20. declare ctly literally '025H';
  21.  
  22. declare state byte external;        /* FSM last state */
  23. declare tries byte external;        /* max number of retries */
  24. declare maxtry byte external;    /* the number of retries to attempt */
  25. declare debug byte external;
  26. declare taking byte external;    /* TRUE if TAKE in effect */
  27.  
  28. declare pksize literally '94';
  29. declare packet(pksize) byte external;
  30.  
  31. declare gencmd(40) byte;        /* text of generic command */
  32.  
  33. newline:    procedure external; end newline;
  34.  
  35. ci: procedure byte external;
  36. end ci;
  37.  
  38. co:    procedure (char) external;
  39.     declare char byte;
  40. end co;
  41.  
  42. nout:    procedure (num) external;
  43.     declare num address;
  44. end nout;
  45.  
  46. token:  procedure address external; end token;
  47.  
  48. prerrpkt:    procedure (pkt) external;
  49.     declare pkt address;
  50. end prerrpkt;
  51.  
  52. tochar:    procedure(char) byte external;
  53.     declare char byte;
  54. end tochar;
  55.  
  56. print:     procedure(string) external;
  57.     declare string address;
  58. end print;
  59.  
  60. spack:    procedure(type, pknum, length, packet) external;
  61.     declare (type, pknum, length, packet) address;
  62. end spack;
  63.  
  64. rpack:    procedure(length, pknum, packet) byte external;
  65.     declare (length, pknum, packet) address;
  66. end rpack;
  67.  
  68. takeline:    procedure(buffer) external;
  69.     declare buffer address;
  70. end takeline;
  71.  
  72. /* BLDLEN: Make a length-encoded string and suffix it to the generic */
  73. /*   command string */
  74. bldlen: procedure(arg, dest) address;
  75.     declare (arg, dest) address;
  76.     declare destptr address;
  77.     declare srcchr based arg byte;
  78.     declare destchr based destptr byte;
  79.     declare len byte;
  80.     declare lastdest address;
  81.  
  82.     len = 0;
  83.     destptr = dest + 1; /* Point to the 1st destination byte */
  84.     do while (srcchr <> null); /* Copy the string */
  85.       destchr = srcchr; /* Copy a byte */
  86.       arg = arg + 1;
  87.       destptr = destptr + 1;
  88.       len = len + 1;
  89.     end;
  90.     destchr = null;
  91.     lastdest = destptr; /* Save final ptr for the return */
  92.     destptr = dest; /* Point to the length field */
  93.     destchr = tochar(len);
  94.     return lastdest;
  95. end bldlen;
  96.  
  97. /* SETGEN: Construct a generic command */
  98. setgen: procedure(type, arg1, arg2, arg3) byte;
  99.     declare type byte;
  100.     declare (arg1, arg2, arg3) address;
  101.     declare (genstart, genptr) address;
  102.     declare genchr based genptr byte;
  103.  
  104.     genstart = .gencmd;
  105.     genptr = genstart;
  106.     genchr = type;  /* Store the command type */
  107.     genptr = genptr + 1;
  108.     genchr = null;
  109.     if (arg1 <> 0) then
  110.       do;
  111.         genptr = bldlen(arg1, genptr); /* Add 1st arg */
  112.         if (arg2 <> 0) then
  113.           do;
  114.             genptr = bldlen(arg2, genptr); /* Add 2nd */
  115.             if (arg3 <> 0) then
  116.               genptr = bldlen(arg3, genptr); /* Add 3rd */
  117.           end;
  118.       end;
  119.     if debug then
  120.       do;
  121.         call print(.('gencmd=$'));
  122.         call print(.gencmd);
  123.         call newline;
  124.       end;
  125.     return (genptr - genstart);
  126. end setgen;
  127.  
  128. /* SENDGEN: Manage the sending of a generic server command packet */
  129. /* Note: This state process does not implement all of the possible */
  130. /*   states which can result from the "send generic command" state. */
  131.  
  132. sendgen:    procedure (cmd, cmdlen);
  133.     declare cmd address;    /* the command to be sent */
  134.     declare cmdlen byte;    /* length of generic command */
  135.     declare (num, length) byte;
  136.  
  137.     if debug then call print(.('sendgen...\$'));
  138.     tries = 0;
  139.     state = 'G';
  140.     do while (state <> 'C' and state <> 'A');
  141.       if debug then
  142.         do;
  143.           call print(.('state=$'));
  144.           call co(state);
  145.           call newline;
  146.         end;
  147.       if state = 'G' then
  148.         do;
  149.           call spack('G', 0, cmdlen, cmd);
  150.           state = rpack(.length, .num, .packet);
  151.         end;
  152.       else
  153.       if state = 'Y' then
  154.         do;
  155.           if packet(0) > 0 then
  156.             do; /* print reply text */
  157.               call print(.packet);
  158.               call newline;
  159.             end;
  160.           state = 'C';
  161.         end;
  162.       else
  163.       if (state = 'N' or state = false) then
  164.         do;
  165.           tries = tries + 1;
  166.           if tries <= maxtry then state = 'G';
  167.           else
  168.             do;
  169.               call spack('E', .num, 20, .('Retry count exceeded'));
  170.               call print(.('Retry count exceeded\$'));
  171.               state = 'A';
  172.             end;
  173.         end;
  174.       else
  175.       if state = 'E' then
  176.         do;
  177.           call prerrpkt(.packet);
  178.           state = 'A';
  179.         end;
  180.       else
  181.         state = 'A';
  182.     end;
  183. end sendgen;
  184.  
  185. /* Display help for the BYE command */
  186. byehelp:    procedure public;
  187.     call print(.('\BYE\\$'));
  188.     call print(.('  The BYE command causes Kermit to shut down and $'));
  189.     call print(.('log out the remote server\$'));
  190.     call print(.('and return to ISIS.\\$'));
  191.     call print(.('Syntax:\\$'));
  192.     call print(.('    BYE\\$'));
  193. end byehelp;
  194.  
  195. /* Display help for the CWD command */
  196. cwdhelp:        procedure public;
  197.     call print(.('\CWD\\$'));
  198.     call print(.('  The CWD command causes the remote server Kermit $'));
  199.     call print(.('to change to the specified\$'));
  200.     call print(.('working directory.  If no directory name is $'));
  201.     call print(.('provided, the server will change\$'));
  202.     call print(.('to the default directory.\\$'));
  203.     call print(.('Syntax:\\$'));
  204.     call print(.('    CWD [remote-directory]\\$'));
  205. end cwdhelp;
  206.  
  207. /* Display help for the FINISH command */
  208. finhelp:    procedure public;
  209.     call print(.('\FINISH\\$'));
  210.     call print(.('  The FINISH command causes Kermit to shut down the $'));
  211.     call print(.('remote server\$'));
  212.     call print(.('without logging it out.\\$'));
  213.     call print(.('Syntax:\\$'));
  214.     call print(.('    FINISH\\$'));
  215. end finhelp;
  216.  
  217. /* Display help for the LOGOUT command */
  218. loghelp:    procedure public;
  219.     call print(.('\LOGOUT\\$'));
  220.     call print(.('  The LOGOUT command causes Kermit to shut down and $'));
  221.     call print(.('log out the remote server.\\$'));
  222.     call print(.('Syntax:\\$'));
  223.     call print(.('    LOGOUT\\$'));
  224. end loghelp;
  225.  
  226. /* BYE: Process a BYE command */
  227. bye:    procedure public;
  228.     call sendgen(.('L'),1);
  229. end bye;
  230.  
  231. /* CWD: Process a (remote) CWD command */
  232. cwd:    procedure public;
  233.     declare (rdir, passwd) address;
  234.     declare passmax literally '20';
  235.     declare passchr(passmax) byte;
  236.     declare passndx byte;
  237.     declare len byte;
  238.  
  239.     passwd = 0;
  240.     rdir = token;
  241.     if rdir <> 0 then /* If directory name given */
  242.       do; /* get password */
  243.         if taking then
  244.           do; /* from "TAKE" file */
  245.             call takeline(.passchr);
  246.             if not taking then
  247.               do; /* Takeline reached end of file */
  248.                 call print(.('take file ends prematurely in $'));
  249.                 call print(.('"cwd"\$'));
  250.                 return;
  251.               end;
  252.           end;
  253.         else
  254.           do; /* from terminal */
  255.             call print(.('Password:$'));
  256.             passndx = 0;
  257.             passchr(passndx) = ci;
  258.             do while (passchr(passndx) <> cr and passchr(passndx) <> lf);
  259.               if passchr(passndx) = del then /* back up */
  260.                 if passndx > 0 then passndx = passndx - 1;
  261.                 else call co(bel); /* none left */
  262.               else
  263.               if passchr(passndx) = ctly then /* start over */
  264.                 passndx = 0;
  265.               else
  266.                 do;
  267.                   passndx = passndx + 1;
  268.                   if passndx >= passmax then
  269.                     do; /* too long */
  270.                       passndx = passndx - 1;
  271.                       call co(bel);
  272.                     end;
  273.                 end;
  274.               passchr(passndx) = ci;
  275.             end;
  276.             call newline;
  277.             passchr(passndx) = null;
  278.           end;
  279.         if debug then
  280.           do;
  281.             call print(.('password=$'));
  282.             call print(.passchr);
  283.             call newline;
  284.           end;    
  285.         if passchr(0) <> null then passwd = .passchr;
  286.       end;
  287.     len = setgen('C',rdir,passwd,0);
  288.     call sendgen(.gencmd,len);
  289. end cwd;
  290.  
  291. /* FINISH: Process a FINISH command */
  292. finish:    procedure public;
  293.     call sendgen(.('F'),1);
  294. end finish;
  295.  
  296. /* LOGOUT: Process a LOGOUT command */
  297. logout:    procedure public;
  298.     call sendgen(.('L'),1);
  299. end logout;
  300.  
  301. end srvctl$module;
  302.