$TITLE ('SEND - HANDLES PACKET TRANSFER BETWEEN LOCAL AND HOST SYSTEM') send$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: */ /* ctl, getc, prerrpkt, putc, rpack, rpar, send, senhelp, spack, */ /* spar, tochar, and unchar */ do; /* Global declarations for the communication module */ declare true literally '0FFH'; declare false literally '00H'; declare port1cmd literally '0F5H'; declare port2cmd literally '0F7H'; declare port1dat literally '0F4H'; declare port2dat literally '0F6H'; declare tx$rdy literally '01H'; declare rx$rdy literally '02H'; declare chrmsk literally '07FH'; 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 soh literally '1'; declare eofl literally '0'; declare delete literally '07FH'; declare myquote literally '023H'; declare mynumpads literally '0'; declare mypadchr literally '0'; declare myeol literally 'cr'; declare mytime literally '5'; declare readonly literally '1'; declare writeonly literally '2'; declare rdwr literally '3'; declare noedit literally '0'; declare pksize literally '94'; declare packet(pksize) byte public; /* buffer for packets */ declare input$and byte external; /* Mask for comm input bytes */ declare output$and byte external; /* Mask for comm output bytes */ declare output$or byte external; /* Mask for comm output bytes */ declare state byte external; /* FSM last state */ declare msgnum byte external; /* message number */ declare tries byte external; /* max number of retries */ /* 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 */ declare pktcnt address; /* tally of good blocks sent */ declare errcnt address; /* tally of error transfers */ 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 localfile(15) byte; /* full name of file on the local disk */ declare remotefile(11) byte; /* file name sent to remote host */ declare fnptr address; declare fnchr based fnptr byte; declare (jfn, status, pklen) address; declare debug byte external; /* here are the subroutines */ exit: procedure external; end exit; co: procedure(char) external; declare char byte; end co; print: procedure(string) external; declare string address; end print; nout: procedure(n) external; declare n address; end nout; ci: procedure byte external; end ci; open: procedure(jfn, filenm, access, mode, status) external; declare (jfn, filenm, access, mode, status) address; end open; read: procedure(jfn, buffer, count, actual, status) external; declare (jfn, buffer, count, actual, status) address; end read; close: procedure(jfn, status) external; declare (jfn, status) address; end close; ready: procedure(port) byte external; declare (port) byte; end ready; newline: procedure external; end newline; token: procedure address external; end token; movevar: procedure(offset, source, dest) byte external; declare offset byte; declare (source, dest) address; end movevar; /* GNXTFN: this routine returns a pointer to the next file in a file */ /* list, or false if there are none. */ gnxtfn: procedure address; filename = token; return (filename > 0); end gnxtfn; /* PUTC: takes a character and a port, waits for transmit ready from */ /* port and then sends the character to it. Doesn't return a result */ putc: procedure (c, port) public; declare (c, status, port) byte; status = 0; do case port; do; call co(c); end; do; do while (status := input(port1cmd) and tx$rdy) = 0; end; output(port1dat) = ((c and output$and) or output$or); end; do; do while (status := input(port2cmd) and tx$rdy) = 0; end; output(port2dat) = ((c and output$and) or output$or); end; end; end putc; /* GETC: this routine waits for something from the receive port then */ /* brings in the character and returns as a result. */ getc: procedure (port) byte public; declare (c, status, port) byte; status = 0; do case port; do; c = ci; end; do; do while status = 0; status = (input(port1cmd) and rx$rdy); end; c = (input(port1dat) and input$and); end; do; do while status = 0; status = (input(port2cmd) and rx$rdy); end; c = (input(port2dat) and input$and); end; end; return c; end getc; /* TOCHAR: takes a character and converts it to a printable character */ /* by adding a space */ tochar: procedure(char) byte public; declare char byte; return (char + space); end tochar; /* UNCHAR: undoes 'tochar' */ unchar: procedure(char) byte public; declare char byte; return (char - space); end unchar; /* CTL: this routine takes a character and toggles the control bit */ /* (ie. ^A becomes A and A becomes ^A). */ ctl: procedure(char) byte public; declare char byte; declare cntrlbit literally '040H'; return (char xor cntrlbit); end ctl; /* Print the contents of an error packet received from the remote host */ prerrpkt: procedure (pkt) public; declare pkt address; declare pkbyte based pkt byte; call print(.(cr,lf,'Error from remote KERMIT',null)); if pkbyte = null then call newline; /* no message text */ else do; /* display the message */ call print(.(':\$')); call print(pkt); end; call newline; end prerrpkt; /* Close the disk input file */ closeup: procedure; call close(jfn, .status); if status > 0 then call print(.('\Unable to close file\$')); end closeup; /* spar: Build a Kermit initialization packet */ spar: procedure (a) public; declare a address; declare b based a byte; b = tochar(pksize); /* set up header */ a = a + 1; b = tochar(mytime); a = a + 1; b = tochar(mynumpads); a = a + 1; b = ctl(mypadchr); a = a + 1; b = tochar(myeol); a = a + 1; b = myquote; end spar; /* rpar: Extract information from a Kermit initialization packet */ rpar: procedure (addr) public; declare addr address; declare item based addr byte; spsize = unchar(item); /* isn't plm wonderful? */ addr = addr + 1; timeint = unchar(item); addr = addr + 1; numpads = unchar(item); addr = addr + 1; padchar = ctl(item); addr = addr + 1; eol = unchar(item); addr = addr + 1; quote = item; end rpar; bufill: procedure (packet) byte; declare packet address; declare (pp, maxpp) address; declare (i, c, done) byte; declare chr based pp byte; declare count address; done = false; pp = packet; maxpp = pp + spsize - 8; do while not done; call read(jfn, .c, 1, .count, .status); if status > 0 then do; call print(.('Error reading file\$')); call exit; end; if count = 0 then done = true; else do; if ((c and chrmsk) < space) or ((c and chrmsk) = delete) then do; chr = quote; pp = pp + 1; chr = ctl(c); end; else if (c and chrmsk) = quote then do; chr = quote; pp = pp + 1; chr = c; end; else chr = c; pp = pp + 1; if pp >= maxpp then done = true; end; end; return (pp - packet); end bufill; /* SPACK: this routine sends a packet of data to the host. It takes */ /* four parameters, the type of packet, message number, packet length */ /* and a pointer to a buffer containing what is to be output. It does */ /* not return a value. */ spack: procedure(type, pknum, length, packet) public; declare (type, pknum, length) byte; declare packet address; declare char based packet byte; declare (i, chksum) byte; if debug then do; call print(.('Sending packet ',null)); call nout(pknum); call print(.(', total packet length is ',null)); call nout(length + 5); /* +5 for soh, count, seq, type, & chksum */ call newline; end; i = 1; /* do padding */ do while (i <= numpads); call putc(padchar, port); if debug then call co('p'); i = i + 1; end; chksum = 0; /* send the packet header */ call putc(soh, port); /* send packet marker (soh) */ if debug then call co('s'); i = tochar(length + 3); chksum = i; call putc(i, port); /* send character count */ if debug then call co('c'); i = tochar(pknum); chksum = chksum + i; /* add in packet number */ call putc(i, port); /* send packet number */ if debug then call co('n'); chksum = chksum + type; /* add in packet type */ call putc(type, port); /* send the packet type */ if debug then call co(type); /* now send the data */ do i = 1 to length; chksum = chksum + char; call putc(char, port); if debug then call co(char); /* was co('.') */ packet = packet + 1; end; /* check sum generation */ chksum = ((chksum + (chksum and 192) / 64) and 63); chksum = tochar(chksum); call putc(chksum, port); /* send the chksum */ if debug then call co('c'); call putc(eol, port); /* terminate the packet */ if debug then do; call print(.('e\$')); call co('.'); end; end spack; /* RPACK: this routine receives a packet from the host. It takes three */ /* parameters: the address of where to put the length of the packet, */ /* the address of where to put the packet number and the address of the */ /* buffer to receive the data. It returns true for a positive reply or */ /* false for a NEGative reply. */ rpack: procedure(length, pknum, packet) byte public; declare (length, pknum, packet, pkptr) address; declare len based length byte; declare num based pknum byte; declare pk based pkptr byte; declare (i, index, chksum, hischksum, type, inchar, msglen) byte; declare buffer(128) byte; if debug then call print(.('rpack | ',null)); inchar = 0; /* wait for a header */ do while inchar <> soh; inchar = getc(port); end; index = 0; inchar = getc(port); do while (inchar <> myeol); buffer(index) = inchar; index = index + 1; inchar = getc(port); end; buffer(index) = null; if debug then do; call print(.('Received packet: [',null)); call print(.buffer); call print(.(']\Length of message: $')); end; msglen = index - 1; if debug then do; call nout(msglen); call newline; call print(.('Length field: $')); call nout(buffer(0)); call co('_'); end; len = unchar(buffer(0)-3); if debug then do; call nout(len); call print(.('\Message number: $')); call nout(buffer(1)); call co('_'); end; num = unchar(buffer(1)); if debug then do; call nout(num); call print(.('\Type: $')); end; type = buffer(2); if debug then do; call co(type); call newline; end; /* debug */ pkptr = packet; chksum = buffer(0) + buffer(1) + buffer(2); i = 3; /* index of first data character */ do while (i < msglen); chksum = (pk := buffer(i)) + chksum; pkptr = pkptr+1; i = i + 1; end; pk = null; /* terminate with null for printing */ chksum = (chksum + ((chksum and 192) / 64)) and 63; if debug then do; call print(.('His checksum: $')); call nout(buffer(msglen)); call co('_'); end; /* debug */ hischksum = unchar(buffer(msglen)); if debug then do; call nout(hischksum); call print(.('\Our checksum: $')); call nout(chksum); call newline; end; /* debug */ if chksum <> hischksum then do; if debug then call print(.('Bad checksum received\$')); return false; end; return type; end rpack; /* SDATA: this routine sends the data from the buffer area to the host. */ /* It takes no parameters but returns the next state depending on the */ /* type of acknowledgement. */ sdata: procedure byte; declare (num, length, retc, retst, c) byte; if debug then call print(.('sdata...\$')); if tries > maxtry then return 'A'; else tries = tries + 1; if ready(0) > 0 then do; /* There is a keystroke ready */ c = getc(0); if (c = 24 or c = 26) then /* ctrl-X or ctrl-Z */ do; call closeup; packet(0) = 'D'; /* Delete this file */ call spack('Z', msgnum, 1, .packet); if c = 26 then /* ctrl-Z means stop all */ do; msgnum = (msgnum + 1) mod 64; return 'B'; end; else do; if gnxtfn = false then /* No more file names */ do; msgnum = (msgnum + 1) mod 64; return 'B'; end; else return 'S'; end; end; end; call spack('D', msgnum, pklen, .packet); retc = rpack(.length, .num, .packet); if (retc = 'N') then do; if (((msgnum + 1) mod 64) = num) then /* NAK for next packet */ retc = 'Y'; /* force into next test */ else do; errcnt = errcnt + 1; retst = state; /* establish return state */ end; end; if (retc = 'Y') then do; tries = 0; pktcnt = pktcnt + 1; msgnum = (msgnum + 1) mod 64; pklen = bufill(.packet); if pklen > 0 then retst = 'D'; else retst = 'Z'; end; else if (retc = 'E') then do; call prerrpkt(.packet); return 'A'; end; else if (retc = false) then retst = state; else return 'A'; /* Report transfer progress */ call print(.(cr,'Packets sent: $')); call nout(pktcnt); call print(.('; number of retries: $')); call nout(errcnt); if debug then call print(.(crlf)); return retst; end sdata; /* SFILE: this routine sends a packet to the host which contains the */ /* filename of the file being sent so that the file can be created at */ /* the host end. It returns a new state depending on the nature of the */ /* the host's acknowledgement. */ sfile: procedure byte; declare (num, length, retc) byte; if debug then call print(.('sfile...\$')); if tries > maxtry then return 'A'; else tries = tries + 1; length = 0; /* count characters in filename */ fnptr = .remotefile; do while fnchr > space; length = length + 1; fnptr = fnptr + 1; end; if debug then call print(.('\Filename is: $')); call print(.localfile); if (filename > 0) then do; call print(.(' to $')); call print(.remotefile); end; call newline; if debug then do; call print(.('File name length is: $')); call nout(length); call newline; end; /* debug */ call spack('F', msgnum, length, .remotefile); retc = rpack(.length, .num, .packet); if (retc = 'N') then return state; if (retc = 'E') then do; call prerrpkt(.packet); return 'A'; end; if (retc <> 'Y') then return 'A'; /* here on valid acknowledgement */ tries = 0; msgnum = (msgnum + 1) mod 64; pktcnt = 0; errcnt = 0; pklen = bufill(.packet); if pklen > 0 then return 'D'; else return 'Z'; end sfile; /* SEOF: this routine is used when eof is detected, it closes up and */ /* returns the new state as usual. */ seof: procedure byte; declare (num, length, retc) byte; if debug then call print(.('seof...\$')); if tries > maxtry then return 'A'; else tries = tries + 1; call spack('Z', msgnum, 0, .packet); retc = rpack(.length, .num, .packet); if (retc = 'N') then return state; if (retc = 'E') then do; call prerrpkt(.packet); return 'A'; end; if (retc <> 'Y') then return 'A'; /* here on valid acknowledgement */ tries = 0; call closeup; if gnxtfn = false then do; msgnum = (msgnum + 1) mod 64; return 'B'; end; else return 'S'; end seof; /* SINIT: this routine does initializations and opens the file to be */ /* sent; it returns a new state depending on the outcome of trying to */ /* open the file. */ sinit: procedure byte; declare (len, num, retc) byte; declare foffset byte; call print(.('\Sending $')); if debug then call print(.('sinit...\$')); if tries > maxtry then return 'A'; else tries = tries + 1; if filename = 0 then return 'A'; call spar(.packet); call spack('S', msgnum, 6, .packet); /* send start packet */ retc = rpack(.len, .num, .packet); if (retc = 'N') then return state; if (retc = 'E') then do; call prerrpkt(.packet); return 'A'; end; if (retc <> 'Y') then return 'A'; /* here on valid acknowledgement */ call rpar(.packet); if eol = 0 then eol = myeol; if quote = 0 then quote = myquote; tries = 0; msgnum = (msgnum + 1) mod 64; /* Crack the file name */ fnptr = filename; if fnchr = ':' then do; /* File name on command has a drive */ foffset = movevar(0,filename,.localfile); /* Use file name as-is */ foffset = movevar(0,filename+4,.remotefile); /* Strip drive */ end; else do; foffset = movevar(0,.def$drive,.localfile); /* Build local file name */ foffset = movevar(foffset,filename,.localfile); /* from default drive */ foffset = movevar(0,filename,.remotefile); end; filename = token; /* Check for second operand */ if (filename > 0) then /* use 2nd operand for remote file name */ foffset = movevar(0,filename,.remotefile); call open(.jfn, .localfile, readonly, noedit, .status); if (status > 0) then do; call print(.('\Cannot open file $')); call print(.localfile); call print(.(crlf)); return 'A'; end; else return 'F'; end sinit; /* SBREAK: this module breaks the flow of control at the end of a */ /* transmission and allows the send routine to terminate by returning */ /* either a successful or failure condition to the main kermit routine. */ sbreak: procedure byte; declare (num, length, retc) byte; if debug then call print(.('sbreak...\$')); if tries > maxtry then return 'A'; else tries = tries + 1; call spack('B', msgnum, 0, .packet); retc = rpack(.length, .num, .packet); if (retc = 'N') then return state; if (retc = 'E') then do; call prerrpkt(.packet); return 'A'; end; if (retc <> 'Y') then return 'A'; /* we only get here if we received a valid acknowledgement */ tries = 0; msgnum = (msgnum + 1) mod 64; return 'C'; end sbreak; /* Display help for the SEND command */ senhelp: procedure public; call print(.('\SEND\\$')); call print(.(' The SEND command causes Kermit to send a file $')); call print(.('to the remote Kermit.\\$')); call print(.('Syntax:\\$')); call print(.(' SEND file [remote-file]\\$')); call print(.('If the "remote-file" is specified, that name will be $')); call print(.('used by the remote\$')); call print(.('Kermit.\\$')); end senhelp; /* SEND: This is the main code for the send command. It is an FSM for */ /* sending files. The main loop calls various routines until it */ /* finishes or an error occurs. */ send: procedure public; filename = token; /* Get the command line file name */ if (filename = 0) then do; call print(.('No files specified\$')); return; end; state = 'S'; /* start in Send-Init state */ msgnum = 0; tries = 0; do while (state <> true and state <> false); if debug then do; call print(.('state : ',null)); call co(state); call newline; end; if state = 'D' then state = sdata; else if state = 'F' then state = sfile; else if state = 'Z' then state = seof; else if state = 'S' then state = sinit; else if state = 'B' then state = sbreak; else if state = 'C' then state = true; else if state = 'A' then state = false; else state = false; end; if state then call print(.('\OK',bel,crlf)); else call print(.('Send failed\$')); end send; end send$module;