home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / intelmdsb / mdsget.p80 < prev    next >
Text File  |  2020-01-01  |  6KB  |  232 lines

  1. $TITLE ('GET - REQUEST FILES FROM A REMOTE SERVER KERMIT')
  2. get$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. /*   get, gethelp  */
  11. do;
  12.  
  13. declare true literally '0FFH';
  14. declare false literally '00H';
  15.  
  16. declare space literally '020H';
  17. declare cr literally '0DH';
  18. declare lf literally '0AH';
  19. declare null literally '00H';
  20. declare crlf literally 'cr,lf,null';
  21. declare bel literally '07H';
  22.  
  23. declare pksize literally '94';
  24. declare packet(pksize) byte external;    /* buffer for packets */
  25.  
  26. declare state byte external;        /* FSM last state */
  27. declare msgnum byte external;        /* message number */
  28. declare tries byte external;        /* max number of retries */
  29. declare oldtry byte external;
  30.  
  31. declare port byte external;        /* the port to use */
  32. declare maxtry byte external;    /* the number of retries to attempt */
  33. declare def$drive(5) byte external;     /* the default local drive */
  34. declare filename address external;    /* the address of the filename */
  35. declare (count, status, pklen) address;
  36.  
  37. declare myquote literally '023H';
  38. declare myeol literally 'cr';
  39. declare chrmsk literally '07FH';
  40.  
  41. declare fullname(20) byte;
  42. declare remotefile(20) byte;
  43.  
  44. declare debug byte external;
  45.  
  46. /* Current Kermit parameters */
  47. declare spsize byte external;    /* the present packet size */
  48. declare timeint byte external;    /* the present time out */
  49. declare numpads byte external;    /* how many pads to send */
  50. declare padchar byte external;    /* the present pad character */
  51. declare eol byte external;        /* the present eol character */
  52. declare quote byte external;    /* the present quote character */
  53.  
  54. /* here are the subroutines */
  55.  
  56. print:  procedure(string)external;
  57.     declare string address;
  58. end print;
  59.  
  60. newline: procedure external; end newline;
  61.  
  62. token:    procedure address external;    end token;
  63.  
  64. nout:    procedure (n) external;
  65.     declare n address;
  66. end nout;
  67.  
  68. movevar:    procedure (offset, source,dest) byte external;
  69.     declare offset byte;
  70.     declare (source, dest) address;
  71. end movevar;
  72.  
  73. spack:     procedure(type, pknum, length, packet) external;
  74.     declare (type, pknum, length, packet) address;
  75. end spack;
  76.  
  77. rpack:     procedure(length, pknum, packet) byte external;
  78.     declare (length, pknum, packet) address;
  79. end rpack;
  80.  
  81. spar:    procedure (a) external;
  82.     declare a address;
  83. end spar;
  84.  
  85. rpar:    procedure (a) external;
  86.     declare a address;
  87. end rpar;
  88.  
  89. rfile:    procedure byte external;
  90. end rfile;
  91.  
  92. rdata:    procedure byte external;
  93. end rdata;
  94.  
  95.  
  96. /* SSINIT: Send a server initialization packet */
  97. ssinit:    procedure byte;
  98.     declare (len, num, retc) byte;
  99.  
  100.     if tries > maxtry then return 'A';
  101.     else tries = tries + 1;
  102.  
  103.     if debug then call print(.('ssinit...\$'));
  104.  
  105.     call spar(.packet);
  106.     call spack('I', msgnum, 6, .packet);    /* send init packet */
  107.  
  108.     retc = rpack(.len, .num, .packet);
  109.  
  110.     if (retc = 'N') then return state;
  111.  
  112.     if (retc = 'E') then
  113.       do; /* Error packet received, so use default params */
  114.         eol = myeol;
  115.         quote = myquote;
  116.         return 'R';
  117.       end;
  118.  
  119.     if (retc <> 'Y') then return 'A';
  120.  
  121.     /* Process params */
  122.     call rpar(.packet);
  123.     if eol = 0 then eol = myeol;
  124.     if quote = 0 then quote = myquote;
  125.     oldtry = tries;
  126.     tries = 0;
  127.     return 'R';
  128.  
  129. end ssinit;
  130.  
  131. /* SGCMD: Send the server GET command */
  132. sgcmd:    procedure byte;
  133.     declare (len, num, retc) byte;
  134.     declare foffset byte;
  135.     declare fnptr address;
  136.     declare fnchr based fnptr byte;
  137.  
  138.     if tries > maxtry then return 'A';
  139.     else tries = tries + 1;
  140.  
  141.     if debug then call print(.('sgcmd...\$'));
  142.  
  143.     /* Crack the file name */
  144.     fnptr = filename;
  145.     if fnchr = ':' then /* File name on command has a drive */
  146.       foffset = movevar(0,filename+4,.remotefile); /* Strip drive */
  147.     else
  148.       foffset = movevar(0,filename,.remotefile);
  149.  
  150.     len = 0;            /* count characters in filename */
  151.     fnptr = .remotefile;
  152.     do while fnchr > space;
  153.       len = len + 1;
  154.       fnptr = fnptr + 1;
  155.     end;
  156.     if debug then do;
  157.       call print(.('File name length is: ',null));
  158.       call nout(len);
  159.       call newline;
  160.     end; /* debug */
  161.     call spack('R', msgnum, len, .remotefile);
  162.     retc = rpack(.len, .num, .packet);
  163.  
  164.     if (retc = 'S') then
  165.       do; /* process params */
  166.         call rpar(.packet);
  167.         if eol = 0 then eol = myeol;
  168.         if quote = 0 then quote = myquote;
  169.         call spar(.packet);
  170.         call spack('Y', msgnum, 6, .packet);    /* Ack w/params */
  171.         msgnum = (msgnum + 1) mod 64;
  172.         oldtry = tries;
  173.         tries = 0;
  174.         filename = token; /* retrieve possible 2nd operand */
  175.         return 'F';
  176.       end;
  177.  
  178.     if (retc = 'N' or retc = false) then return state;
  179.  
  180.     return 'A';
  181.  
  182. end sgcmd;
  183.  
  184. /* Display help for the GET command */
  185. gethelp:procedure public;
  186.     call print(.('\GET\\$'));
  187.     call print(.('  The GET command requests a specific file from the $'));
  188.     call print(.('remote server.\\$'));
  189.     call print(.('Syntax:\\$'));
  190.     call print(.('    GET file [local-file]\\$'));
  191.     call print(.('If the "local-file" is not specified, Kermit $'));
  192.     call print(.('will name the local file\$'));
  193.     call print(.('with the file name sent by the remote Kermit.\\$'));
  194. end gethelp;
  195.  
  196. /* GET: This is the main code for the get command.  It is an FSM for    */
  197. /* requesting files from a remote server. The main loop calls various */
  198. /* routines until it finishes or an error occurs; this is signified by */
  199. /* a true or false result being returned to the main 'kermit' routine. */
  200.  
  201. get:   procedure public;
  202.  
  203.     if debug then call print(.('Get a file\$'));
  204.     state = 'I';
  205.     msgnum = 0;
  206.     tries = 0;
  207.     oldtry = 0;
  208.     filename = token;
  209.     if (filename = 0) then
  210.       do;
  211.         call print(.('No files specified\$'));
  212.         return;
  213.       end;
  214.     do while (state <> true and state <> false);
  215.       if state = 'D' then state = rdata;
  216.       else
  217.         if state = 'I' then state = ssinit;
  218.         else
  219.           if state = 'F' then state = rfile;
  220.           else
  221.             if state = 'R' then state = sgcmd;
  222.             else
  223.               if state = 'C' then state = true;
  224.               else state = false;
  225.     end;
  226.     if state then call print(.('\OK',bel,crlf));
  227.     else call print(.('get failed\$'));
  228.  
  229. end get;
  230.  
  231. end get$module;
  232.