$TITLE ('RECV - RECEIVES FILES FROM REMOTE KERMIT') recv$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: */ /* movevar, rdata, ready, rechelp, recv, and rfile */ do; declare true literally '0FFH'; declare false literally '00H'; declare port1cmd literally '0F5H'; declare port2cmd literally '0F7H'; declare rx$rdy literally '02H'; declare null literally '00'; declare cr literally '0DH'; declare lf literally '0AH'; declare crlf literally 'cr,lf,null'; declare bel literally '07H'; declare myquote literally '023H'; declare chrmsk literally '07FH'; declare readonly literally '1'; declare writeonly literally '2'; declare noedit literally '0'; declare state byte external; declare msgnum byte external; declare tries byte external; declare oldtry byte external; declare pktcnt address; declare errcnt address; declare port byte external; declare debug byte external; declare maxtry byte external; declare warning$flag byte external; declare def$drive(5) byte external; declare localname(20) byte; declare filename address external; declare pksize literally '94'; declare packet(pksize) byte external; declare (jfn, count, status) address; /* 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 */ ci: procedure byte external; end ci; csts: procedure byte external; end csts; co: procedure(char)external; declare char byte; end co; print: procedure(string)external; declare string address; end print; nout: procedure(num)external; declare num address; end nout; newline: procedure external; end newline; token: procedure address external; end token; open: procedure(jfn, file, access, mode, status) external; declare (jfn, file, access, mode, status) address; end open; write: procedure(jfn, buffer, count, status) external; declare (jfn, buffer, count, status) address; end write; close: procedure(jfn, status) external; declare (jfn, status) address; end close; delete: procedure(file, status) external; declare (file, status) address; end delete; exit: procedure external; end exit; getc: procedure(port) byte external; declare port byte; end getc; ctl: procedure(char) byte external; declare char byte; end ctl; 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; /* Print an error packet */ prerrpkt: procedure (pkt) external; declare pkt address; end prerrpkt; /* Move a variable string from source to dest until a null is found. */ /* The value of offset defines the starting point in dest of the move */ movevar: procedure (offset, source, dest) byte public; declare offset byte; declare (source, dest) address; declare schr based source byte; declare dchr based dest byte; dest = dest + offset; do while schr <> null; dchr = schr; source = source + 1; dest = dest + 1; offset = offset + 1; end; dchr = null; /* append a null */ return offset; end movevar; /* Alter the local file name in an effort to create a unique name */ altername: procedure (flname); declare flname address; declare (fnchar based flname)(20) byte; declare (basestart, perloc, stopper) byte; declare (adjusted, offset) byte; declare (i, j) byte; /* Locate the start of the root name */ if fnchar(0) = ':' then basestart = 4; /* skip drive spec */ else basestart = 0; i = basestart; perloc = 0; do while fnchar(i) <> null; if fnchar(i) = '.' then /* found a period */ if perloc = 0 then perloc = i; i = i + 1; end; stopper = i; if perloc = 0 then do; /* name has no extension, so add an extension of "0" */ fnchar(stopper) = '.'; fnchar(stopper+1) = '0'; fnchar(stopper+2) = null; stopper = stopper + 2; end; else if (perloc - basestart) < 6 then do; /* the base name is shorter than 6 chars */ i = stopper; do while i >= perloc; /* shift the extension right 1 char */ fnchar(i+1) = fnchar(i); i = i - 1; end; fnchar(perloc) = '0'; /* insert a zero before the period */ perloc = perloc + 1; /* Adjust the */ stopper = stopper + 1; /* pointers */ end; else if (stopper - perloc) < 4 then do; /* Extension is short, so add a zero */ fnchar(stopper) = '0'; stopper = stopper + 1; fnchar(stopper) = null; end; else /* Both parts of the name are full */ do; i = perloc - 1; /* point to end of base name */ adjusted = false; do while not adjusted; if fnchar(i) < 'Z' then do; fnchar(i) = fnchar(i) + 1; adjusted = true; end; else if fnchar(i) >= 'a' and fnchar(i) < 'z' then do; fnchar(i) = fnchar(i) + 1; adjusted = true; end; else do; if i <= basestart then i = stopper - 1; else i = i - 1; if i = perloc then do; offset = movevar(0, .('A00000.000',null), flname); adjusted = true; end; end; end; end; end altername; /* Find a local file name which doesn't conflict with existing files */ find$good$name: procedure (flname); declare flname address; declare successful byte; successful = false; do while not successful; call altername(flname); call open(.jfn, flname, readonly, noedit, .status); if status = 0 then call close(jfn, .status); /* still a duplicate */ else successful = true; end; end find$good$name; ready: procedure (port) byte public; declare (port, status) byte; do case port; do; status = csts; end; do; status = input(port1cmd) and rx$rdy; end; do; status = input(port2cmd) and rx$rdy; end; end; return status; end ready; bufemp: procedure(packet, len); declare packet address; declare inchar based packet byte; declare (i, char, len) byte; if debug then call print(.('Writing to disk...',null)); i = 0; do while (i < len); char = inchar; if char = myquote then do; packet = packet + 1; i = i + 1; char = inchar; if (char and chrmsk) <> myquote then char = ctl(char); end; if debug then call co(char); call write(jfn, .char, 1, .status); if status > 0 then do; call print(.('Write error ',null)); call nout(status); call newline; call exit; end; packet = packet + 1; i = i + 1; end; if debug then call newline; end bufemp; rinit: procedure byte; declare (len, num, retc) byte; if tries > maxtry then return 'A'; else tries = tries + 1; if debug then call print(.('rinit...',crlf)); retc = rpack(.len, .num, .packet); if (retc = 'S') then /* send init received */ do; call rpar(.packet); call spar(.packet); call spack('Y', msgnum, 6, .packet); oldtry = tries; tries = 0; msgnum = (msgnum + 1) mod 64; return 'F'; end; if (retc = 'E') then do; /* Error packet received */ call prerrpkt(.packet); return 'A'; end; if (retc = false) then do; call spack('N', msgnum, 0, 0); return state; end; return 'A'; end rinit; rfile: procedure byte public; 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(.('rfile...',crlf)); retc = rpack(.len, .num, .packet); if retc = 'S' then do; if (oldtry > maxtry) then return 'A'; else oldtry = oldtry + 1; if (((num + 1) mod 64) = msgnum) then /* previous packet again */ do; call spar(.packet); call spack('Y', num, 6, .packet); /* re-ACK it */ tries = 0; return state; end; else return 'A'; end; if retc = 'Z' then do; if (oldtry > maxtry) then return 'A'; else oldtry = oldtry + 1; if (num = msgnum - 1) then do; call spack('Y', num, 0, 0); tries = 0; return state; end; else return 'A'; end; if retc = 'F' then do; if (num <> msgnum) then return 'A'; call print(.(cr,lf,'Receiving ',null)); /* Construct the (local) ISIS file name */ if (filename = 0) then /* Use the remote name if no operand */ do; foffset = movevar(0,.def$drive,.localname); foffset = movevar(foffset,.packet,.localname); end; else do; call print(.packet); call print(.(' to $')); fnptr = filename; if fnchr = ':' then /* File name on command line has a drive */ foffset = movevar(0, filename, .localname); else do; /* Build file name from default drive */ foffset = movevar(0, .def$drive, .localname); foffset = movevar(foffset, filename, .localname); end; end; call print(.localname); call print(.(crlf)); if warning$flag then do; /* Check for a pre-existing local file */ call open(.jfn, .localname, readonly, noedit, .status); if status = 0 then do; /* the file already exists */ call close(jfn, .status); call find$good$name(.localname); /* Mod file name */ call print(.('Using local file name of $')); call print(.localname); call print(.('; other name already in use.\$')); end; end; call open(.jfn, .localname, writeonly, noedit, .status); if status > 0 then do; call print (.('Unable to create file, error ', null)); call nout(status); call newline; return 'A'; end; call spack('Y', msgnum, 0, 0); oldtry = tries; tries = 0; msgnum = (msgnum + 1) mod 64; pktcnt = 0; errcnt = 0; return 'D'; end; if retc = 'B' then do; if (num <> msgnum) then return 'A'; call spack('Y', msgnum, 0, 0); return 'C'; end; if retc = 'E' then do; /* Error packet received */ call prerrpkt(.packet); return 'A'; end; return state; end rfile; rdata: procedure byte public; declare (num, len, retc, retst, c) byte; if tries > maxtry then return 'A'; else tries = tries + 1; if debug then call print(.('rdata...',crlf)); retc = rpack(.len, .num, .packet); if retc = 'D' then do; if (num <> msgnum) then do; if (oldtry > maxtry) then return 'A'; oldtry = oldtry + 1; if (((num + 1) mod 64) = msgnum) then /* prev packet again */ do; call spar(.packet); call spack('Y', num, 6, .packet); /* re-ACK it */ tries = 0; retst = state; end; else return 'A'; end; else do; /* correct packet */ call bufemp(.packet, len); if ready(0) = 0 then /* no console input */ call spack('Y', msgnum, 0, 0); else do; /* There is a keystroke ready */ c = getc(0); if (c = 24 or c = 26) then /* ctrl-X or ctrl-Z */ do; /* Send the char with the ACK */ packet(0) = ctl(c); call spack('Y', msgnum, 1, .packet); end; else /* Ignore the keystroke */ call spack('Y', msgnum, 0, 0); end; oldtry = tries; pktcnt = pktcnt + 1; tries = 0; msgnum = (msgnum + 1) mod 64; retst = 'D'; end; end; else if retc = 'F' then do; if (oldtry > maxtry) then return 'A'; else oldtry = oldtry + 1; if (num = msgnum - 1) then do; call spack('Y', num, 0, 0); tries = 0; retst = state; end; else return 'A'; end; else if retc = 'Z' then do; if (num <> msgnum) then return 'A'; call spack('Y', msgnum, 0, 0); call close(jfn, .status); if status > 0 then call print(.(cr,lf,'Unable to close file',null)); if len > 0 then /* There was data with the packet */ if packet(0) = 'D' then do; /* File deletion requested by remote Kermit */ call delete(.localname, .status); if status = 0 then do; call print(.(cr,lf,'File $')); call print(.localname); call print(.(' deleted on request from remote Kermit',crlf)); end; else call print(.('Requested file delete failed',crlf)); end; msgnum = (msgnum + 1) mod 64; retst = 'F'; end; else if retc = 'E' then /* Error packet received */ do; call prerrpkt(.packet); return 'A'; end; else if retc = false then /* Reception error */ do; errcnt = errcnt + 1; call spack('N', msgnum, 0, 0); retst = state; end; if retst <> 'A' and retst <> 'F' then do; /* Report transfer progress */ call print(.(cr,'Packets received: $')); call nout(pktcnt); call print(.('; number of retries: $')); call nout(errcnt); if debug then call print(.(crlf)); end; return retst; end rdata; /* Display help for the RECEIVE command */ rechelp:procedure public; call print(.('\RECEIVE\\$')); call print(.(' The RECEIVE command causes KERMIT to wait for $')); call print(.('a file to be sent by the\$')); call print(.('remote Kermit.\\$')); call print(.('Syntax:\\$')); call print(.(' RECEIVE [local-file]\\$')); call print(.('If the "local-file" is not specified, Kermit will $')); call print(.('name the local file with\$')); call print(.('the file name sent by the remote Kermit.\\$')); end rechelp; recv: procedure public; if debug then call print(.('Receive a file',crlf)); state = 'R'; msgnum = 0; tries = 0; oldtry = 0; filename = token; /* Capture operand, if any */ do while (state <> true and state <> false); if state = 'D' then state = rdata; else if state = 'F' then state = rfile; else if state = 'R' then state = rinit; else if state = 'C' then state = true; else state = false; end; if state then call print(.('\OK',bel,crlf)); else call print(.('receive failed\$')); end recv; end recv$module;