home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
archives
/
intelmdsb.zip
/
mdsget.p80
< prev
next >
Wrap
Text File
|
1988-08-16
|
6KB
|
232 lines
$TITLE ('GET - REQUEST FILES FROM A REMOTE SERVER KERMIT')
get$module:
/* COPYRIGHT (C) 1985, Trustees of Columbia University in the City of New */
/* York. Permission is granted to any individual or institution to use, */
/* copy, or redistribute this software so long as it is not sold for */
/* profit, provided this copyright notice is retained. /*
/* Contains the following public routines: */
/* get, gethelp */
do;
declare true literally '0FFH';
declare false literally '00H';
declare space literally '020H';
declare cr literally '0DH';
declare lf literally '0AH';
declare null literally '00H';
declare crlf literally 'cr,lf,null';
declare bel literally '07H';
declare pksize literally '94';
declare packet(pksize) byte external; /* buffer for packets */
declare state byte external; /* FSM last state */
declare msgnum byte external; /* message number */
declare tries byte external; /* max number of retries */
declare oldtry byte external;
declare port byte external; /* the port to use */
declare maxtry byte external; /* the number of retries to attempt */
declare def$drive(5) byte external; /* the default local drive */
declare filename address external; /* the address of the filename */
declare (count, status, pklen) address;
declare myquote literally '023H';
declare myeol literally 'cr';
declare chrmsk literally '07FH';
declare fullname(20) byte;
declare remotefile(20) byte;
declare debug byte external;
/* Current Kermit parameters */
declare spsize byte external; /* the present packet size */
declare timeint byte external; /* the present time out */
declare numpads byte external; /* how many pads to send */
declare padchar byte external; /* the present pad character */
declare eol byte external; /* the present eol character */
declare quote byte external; /* the present quote character */
/* here are the subroutines */
print: procedure(string)external;
declare string address;
end print;
newline: procedure external; end newline;
token: procedure address external; end token;
nout: procedure (n) external;
declare n address;
end nout;
movevar: procedure (offset, source,dest) byte external;
declare offset byte;
declare (source, dest) address;
end movevar;
spack: procedure(type, pknum, length, packet) external;
declare (type, pknum, length, packet) address;
end spack;
rpack: procedure(length, pknum, packet) byte external;
declare (length, pknum, packet) address;
end rpack;
spar: procedure (a) external;
declare a address;
end spar;
rpar: procedure (a) external;
declare a address;
end rpar;
rfile: procedure byte external;
end rfile;
rdata: procedure byte external;
end rdata;
/* SSINIT: Send a server initialization packet */
ssinit: procedure byte;
declare (len, num, retc) byte;
if tries > maxtry then return 'A';
else tries = tries + 1;
if debug then call print(.('ssinit...\$'));
call spar(.packet);
call spack('I', msgnum, 6, .packet); /* send init packet */
retc = rpack(.len, .num, .packet);
if (retc = 'N') then return state;
if (retc = 'E') then
do; /* Error packet received, so use default params */
eol = myeol;
quote = myquote;
return 'R';
end;
if (retc <> 'Y') then return 'A';
/* Process params */
call rpar(.packet);
if eol = 0 then eol = myeol;
if quote = 0 then quote = myquote;
oldtry = tries;
tries = 0;
return 'R';
end ssinit;
/* SGCMD: Send the server GET command */
sgcmd: procedure byte;
declare (len, num, retc) byte;
declare foffset byte;
declare fnptr address;
declare fnchr based fnptr byte;
if tries > maxtry then return 'A';
else tries = tries + 1;
if debug then call print(.('sgcmd...\$'));
/* Crack the file name */
fnptr = filename;
if fnchr = ':' then /* File name on command has a drive */
foffset = movevar(0,filename+4,.remotefile); /* Strip drive */
else
foffset = movevar(0,filename,.remotefile);
len = 0; /* count characters in filename */
fnptr = .remotefile;
do while fnchr > space;
len = len + 1;
fnptr = fnptr + 1;
end;
if debug then do;
call print(.('File name length is: ',null));
call nout(len);
call newline;
end; /* debug */
call spack('R', msgnum, len, .remotefile);
retc = rpack(.len, .num, .packet);
if (retc = 'S') then
do; /* process params */
call rpar(.packet);
if eol = 0 then eol = myeol;
if quote = 0 then quote = myquote;
call spar(.packet);
call spack('Y', msgnum, 6, .packet); /* Ack w/params */
msgnum = (msgnum + 1) mod 64;
oldtry = tries;
tries = 0;
filename = token; /* retrieve possible 2nd operand */
return 'F';
end;
if (retc = 'N' or retc = false) then return state;
return 'A';
end sgcmd;
/* Display help for the GET command */
gethelp:procedure public;
call print(.('\GET\\$'));
call print(.(' The GET command requests a specific file from the $'));
call print(.('remote server.\\$'));
call print(.('Syntax:\\$'));
call print(.(' GET file [local-file]\\$'));
call print(.('If the "local-file" is not specified, Kermit $'));
call print(.('will name the local file\$'));
call print(.('with the file name sent by the remote Kermit.\\$'));
end gethelp;
/* GET: This is the main code for the get command. It is an FSM for */
/* requesting files from a remote server. The main loop calls various */
/* routines until it finishes or an error occurs; this is signified by */
/* a true or false result being returned to the main 'kermit' routine. */
get: procedure public;
if debug then call print(.('Get a file\$'));
state = 'I';
msgnum = 0;
tries = 0;
oldtry = 0;
filename = token;
if (filename = 0) then
do;
call print(.('No files specified\$'));
return;
end;
do while (state <> true and state <> false);
if state = 'D' then state = rdata;
else
if state = 'I' then state = ssinit;
else
if state = 'F' then state = rfile;
else
if state = 'R' then state = sgcmd;
else
if state = 'C' then state = true;
else state = false;
end;
if state then call print(.('\OK',bel,crlf));
else call print(.('get failed\$'));
end get;
end get$module;