#-h- kermit.def 66 ascii 05/30/84 23:45:46 # kermitde ---- defines for kermit # # # Parameters which may need to be changed for your machine: # MAXPACK, BRKCHR, MY... # defines normally in ratdef: define(NULL,NUL) # ASCII NUL #define(SOH,1) # Start of header #define(SP,32) # ASCII space #define(CR,13) # ASCII Carriage Return #define(SHARP,35) #define(DEL,127) # Delete (rubout) #define(strcpy,scopy($1,1,$2,1)) # already defined on many systems # this kermit's init parameters define(MAXPACK,94) # Maximum incoming packet size (max 94) define(MYTIME,10) # Seconds after which I should be timed out define(MYPAD,0) # Number of padding characters I will need (max 94) define(MYPCHAR,NULL) # Padding character I need define(MYEOL,CR) # End-Of-Line character I need define(MYQUOTE,SHARP) # Quote character I will use define(MYBQUOTE,AMPER) # Eighth-bit quote char: BLANK => none define(MYREPTC,TILDE) # Repeat prefix: BLANK => none define(MYCHECK,DIG1) # Checksum type: DIG1 => default define(MYCAPS,arith(CAP_TIMO,+,CAP_SERV)) # capability mask define(CAP_TIMO,8%40) # I can timeouts: 0 => no, 8%40 => yes define(CAP_SERV,8%20) # I have server mode: 0 => no, 8%20 => yes define(INIT_SIZ,10) # number of parameters we will look at in an init pak define(MAXTIM,30) # Maximum timeout interval define(MINTIM,2) # Minumum timeout interval define(MAXTRY,5) # Times to retry a packet define(ESCCHR,CARET) # connect mode escape char define(MAXLIN,100) # Size of packet buffers define(MAXNAM,FILENAMESIZE) # Maximum name file name length define(PBSIZE,3) # Pushback buffer size # U1100 DEPENDENT #define(MAGIC,283) # Magic character for seting raw mode #1100 #define(CTRL_B,2) # ASCII Ctrl_B #define(PADU,511) # Univac padding character #1100 #define(CTRLD,4) #define(ESCCHR,CTRLD) # Default break-connection character #define(NUMOPTS,5) # Number of possible command line options # END # program macros define(tochar,($1+BLANK)) # convert a control char to a printing one define(unchar,($1-BLANK)) # undo tochar define(INCR, $1 = $1 + 1) # Incrementer for counter variables define(CHCOPY,{$2($3)=$1;$3=$3+1;$2($3)=EOS}) # appends a char onto a string define(cant3s,prints($4,"Can't open file '%s'@n.", $3)) define(eprintf,printf(ERROUT,$1,$2,$3,$4,$5,$6,$7,$8,$9)) # HP3000 DEPENDENT define(cchar,kermitc1) define(cint,kermitc2) define(cpb,kermitc3) define(quit,quitit) # to avoid name collision define(TERMTYPE,13) # 13 for anything but a Series 33 # use 4 for Series 33 # END define(DUM,0) # used only as dummy argument #-t- kermit.def 66 ascii 05/30/84 23:45:46 #-h- kermit.c1 20 ascii 05/30/84 23:45:47 # kermitc1 --- common cchar # # Global characters # common/Cchar/ state, padchar, eol, escchr, quotec, bquote, reptc, lastpk, filnam(MAXNAM), recpkt(MAXLIN), packet(MAXLIN),msghdr(MAXLINE) character state # Present state of the automaton character padchar # Padding character to send character eol # End-Of-Line character to send character escchr # Connect command escape character character quotec # Incoming quote character for control chars character bquote # Incoming quote character for 8th-bit character reptc # Incoming repeat prefix character character lastpk # Last received packet type character filnam # current file name character recpkt # Receive packet buffer character packet # Packet buffer character msghdr # Message header #-t- kermit.c1 20 ascii 05/30/84 23:45:47 #-h- kermit.c2 40 ascii 05/30/84 23:45:47 # kermitc2 --- cint # # Global Variables # common /Cint/ size, n, rpsiz, spsiz, pad, timint, numtry, oldtry, fd, lfdin, lfdout, image, remspd, remote, debug, eoflg, srvflg, sflg, rflg, dobquo, dorept, xonwait, imgflg, binfil, crpend, ttype, swait, mypad, nofilconv integer size # Size of present data integer n # Message number integer rpsiz # Maximum receive packet size integer spsiz # Maximum send packet size integer pad # How much padding to send integer timint # Timeout for foreign host on sends integer numtry # Times this packet retried integer oldtry # Times previous packet retried filedes fd # file pointer of file to read/write filedes lfdin # line file descriptor for reads filedes lfdout # line file descriptor for writes integer image # YES means 8-bit mode integer remspd # speed of this tty integer remote # YES means we're a remote host kermit integer debug # YES means debugging integer eoflg # EOF flag for Send Data state integer srvflg # Flag for server mode integer sflg # Flag for send mode integer rflg # Flag for receive mode integer dobquo # YES => do 8th bit quoting integer dorept # YES => do repeat prefixing integer xonwait # YES => wait for XON before each packet send integer imgflg # YES => image-mode command flag set integer binfil # YES => do 8 bit i/o on this file integer crpend # YES => CR pending in bufemp # HP3000 DEPENDENT: integer ttype # save terminal type at startup integer swait # milliseconds to wait after sending packet integer mypad # number of pad characters to request integer nofilconv # YES => DON'T do incoming filename conversion #-t- kermit.c2 40 ascii 05/30/84 23:45:47 #-h- kermit.c3 6 ascii 05/30/84 23:45:48 ## cdefs --- preprocessor common block to hold input characters # on kermitc3 on HP 3000 common /Cpb/ bp, buf(PBSIZE) integer bp # next available character; init = 0 character buf # pushed-back characters #-t- kermit.c3 6 ascii 05/30/84 23:45:48 #-h- kermit.r 2486 ascii 05/30/84 23:45:50 #-h- main 5603 local 01/18/84 08:53:22 # # K E R M I T file transfer utility. # # Kendall Tidwell & Allen Cole, University of Utah Computer Center # # # When Kermit is invoked without arguments it defaults to a Kermit server. # The 's' argument invokes Kermit in the send state and must be followed # by the file(s) that are to be sent. The 'r' puts Kermit in the receive # state. The 'r' option is not necessary since the Kermit server will # handle both sending and receiveing. The Kermit server however, cannot # send more than one file at a time. Thus, when sending more than one # file it may be desireable to use the 's' option. # define(BANNER,"Software Tools Kermit (HP 3000) Version 1n") define(USAGE,"usage: kermit [rdif] [sdif [file [-as name]]@.@.@.] [dif].") # ifnotdef HP3000: [rdifx] [sdifx [file [-as name]]...] [difx] # # # Revision History: (3 => change for HP3000, p => portable change) # # 5-18-84 kp fixed prmsg to include cchar (for msghdr) # 1n fixed rpack, gnxtfl, quiti to use msghdr # # 5-2-84 kp 3 changed setraw to explicitly turn off parity generation # 1m required on Series III hardware # changed banner somewhat # # 4-27-84 kp 3 updated usage message # 1l fixed gnxtfl to not try name translation on 'send' files # added error messages for nearly every possible failure # new routine failmsg, called from recsw and sendsw # separated failures into retrys, wrong pkt number, # wrong packet type, other # added file closing for aborted transfers: # recsw, sendsw, server # changed recsw to delete incompletely transferred files # added message upon server startup # added 'f' flag: prevents incoming name translation # # 4-24-84 kp 3 fixed errors in doc file on use of 'x' # # 4-19-84 kp 3 changed rfile and gnxtfl to use new cant3s for better # 1k error messages # # 4-15-84 kp p changed outnam to uppercase outgoing filenames # 1j ("-as name" not affected) # made server error messages better # moved BANNER and USAGE macros to source file # # 4-2-84 kp 3 redid filename truncation algorithm (truncate) # 1i 3 added message for control-y (interrupt) termination # p deleted Univac DBLINE debugging stuff # # 3-18-84 kp p changes to bufill, bufemp, ctl and rpack to use parity bit when # 1h sending/receiving binary files # p fixed bufemp: crpend flag was not reset before starting out # p changed getfil to OVERWRITE OLD FILES # p minor fix to gnxtfl error msg # # 3-16-84 kp p added new routines for error packet handling: # 1g errpkt prints out error packets, errmsg sends error # packets (or prints, if local), prmsg prints a message # p consolidated file opening code from sinit, seof, main # into gnxtfl # p added -as flag for the send command # # 3-14-84 kp p redid some of bufill and bufemp: # 1f bufemp recognizes CR-LF's split across packets (for DEC_20) # CR-LFs are not subject to repeat prefixes # NEWLINE <--> CR-LF mapping turned off for binary files # 3 added binary file support: '8' flag, checks on file type # not tested yet # 3 changed setraw to check isatty before calling ffcontrol # 3 put termtype 13 into define TERMTYPE # # 3-11-84 kp p added debug code (a la Unix kermit) # 1e p fixed filename bug in server that made 'send' command fail # p added pbinit routine # # 3-9-84 kp p changed TRUE -> YES, FALSE -> NO # 1d p added eighth-bit quoting and repeat prefixing: # rewrote bufill and bufemp # added globals reptc, dorept, dobquo; deleted eoflg # p fixed inverted use of MYQUOTE and quote in bufil and bufemp # Unix version is also wrong, see protocol manual # p fixed ctl (didn't work on DEL) # p redid mask portably using mod function # p redid chksum portably using mod function # p added 'x' option for talking with 3000's and IBM's # Causes wait for DC1 (^Q) before sending out a packet # in spack. Not tested. # p put program pause into system-dependent routine sleepm # # 2-29-84 kp 3 rewrote filename munging routines for HP3000: # 1c innam, outnam, chgnam, validate, truncate # p changed all usage of chgnam and innam to first # try the 'raw' filename, and then try the munged name: # rfile, seof, sinit, server # p changed gnxtfl to call delarg only if there is one # p changed getfil to NOT overwrite pre-existing files # rfile sends back a message if this condition occurs # p changed routine lderr into routine erpack, which concatenates # two error messages together and sends them out as an # error packet # # 2-16-84 kp PORT TO HP 3000: # renamed include files # passed thru stfix.scripts (HP 3000 dependent changes) # character -> pcharacter # index -> iindex # create -> creat # # Changes for better portability/functionality: # commented out all debugger ifdefs (apparently Univac-dependant) # deleted 'external index' declarations # changed several 'fd < 0' to 'fd == ERR' (also 'fd > 0') # gave all functions at least one parameter # added final returns to getfil, gnxtfl, quit # changed spack to permit looser parameter checking # added cchar include in getfil # redid NEWLINE handling in bufill and bufemp # changes to delarg's in main to avoid deleting non-existent args # changed SINIT to use CR as eol default # changed spsiz setting in rpar to be portable # changed default quote to SHARP # changed handling of files: # remfd -> lfdin is port to read packets from # lfdout is now port to send packets to # made tochar and unchar into macros # added NAK's for timeouts or mangled packets in rinit, # rfile, rdata # fixed server to terminate on EOF # added defines and rpar, spar code for init parameters 7-10 # added startup banner # reorganized routines into portable and nonportable sets # # Changes just for HP3000: # changed endst usage to pass OK or ERR (new endst) # made necessary local changes to machine dependent routines: # setraw, unsetraw, putbuf # changed routine names: mask->chksum, getbit->mask # added timeouts: setioc calls in rpack, changes to GET_CH macro # # # A Note About the Code: # This RATFOR version of Kermit has been implemented on the # University of Utah Computer Center Univac 1100/60 using the # "Software Tools" prepared by the Advanced Research Group, # Computer Science and Applied Mathematics Department, Lawrence # Berkeley Laboratory, Berkeley, California. Since this set of "tools" # is very robust this implementation has been relatively easy. # Due to limitations in the capabilities of the original ST primitves, # as well as limitations due to local machine constraints, there # are several pieces of code which are adapted for particular machines. # These pieces of code have been marked for easy location with variations # using the word DEPENDENT, such as: # # *** MACHINE DEPENDENT FUNCTION *** # # HP3000 DEPENDENT # # U1100 DEPENDENT etc # # The machine dependent code inside of functions and subroutines # has been marked as follows : # # # xxx DEPENDENT # . # . # . # # END MACHINE DEPENDENT # # or # # #ifdef(xxx) # . # . # . # #elsedef # # . # # . # # . # #enddef # # The latter form is in preparation for the new ratfor preprocessor. # The ifdef, elsedef, enddef statements are not functonal yet. # # Single machine dependent statements are commented : # # statement # MACHINE DEPENDENT # # # Many of these pieces of code may not be needed for other systems. # Other pieces may only need to be modified. Since there are few # pieces of non-portable code, installing Kermit will hopefully be an # easy task. # # Binary Data Transmission: # This code assumes that using the eighth bit for data transmission # is not possible. (The Unix kermit has provisions for an 'image' mode.) # Eighth-bit quoting (as per the Kermit standard) is # implemented to allow binary transfers. (The cost is a 50% transmission # overhead). See, however, the caveats in bufill and bufemp about # the use of getch and putch for binary data. # # M A I N # # This is the main body of Kermit which calls to the other # functions and procedures. # DRIVER(kermit) include kermit.def # ("rkerm.h") # Definitions related to Kermit only include cint # Common block of integers include cchar # Common block of characters integer numarg,junk,retn # Counter for arguments, dummy character mode(MAXNAM) # Holds argument string integer server # Server mode state switcher integer recsw # Controlling function in Receive mode integer sendsw # Controlling function in Send mode integer getarg # Gets line of input from STDIN integer getenv # Gets environment values integer findarg_i # HP3000 string help USAGE string banner BANNER string stdhdr "ST " # Default header for messages string s_kerm "Kermit" string s_kermhdr "kermitheader" # Environment variable name call query(USAGE) # User help if (getenv (s_kermhdr, msghdr) == NO) # Look for message header in env call strcpy (stdhdr, msghdr) # Use default message header call concat (msghdr, s_kerm, msghdr) spsiz=80 # default packet size timint = 10 # default timeout for receiving packets pad=0 # No padding padchar=NULL # Use NULL if any padding wanted eol=CR # EOL for outgoing packets quotec=SHARP # Standard control-quote character bquote=MYBQUOTE # Binary quote char dobquo = NO # Default: no binary quoting reptc = MYREPTC # Repeat prefix dorept = NO # Default: no repeat prefixing escchr=ESCCHR # Escape char for connect mode call pbinit # Initialize pushback buffer fd = ERR # Initialize file descriptor xonwait = NO # Default: don't do XON wait nofilconv = NO # Default: do incoming filename conversion image = NO # No image mode at present debug = 0 # 0: no debugging, 1: states, 2: verbose imgflg = NO # Default: not binary mode binfil = NO # ditto remote=YES # This Kermit is always remote lfdin=STDIN # therefore, use standard i/o ports for line lfdout=STDOUT # May be STDIN on some machines sflg = 0 # Turn off parse flags rflg = 0 srvflg = 0 # HP3000 DEPENDENT if (findarg_i ("-sw.", swait) == EOF) # Look for -sw flag (debug) swait = 0 # Default if (findarg_i ("-pad.", mypad) ^= EOF) # Look for -pad flag mypad = min(94,max(0,mypad)) # must be in range 0-94 else # END mypad = MYPAD # Default #call test_buf # a way to test just bufill and bufemp numarg = getarg(1,mode,MAXNAM) # Get first command line argument if (numarg == EOF) # If no argument.... srvflg = 1 # default to server mode. else { call upper(mode) # Make argument completely upper case for (i=1; mode(i) ^= EOS; i=i+1) { # loop through flags switch(mode(i)) { case BIGR: # If argument starts with R... rflg = 1 # go to receive state. case BIGS: # If argument starts with S... sflg = 1 # go to send state. case BIGD: debug = debug + 1 # higher debug level case BIGX: xonwait = YES # do wait for ^Q (XON) before sending packets case BIGF: nofilconv = YES # DON'T convert incoming filenames case BIGI, DIG8: # '8' is for compatablity only imgflg = YES # force binary (image) mode default: # Anything else... call usage # is erroneous. } } } if (numarg ^= EOF) call delarg(1) # Delete argument if (rflg == 1 & sflg == 1) call usage # 'r' and 's' is wrong else if (rflg == 0 & sflg == 0) srvflg = 1 # No 'r' or 's' => server mode #ifdef (HP3000) if (srvflg == 0 & isatty(lfdin) == NO) remote = NO #endef call printf (STDOUT, "%s: %s@n.", msghdr, banner) # Ready message if (srvflg == 1) { call putlin (msghdr, STDOUT) call printf (STDOUT, " Server Mode@n _ Terminate with the 'finish' command (from your local kermit) or a ^Y@n.") call setraw # Set raw mode retn = server(DUM) # Invoke server call unsetraw # Restore tty } if (sflg == 1) { numarg = getarg(1,filnam,MAXNAM) # Check for a file name in command line if (numarg == EOF) # If no name is given... call usage # Print error message call setraw # Set raw mode retn = sendsw(EOS, BIGS) # Go to send state (start w/ send-init) call unsetraw # Restore tty } if (rflg == 1) { call setraw # Set raw mode retn = recsw(DUM) # Go to receive state call unsetraw # Restore tty } if (retn == LETA | retn == NO)# It aborted call endst(ERR) # End kermit with an error status DRETURN end #-t- main 5603 local 01/18/84 08:53:22 #-h- bufemp 1116 local 12/29/83 14:15:12 # # B U F E M P # # Get data from an incoming packet into a file # Control-quoting, 8-bit & repeat prefixes are done. # Note that parity stripping was already done in spack. # # Assumes putch (to a file) works with 8-bit data. HP3000 DEPENDENT # If this is not the case, putch call will have to # be replaced with some more complicated function that calls writef. # # next line is HP3000 DEPENDENT segmentation information subroutine bufemp(buffer,bfd,len) character buffer(ARB) # Buffer integer bfd, len # File pointer, length include cchar # Common block of characters include cint # Common block of integers integer ctl, mask # Ctl, mask functions integer nrep # repeat count integer i, j # Counter character t, t8, t7 # Character holders i = 1 # Set buffer index if (crpend == YES) # If there is a CR pending from last packet if (len >= 2 & buffer(1) == quotec & ctl(buffer(2)) == LF) { call putch (NEWLINE, bfd) # a CR-LF sequence that was split up i = 3 # skip the LF } else call putch (CR, bfd) # it was just a CR crpend = NO # No CR pending anymore for ( ; i<=len; INCR(i)) # Loop thru data field { t = buffer(i) # Get character if (dorept == YES & t == reptc) { # Repeat prefix seen nrep = unchar(buffer(i+1)) # Get the count i = i + 2 t = buffer(i) # Next char } else nrep = 1 if (dobquo == YES & t == bquote) { # Found eighth-bit quote t8 = 128 # save value for eighth bit INCR(i) t = buffer(i) # Next char } else t8 = 0 if (t == quotec) { # A quoted char INCR(i) t = buffer(i) # get the next char t7 = mask(t) if (t7 >= 63 & t7 <= 95) t = ctl(t) # Controlify the quoted control char } t = t + t8 # Add in eighth bit if (t == CR & binfil == NO & # only do CR-LF mapping for ascii files nrep == 1) # CR-LF does not get a repeat count if (i+2 <= len & buffer(i+1) == quotec & ctl(buffer(i+2)) == LF) { # CR, LF sequence t = NEWLINE # It's a NEWLINE i = i + 2 # skip LF } else if (i == len) # This is CR at the end of the packet { crpend = YES # Mark it as 'pending' break # and don't put it out } for (j=1; j<=nrep; j=j+1) # Put out the correct number of chars call putch (t, bfd) } return end #-t- bufemp 1116 local 12/29/83 14:15:12 #-h- bufill 1582 local 12/29/83 14:15:13 # # B U F I L L # # Get a bufferful of data from the file that's being sent. # Control-quoting, 8-bit & repeat prefixes are done. # # Assumes ngetch returns 8-bit data. HP3000 DEPENDENT # If this is not the case, getch call (in ngetch) will have to # be replaced with some more complicated function that calls readf. # # next line is HP3000 DEPENDENT segmentation information integer function bufill(buffer) character buffer(ARB) # Buffer include cchar # Common block of characters include cint # Common block of integers character c, c1, c7 # Character holder character ctl, ngetch # Functions integer mask # Function integer i, j # Loop index i = 1 while (ngetch(c,fd) != EOF) # Loop: Get next character { if (dorept == YES & # repeat prefixing enabled c ^= NEWLINE) # cannot do repeat counts for CR-LFs { for (j=1; ngetch(c1,fd) == c; j=j+1) # look for repeated chars if (j >= 94) # 94 char repeat limit break call putbak(c1) # put back the one that didn't match if (j < 3) # If less than threshhold for doing repeat for ( ; j>1; j=j-1) # put them back call putbak(c) else { CHCOPY (MYREPTC, buffer, i) # repeat prefix CHCOPY (tochar(j), buffer, i) # repeat count } } if (c == NEWLINE) { if (binfil == NO) { # do a CR, LF sequence CHCOPY (MYQUOTE, buffer, i) CHCOPY (ctl(CR), buffer, i) CHCOPY (MYQUOTE, buffer, i) CHCOPY (ctl(LF), buffer, i) } else # A NEWLINE in binary mode ; # Strip NEWLINES in binary mode. HP3000 DEPENDENT # If using readf and NEWLINE is an ascii char, # this is wrong. } else { c = mod (c,256) # strip down to eight bits (should already be) if (c > 127 & dobquo == YES) # If eighth bit on { CHCOPY (MYBQUOTE, buffer, i) # add eighth-bit quote c = mask(c) # strip down to seven bits } else if (binfil == NO) # If in ascii mode c = mask(c) # strip down to seven bits c7 = mask(c) # A seven bit version of c if (c7= spsiz-9) return(i-1) # Check length } if (i == 1) return(EOF) # Wind up here only on EOF return(i-1) # Handle partial buffer before EOF end #-t- bufill 1582 local 12/29/83 14:15:13 #-h- ctl # # C T L # # Turns a control character into a printable charcter and vice versa # by toggling the control bit (ie. ^A becomes A and A becomes ^A). character function ctl(ch) character ch integer mask if (mask(ch)>=64) # If not control character return (ch-64) # make it a control character else # If control character return (ch+64) # make it a regular character return # dummy for compiler end #-t- ctl #-h- errmsg # # E R R M S G # # Load two part error message, send it or print it. # subroutine errmsg(mesg,mesg2) character mesg(ARB),mesg2(ARB) # Messages include cint include cchar string s_c ": " i = 1 call stcopy (msghdr,1,packet,i) call stcopy (s_c,1,packet,i) call stcopy (mesg,1,packet,i) call stcopy (mesg2,1,packet,i) packet(MAXLINE) = EOS if (remote == YES) # If this is a remote kermit { # send message as an error packet packet(MAXPACK-1) = EOS # truncate to legal size call spack (BIGE,n,length(packet),packet) # Send the error packet } else call prmsg (mesg, mesg2) return end #-t- errmsg #-h- errpkt # # E R R P K T # # Print an error packet. # subroutine errpkt(pkt) character pkt(ARB) include cint call eprintf ("Error from remote Kermit: %s@n.", pkt) return end #-t- errpkt #-h- failmsg # # F A I L M S G # # Send message about a protocol failure. # subroutine failmsg(oldstate) character oldstate include cint include cchar character line(MAXLINE) integer i string retr "Retry limit exceeded" string wrong "Wrong packet number received" string type1 "Wrong packet type " string type2 " received" string stat "Illegal internal state " string while " while in state " string infile ", in file " string s_0 " " i = 1 switch (state) # Find the appropriate error message { case LETA: return # a message was already received or sent case LETM: call stcopy (retr,1,line,i) case LETN: call stcopy (wrong,1,line,i) case LETW: call stcopy (type1,1,line,i) call chcopy (lastpk,line,i) call stcopy (type2,1,line,i) default: call stcopy (stat,1,line,i) } call stcopy (while,1,line,i) call chcopy (oldstate,line,i) # Give the state if (fd ^= ERR) { # Give the file, if open call stcopy (infile,1,line,i) call stcopy (filnam,1,line,i) } call errmsg (line, s_0) # Send error message to appropriate place if (debug > 0 & remote == YES) call prmsg (line, s_0) # Send a copy to ERROUT if debug is on return end #-t- failmsg #-h- getcmd # # G E T C M D # # Gets command from G packet. # character function getcmd(len,cmd) integer len # Command length character cmd(ARB) # Command holder if (len == 1) # This Kermit only handles single getcmd = cmd(1) # character commands else if (len > 1) getcmd = cmd(1) return end #-t- getcmd #-h- getfil 684 local 12/29/83 14:15:14 # # G E T F I L # # Open a new file, overwriting any existing file. # integer function getfil(filenm) character filenm(ARB) # File name holder filedes create, open # create and open functions integer gettyp1, setenv # (or gettyp) character getch character c # character holder integer junk include cint # Common block of integers include cchar # Common block of characters #ifdef (HP3000) string s_deffile "deffile" # HP3000 environment variable for setting string bin_mods "rec=128,1,f,b:disc=4000" # default file type for creat #endef c = LETA # Signal for a non-empty or non-existent file fd = open(filenm, READ) # test whether file already exists if (fd ^= ERR) { c = getch(c,fd) # test for empty file call close (fd) } if (c == EOF) fd = open (filenm, APPEND) # Append to an empty file else { #ifdef (HP3000) if (imgflg == YES) junk = setenv (s_deffile, bin_mods) #endef fd = create(filenm,WRITE) # Otherwise, create a new one #ifdef (HP3000) if (imgflg == YES) call rmenv (s_deffile) # delete the environment variable #endef } crpend = NO # Reset crpend flag for bufemp if (fd ^= ERR) { call strcpy (filenm, filnam) # Remember the name if (gettyp1(fd) == BINARY | imgflg == YES) binfil = YES else binfil = NO return(fd) # Return file descriptor } else # If file won't open return(NO) # Return false return end #-t- getfil 684 local 12/29/83 14:15:14 #-h- gnxtfl # # G N X T F L # # Get next file from command line. # # special compiler control HP3000 DEPENDENT: integer function gnxtfl(sname) character sname(ARB) include cchar # Common block of characters include cint # Common block of integers integer getarg, equal # Functions integer gettyp1 # gettyp on most machines HP3000 DEPENDENT filedes open string s_as "-as" # Flag arg to indicate name to send under string cant(MAXLINE) "Can't open file " # File opening error message string s_dum "" string noname "No file name after '-as' after " # -as error message if (sname(1) ^= EOS) # If name supplied (server mode) call strcpy (sname, filnam) # use given file name else { if (getarg(1,filnam,MAXNAM) == EOF) # Otherwise, get next file name return(BIGB) # No more names - break transmission call delarg(1) # Delete argument } call pbinit # Reset the pushback buffer fd = open(filnam,READ) # Try raw name first if (fd == ERR) { # If it doesn't exist #ifdef(HP3000) call cant3s (".", 0, filnam, cant) # special error message retrieval cant(94) = EOS # just to be sure of the length call errmsg (cant, s_dum) #elsedef # call errmsg (cant, filnam) # Send error message #enddef return(LETA) # Abort } if (gettyp1(fd) == BINARY | imgflg == YES) # check for whether we should binfil = YES # treat this a binary file else binfil = NO if (remote == NO) call printf (ERROUT, "%s: sending file '%s'.", msghdr, filnam) call outnam(filnam) # Put name into standard format if (getarg(1,packet,MAXNAM) ^= EOF) # If the next arg if (equal (s_as, packet) == YES) # is the '-as' flag { call delarg(1) # Delete it if (getarg(1,packet,MAXNAM) == EOF) # If there's not another name { call errmsg (noname, filnam) # send an error message return(LETA) # and abort } else { call delarg(1) # Delete arg call strcpy(packet, filnam) # copy this into the filename slot } } if (remote == NO) call printf (ERROUT, " as '%s'@n.", filnam) return(BIGF) # Ready to send new file. end #-t- gnxtfl #-h- ngetch # ngetch --- get a (possibly pushed back) character # next line is HP3000 DEPENDENT segmentation information character function ngetch(c, fd) character getch character c integer fd include cpb if (bp > 0) { c = buf(bp) bp = bp - 1 } else c = getch(c, fd) ngetch = c return end #-t- ngetch #-h- pbinit # pbinit --- initialize the push-back buffer subroutine pbinit include cpb bp = 0 return end #-t- pbinit #-h- prmsg # # P R M S G # # Load two part message and print it. # subroutine prmsg(mesg,mesg2) character mesg(ARB),mesg2(ARB) # Messages include cint include cchar if (remote == NO) # If this is a local kermit call eprintf ("%s: %s %s@n.", msghdr, mesg, mesg2) # print the message return end #-t- prmsg #-h- putbak # putbak --- push character back onto input # next line is HP3000 DEPENDENT segmentation information subroutine putbak(c) character c include cpb bp = bp + 1 if (bp > PBSIZE) call error ("too many characters pushed back.") buf(bp) = c return end #-t- putbak #-h- rdata 2639 local 12/29/83 14:15:15 # # R D A T A # # Receive Data # # CONTAINS HP3000 DEPENDENT CODE # character function rdata(dum) integer dum include cchar # Common block of chars include cint # Common block of integers integer num, len, x # Packet number, length, dummy character rpack if (numtry > MAXTRY) return(LETM) # "Abort" if too many tries INCR(numtry) switch(rpack(len,num,packet)) { # Get packet case BIGD: # Got Data packet if (num != n) { # Right packet ? if (oldtry > MAXTRY) return(LETM) # No. If too many tries INCR(oldtry) # give up if (n ==0) # Else check packet number x = 63 else x = n-1 if (num == x) { # Previous packet again ? call spack(BIGY,num,0,0) # Yes, re-ACK it numtry = 0 # Reset try counter return(state) # Stay in D, don't write out data! } else return(LETN) # Sorry! Wrong number. } # Got data with right packet number call bufemp(packet,fd,len) # Write the data to the file call spack(BIGY,n,0,0) # Acknowledge the the packet oldtry = numtry # Reset the try counters numtry = 0 # ... n = mod(n+1,64) # Bump the packet number, mod 64 return(BIGD) # Remain in data state case BIGF: # Got a File Header if (oldtry > MAXTRY) return(LETM) # If too many tries, "abort" INCR(oldtry) if (n == 0) # Else check packet number x = 63 else x = n-1 if (num == x) { # It was the previous one call spack(BIGY,num,0,0) # ACK it again numtry = 0 # Reset try counter return(state) # Stay in data state } else return(LETN) # Not previous packet, "abort" case BIGZ: # End-Of-File if (num != n) return(LETN) # Must have right packet number call spack(BIGY,n,0,0) # OK, ACK it. call bufemp(packet,fd,0) # flush possible final CR call flush(fd) # flush file system buffers #ifdef(HP3000) DEPENDENT call close_type (fd, %10) # truncate fixed record file after EOF #elsedef #call close(fd) # Close the file #enddef fd = ERR # Remember that file was closed n = mod(n+1,64) # Bump the packet number return(BIGF) # Go back to Receive File state case LETC,LETT: # No good packet came call spack (BIGN, n, 0, 0) # NAK return(state) # Keep waiting case BIGE: # Error packet call errpkt (packet) # print it return(LETA) # Abort default: return(LETW) # Some other packet, "abort" } return end #-t- rdata 2639 local 12/29/83 14:15:15 #-h- recsw 1037 local 12/29/83 14:15:17 # # R E C S W # # This is the state table switcher for receiving files. # integer function recsw (dum) integer dum include cchar # Common block of chars include cint # Common block of integers character rinit, rdata, rfile # Use these functions integer junk character lstate, llstate integer remove if (srvflg == 1) # If in server mode state = BIGF # start in F state. else { state = BIGR # Receive is the start state n = 0 # Initialize message number numtry = 0 # Say no tries yet } repeat { # Do until done if (debug >= 1) call eprintf (" recsw %c %d@n.", state, n) switch(state) { case BIGD: state = rdata(DUM)# Data receive state case BIGF: state = rfile(DUM)# File receive state case BIGR: state = rinit(DUM)# Send initiate state case BIGC: return(YES) # Complete state default: # Anything else is an error call failmsg(llstate) # Put out an error message if (fd ^= ERR) { # If file left open call close (fd) # Close it fd = ERR # Remember it's closed junk = remove (filnam) # Delete the partial file } return (NO) # Error return } llstate = lstate # Remember last state lstate = state } return end #-t- recsw 1037 local 12/29/83 14:15:17 #-h- rfile 2961 local 02/04/84 14:59:18 # # R F I L E # # Receive File Header # character function rfile(dum) integer dum include cchar # Common block of chars include cint # Common block of integers integer num, len, x, g # Packet length, number, dummy integer getfil # functions character rpack # Rpack function string cant(MAXLINE) "Can't open file " # Error message string exists " already exists" string s_dum "" if (numtry > MAXTRY) return(LETM) # If too many tries, "abort" INCR(numtry) switch(rpack(len,num,packet)) { # Get a packet case BIGS: # Send-Init, maybe our ACK lost if (oldtry > MAXTRY) return(LETM) # If too many tries, "abort" INCR(oldtry) if (n==0) x = 63 else x = n-1 if (num == x) { # Previous packet count mod 64? call spar(packet) # Yes, ACK it again call spack(BIGY,num,INIT_SIZ,packet) # with our Send-Init parameters numtry = 0 # Reset try counter return(state) # Stay in this state } else return(LETN) # Not previous packet, "abort" case BIGZ: # End of File if (oldtry > MAXTRY) return(LETM) INCR(oldtry) if (n == 0) x = 63 else x = n-1 if (num == x) { # Previous packet, mod 64? call spack(BIGY,num,0,0) # Yes, ACK it again. numtry = 0 # Reset try counter return(state) # Stay in this state } else return(LETN) # Not previous packet, "abort" case BIGF: # File Header if (num != n) return(LETN) # which is what we really want # The packet number must be right g = getfil(packet) # Try to open a new file with raw name if (g == NO & nofilconv == NO) {# If it failed due to incompatable name call innam(packet) # Make file name local compatible g = getfil(packet) # Retry open } if (g == NO) { #ifdef(HP3000) call cant3s (".", 0, packet, cant) # special error message retrieval cant(94) = EOS # just to be sure call errmsg (cant, s_dum) #elsedef # call errmsg (cant, packet) # Send error message #enddef return(LETA) # Give up if can't } else if (g == LETA) { # File already exists call errmsg(packet, exists) # Send error message return(LETA) # Give up if can't } call spack(BIGY,n,length(packet),packet) # Acknowledge the file header oldtry = numtry # Reset the try counters numtry = 0 # .... n = mod(n+1,64) # Bump packet number, mod 64 return(BIGD) # Switch to Data state case BIGB: # Break transmission (EOT) if (num != n) return(LETN) # Need right packet number here call spack(BIGY,n,0,0) # Say OK return(BIGC) # Go to complete state case LETC,LETT: # Couldn't get good packet call spack (BIGN, n, 0, 0) # NAK return(state) # Keep Waiting case BIGE: # Error packet call errpkt (packet) # print it return(LETA) # Abort default: return(LETW) # Some other packet, "abort" } return end #-t- rfile 2961 local 02/04/84 14:59:18 #-h- rinit 1148 local 12/29/83 14:18:07 # # R I N I T # # Receive Initialization # character function rinit(dum) integer dum include cchar # Common block of chars include cint # Common block of integers integer len, num # Packet length, number character rpack # Rpack function if(numtry > MAXTRY) return (LETM) # If too many tries "abort" INCR(numtry) switch(rpack(len,num,packet)) { # Get a packet case BIGS: # Send-Init call rpar(packet) # Get the other side's init data call spar(packet) # Fill up packet with my init info call spack(BIGY,n,INIT_SIZ,packet) # ACK with my parameters oldtry = numtry # Save old try count numtry = 0 # Start a new counter n = mod(n+1,64) # Bump packet number, mod 64 return(BIGF) # Enter file send state case LETC,LETT: # Didn't get packet call spack (BIGN, n, 0, 0) # NAK return(state) # Keep waiting case BIGE: # Error packet call errpkt (packet) # print it return(LETA) # Abort default: return(LETW) # Some other packet type, "abort" } return end #-t- rinit 1148 local 12/29/83 14:18:07 #-h- rpack 3595 local 12/29/83 14:15:20 # # R P A C K # # Read a packet # *** CONTAINS MACHINE DEPENDENT CODE *** # A check has been added where the checksum is read from the packet. # This check is for a CR in the spot where a checksum should be found. # This check is implemented to correct for the Univac stripping off # trailing blanks during I/O. Sometimes the checksum character is # a blank (ascii 32) and is stripped off by the Univac when it is # received leaving a CR to be read in it's place. This is corrected by # assuming that if a checksum of CR is read, the trailing blank of # the packet (checksum) has been stripped. In this case the checksum # is set to 32 (blank). # # GET_CH is a macro that reads a character and checks for an EOF which # is fatal, or TIMO (timeout), which causes a restart of the packet. # It assumes that if timeouts are allowed, a timeout causes getch to return # the constant TIMO. # # next line is HP3000 DEPENDENT segmentation information character function rpack(len,num,data) integer len,num # Packet length, number character data(ARB) # Packet data include cchar # Common block of type character include cint # Common block of type integer integer i, done # Data character number, Loop exit character checks, t, type # Checksum, current char, pkt type character getch # Character reading function integer chksum, mask # checksum, mask functions #ifdef(TIMO) # if timeouts allowed define(GET_CH, t=getch(t,lfdin); if (debug >= 3) call putch (t, ERROUT) if (t == EOF) goto 100 # abort on EOF else if (t == TIMO) goto 200 # timeout return ) #elsedef # no timeouts case #define(GET_CH, # t=getch(t,lfdin); # if (debug >= 3) # call putch (t, ERROUT) # if (t == EOF) goto 100 # abort on EOF # ) #enddef #ifdef(TIMO) call setioc (lfdin, IO_TIMO, timint) # set timeout # HP3000 DEPENDENT #enddef if (debug >= 3) call eprintf (" rpack (raw):.") repeat { GET_CH # get a character (quit on EOF) if (t == SOH) # wait for start of packet break } done = NO # Got SOH, init loop while (done != YES) { # Loop to get a packet GET_CH # Get character if (binfil == NO) # If in ascii mode t = mask(t) # Strip parity if (t == SOH) next # Resynchronize if SOH checks = t # Start the checksum len = unchar(t)-3 # Character count GET_CH # Get character if (binfil == NO) # If in ascii mode t = mask(t) # Strip parity if (t == SOH) next # Resynchronize if SOH checks = checks + t # Accumulate checksum num = unchar(t) # Packet number GET_CH # Get character if (binfil == NO) # If in ascii mode t = mask(t) # Strip parity if (t == SOH) next # Resynchronize if SOH checks = checks + t # Accumulate checksum type = t # Packet type for(i=1; i<=len; i=i+1) { # The data itself if any GET_CH # Get character if (binfil == NO) # If in ascii mode t = mask(t) # Strip parity if (t == SOH) next # Resynch if SOH checks = checks + t # Accumulate checksum data(i) = t # Put it in the data buffer } data(len+1) = EOS # Mark end of data GET_CH # Get last character (checksum) # U1100 DEPENDENT # if (t == 10) # If checksum character is CR then... # t = 32 # Univac has stripped a trailing blank. # END MACHINE DEPENDENT if (binfil == NO) # If in ascii mode t = mask(t) # Strip parity if (t == SOH) next # Resynchronize if SOH done = YES # Got checksum, done } if (debug >= 3) call putch (NEWLINE, ERROUT) #ifdef(TIMO) call setioc (lfdin, IO_TIMO, 0) # turn off timeout # HP3000 DEPENDENT #enddef if (debug >= 2) # debug print (before checksum check) call eprintf (" rpack: %c %2d '%s'@n.", type, num, data) checks = chksum(checks) # Perform checksum if (checks != unchar(t)) # Check the checks, fail if bad { if (debug >= 1) call eprintf (" rpack: checksum fail: %c/%c@n.",t,tochar(checks)) else if (remote == NO) { call putch (PERCENT, ERROUT) call flush (ERROUT) } lastpk = LETC return(LETC) # indicate checksum failure } lastpk = type return(type) # All OK, return packet type 100 continue # EOF on line if (debug >= 1) call eprintf ("@n%s: EOF read from line@n.", msghdr) lastpk = LETA return (LETA) # abort 200 continue # Timeout (TIMO returned from getch) if (debug >= 1) call eprintf (" timeout@n.") # timeout message else if (remote == NO) { call putch (PERCENT, ERROUT) # normal way to indicate a timeout call flush (ERROUT) # get it out now } lastpk = LETT return(LETT) # indicates timeout end #-t- rpack 3595 local 12/29/83 14:15:20 #-h- rpar 1136 local 12/29/83 14:15:22 # # R P A R # # Get the other side's send-init parameters # subroutine rpar(data) character data(ARB) character ctl # Ctl function include cchar # Common block of characters include cint # Common block of integers define(RPAR_END,if(data($1)==EOS) return) # End of init parameters dobquo = NO # default: no eighth-bit quoting dorept = NO # default: no repeat prefixing RPAR_END(1) spsiz = min(MAXPACK,unchar(data(1))) # Maximum send packet size RPAR_END(2) if (unchar(data(2)) <= 0) # When I should time out on reads timint = MAXTIM else timint = min(MAXTIM,max(MINTIM,unchar(data(2)))) RPAR_END(3) pad = unchar(data(3)) # Number of pads to send RPAR_END(4) padchar = ctl(data(4)) # Padding character to send RPAR_END(5) eol = unchar(data(5)) # EOL character I must send RPAR_END(6) quotec = data(6) # Incoming data quote character RPAR_END(7) bquote = data(7) # Incoming binary quote character if ((MYBQUOTE >= 33 & MYBQUOTE <= 62) | (MYBQUOTE >= 96 & MYBQUOTE <= 126) | MYBQUOTE == BIGY) # If I have quoting compiled in if ((bquote >= 33 & bquote <=62) | (bquote >=96 & bquote <= 126)) dobquo = YES # Eighth-bit quoting agreed, use his char else if (bquote == BIGY) { dobquo = YES # Eighth-bit quoting agreed bquote = MYBQUOTE # Use my char if (MYBQUOTE == BIGY) bquote = AMPER # Both said 'Y': use '&' } RPAR_END(8) RPAR_END(9) reptc = data(9) # Incoming repeat prefix char if (((reptc >= 33 & reptc <=62) | (reptc >=96 & reptc <= 126)) & reptc == MYREPTC) dorept = YES # Our repeat prefixes agree, so use it return end #-t- rpar 1136 local 12/29/83 14:15:22 #-h- sbreak 1236 local 12/29/83 14:21:14 # # S B R E A K # # Send Break (EOT) # character function sbreak(dum) integer dum integer num, len # Packet number, length include cchar # Common block of characters include cint # Common block of integers character rpack # Rpack function if (numtry > MAXTRY) return(LETM) # If too many tries "abort" INCR(numtry) call spack(BIGB,n,0,packet) # Send a B packet switch(rpack(len,num,recpkt)) { # What was the reply case BIGN: # NAK, fail num = num-1 # ...unless for previous packet, if (num < 0) # in which case, stay in B state. num = 63 if (n != num) return(state) case BIGY: # ACK if (n != num) return(state) # If wrong ACK, fail numtry = 0 # Reset try counter n = mod(n+1,64) # and bump packet count return(BIGC) # Switch state to Complete case LETC,LETT: return(state) # Receive failure, stay in state B case BIGE: # Error packet call errpkt (recpkt) # print it return(LETA) # Abort default: return(LETW) # Other, "abort" } return end #-t- sbreak 1236 local 12/29/83 14:21:14 #-h- sdata 1558 local 12/29/83 14:23:18 # # S D A T A # # Send File Data # character function sdata(dum) integer dum include cchar # Common block of characters include cint # Common block of integers integer num, len # Packet number ,length character rpack # Rpack function integer bufill # Bufill function if (numtry > MAXTRY) return(LETM) # If too many tries, give up INCR(numtry) call spack(BIGD,n,size,packet) # Send a D packet switch(rpack(len,num,recpkt)) { # What was the reply case BIGN: # NAK, just stay in this state, num = num-1 # unless NAK for next packet, if (num < 0) # which is just like an ACK num = 63 # for this packet. if (n != num) return(state) case BIGY: # ACK if (n != num) return(state) # If wrong ACK, fail numtry = 0 # Reset try counter n = mod(n+1,64) # Bump packet count size = bufill(packet) # Get data from file if (size == EOF) { # If EOF set state to that return(BIGZ) } return(BIGD) # Got data, stay in state D case LETC,LETT: return(state) # Receive failure, stay in D case BIGE: # Error packet call errpkt (recpkt) # print it return(LETA) # Abort default: return(LETW) # Anything else "abort" } return end #-t- sdata 1558 local 12/29/83 14:23:18 #-h- sendsw 1208 local 12/29/83 14:15:24 # # S E N D S W # # Sendsw is the state table switcher for sending # files. It loops until either it finishes, or # an error is encountered. The routines called by # sendsw are responsible for changing the state. # # # special compiler control HP3000 DEPENDENT: integer function sendsw (sname, start) character sname(ARB) # name of file to send (EOS => use args) integer start # state to start in - BIGS or BIGF include cchar # Common block of characters include cint # Common block of integers character sinit, sfile, seof, sdata, sbreak # Functions character lstate, llstate state = start # Use indicated start state (usually BIGS) n = 0 # Initialize message number numtry = 0 # Say no tries yet repeat { # Do this as long as necessary if (debug >= 1) call eprintf (" sendsw %c %d@n.", state, n) switch(state) { case BIGD: state = sdata(DUM)# Data-Send state case BIGF: state = sfile(sname)# File-Send case BIGZ: state = seof(DUM) # End of File if (state == BIGF & sname(1) ^= EOS) # If ready for next file state = BIGB # Do Break case BIGS: state = sinit(DUM)# Send Init case BIGB: state = sbreak(DUM) # Break-Send case BIGC: return(YES) # Complete default: # Anything else is an error call failmsg(llstate) # Put out an error message if (fd ^= ERR) { # If file left open call close (fd) # Close it fd = ERR # Remember it's closed } return (NO) # Error return } llstate = lstate lstate = state # Remember last state } return end #-t- sendsw 1208 local 12/29/83 14:15:24 #-h- seof 2111 local 01/16/84 08:50:37 # # S E O F # # Send End Of File. # character function seof(dum) integer dum include cchar # Common block of characters include cint # Common block of integers integer num, len # Packet number, length character rpack # Rpack function if (numtry > MAXTRY) return(LETM) # If too many tries, give up INCR(numtry) call spack(BIGZ,n,0,packet) # Send a Z packet switch(rpack(len,num,recpkt)) { # What was the reply ? case BIGN: # NAK, fail num = num-1 if (num < 0) # ...unless for previous packet, num = 63 # in which case, stay in this state if (n != num) return(state) case BIGY: # ACK if (n != num) return(state) # If wrong ACK, hold out numtry = 0 # Reset try counter n = mod(n+1,64) # Bump packet count call close(fd) # Close the input file fd = ERR # and flag that we did return (BIGF) # Go to file header state case LETC,LETT: return(state) # Receive failure, stay in state Z case BIGE: # Error packet call errpkt (recpkt) # print it return(LETA) # Abort default: return(LETW) # Something else, "abort" } return end #-t- seof 2111 local 01/16/84 08:50:37 #-h- server 3027 local 02/04/84 14:59:22 # # S E R V E R # # This is the state controller for the server mode of operation. # integer function server (dum) integer dum include cchar # Common block of characters include cint # Common block of integers integer len, num, junk # Packet length, number, dummy integer timeos # number of timeouts seen character typ # packet typ integer recsw, sendsw # Functions called by server character getcmd, rpack string badcmd ": not a valid Kermit server command" string badstcmd ": command not implemented by ST Kermit server" n = 0 # Initialize message number numtry = 0 # Say no tries yet timeos = 0 # No timeouts seen yet repeat { # Do until told to quit typ = rpack(len,num,packet) # Get a packet if (debug >= 1) { if (typ == NO & debug >= 3) call putch(NEWLINE, ERROUT) call eprintf ("server %c @n.", typ) } switch(typ) { case BIGS,BIGI: # The other side wants to initialize call rpar(packet) # Get other side's initial parameters call spar(packet) # Get my initial parameters call spack(BIGY,n,INIT_SIZ,packet) # Send ACK with my init parameters oldtry = numtry # Reset try counters numtry = 0 # .... if (typ == BIGS) # If this was a send-init packet { n = mod(n+1,64) # Increment packet count junk = recsw(DUM) # Go to receive state to receive file } n = 0 # Reset packet count case BIGR: # The other side wants to receive call strcpy(packet,filnam) # To let packet array be reused junk = sendsw(filnam,BIGS) # Send the requested file n = 0 case BIGG: # Other side is sending a command switch(getcmd(len,packet)) { # What is the command ? case BIGF: # Finish, shut down Kermit call spack(BIGY,num,0,0) # Acknowledge receipt of command call quit # Leave kermit case BIGL: # Logout: shut down Kermit and logout. call spack(BIGY,num,0,0) # Acknowledge receipt of command call quit # Execute session logout (not implemented) default: # Anything else packet(2) = EOS call errmsg (packet, badstcmd) # Send error message } case BIGX, BIGC, BIGK: # Valid, but unimplemented packet(1) = typ packet(2) = EOS call errmsg (packet, badstcmd) # Send err message case BIGN: # NAK: ignore it (some confusion) case LETA: # EOF on line: abort return(LETA) case LETC: # checksum err: call spack(BIGN,n,0,0) # NAK it n = 0 case LETT: # timeout timeos = mod(timeos+1,5) # increment timeout counter if (timeos == 0) # If it rolls over (every fifth) call spack(BIGN,n,0,0) # send out a NAK, just to keep line active n = 0 case BIGE: # Error packet call errpkt (recpkt) # print it default: # Anything else, reset packet count, retry packet(1) = typ packet(2) = EOS call errmsg (packet, badcmd) # Send an error message n = 0 # Reset counter } if (fd ^= ERR) # If a file was left open (xfer aborted) { call close (fd) # Close it fd = ERR # Remember closure } } return end #-t- server 3027 local 02/04/84 14:59:22 #-h- sfile 1533 local 12/29/83 14:27:41 # # S F I L E # # Send File Header. # character function sfile(sname) character sname(ARB) include cchar # Common block of characters include cint # Common block of integers integer num, len # Packet number, length character g character rpack # Rpack function integer bufill, length # functions character gnxtfl # function string s_send "file being saved as " g = gnxtfl (sname) # Open the file to be sent if (g ^= BIGF) # BIGF => OK return(g) # abort or break states if (numtry > MAXTRY) return(LETM) # If too many tries give up INCR(numtry) len = length(filnam) # get length of filename call spack(BIGF,n,len,filnam) # Send an F packet switch(rpack(len,num,recpkt)) { # What was the reply ? case BIGN: # NAK, just stay in this state num = num-1 # unless NAK for next packet, if (num < 0) # which is just like ACK for num = 63 # this packet, fall thru to.... if (n != num) return(state) case BIGY: # ACK if(n != num) return(state) # If wrong ACK, stay in F state if (len > 0) # If the remote filename was returned call prmsg (s_send, recpkt)# print it out numtry = 0 # Reset try counter n = mod(n+1,64) # Bump packet count size = bufill(packet) # Get first data from file return(BIGD) # Switch to state D case LETC,LETT: return(state) # Receive failure, stay in F state case BIGE: # Error packet call errpkt (recpkt) # print it return(LETA) # Abort default: return(LETW) # Something else, just "abort" } return end #-t- sfile 1533 local 12/29/83 14:27:41 #-h- sinit 2560 local 01/04/84 17:49:40 # # S I N I T # # Send Initiate: Send my parameters, get other side's back. # # The 10 second wait before sending the first packet gives # the user time to get back to his local Kermit and set it # to receive. # character function sinit(dum) integer dum include cchar # Common block of characters include cint # Common block of integers integer num, len # Packet number, Length character rpack # Rpack function if (numtry > MAXTRY) return (LETM) # If too many tries, give up numtry=numtry+1 # Increment count of tries call spar(packet) # Fill packet with init info if (sflg == 1 & remote == YES) # If in send only (not server) mode call sleepm (10000) # Wait 10 seconds call spack(BIGS,n,INIT_SIZ,packet) # Send an S packet switch(rpack(len,num,recpkt)) { # What was reply ? case BIGN: return(state) # NAK case BIGY: # ACK if (n != num) return(state) # If wrong ACK, stay in S state call rpar(recpkt) # Get other sides init info if (eol == 0) eol = CR # Check and set defaults if (quotec == 0) quotec = SHARP # Control-prefix quote numtry = 0 # Reset try counter n=mod(n+1,64) # Bump packet count return (BIGF) # Go to file header state case LETC,LETT: return(state) # Receive failure, stay in S state case BIGE: # Error packet call errpkt (recpkt) # print it return(LETA) # Abort default: return(LETW) # Anything else just abort } return end #-t- sinit 2560 local 01/04/84 17:49:40 #-h- spack 1861 local 12/29/83 14:30:20 # # S P A C K # # Send a packet # # HP3000 DEPENDENT to allow calling routine with '0' for 'data' array: subroutine spack(type,num,len,data) character type, data(ARB) # Packet type, data integer num, len # Packet number, length of data include cchar # Common block of characters include cint # Common block of integers character checks, buffer(100) # Checksum, packet buffer integer i,bufptr # Loop counter, buffer pointer integer chksum # Chksum function character getch # function character c # char holder data(len+1) = EOS # just to be sure if (debug >= 2) call eprintf (" spack: %c %2d '%s'@n.", type, num, data) bufptr = 1 # Initialize buffer pointer for (i=1; i<=pad; i=i+1) call putch(padchar,lfdout) # Issue any padding buffer(bufptr) = SOH # Packet marker, ASCII 1 (SOH) INCR(bufptr) # Increment buffer pointer checks = tochar(len+3) # Initialize the checksum buffer(bufptr) = tochar(len+3) # Send the character count INCR(bufptr) # Increment buffer pointer checks = checks + tochar(num) # Initialize checksum buffer(bufptr) = tochar(num) # Packet number INCR(bufptr) checks = checks + type # Accumulate checksum buffer(bufptr) = type # Packet type INCR(bufptr) for (i=1; i<=len; i=i+1) { # Loop for all data characters buffer(bufptr) = data(i) # Get a character INCR(bufptr) # Increment buffer pointer checks = checks + data(i) # Accumulate checksum } checks = chksum(checks) # Perform checksum buffer(bufptr) = tochar(checks) # Put it in the packet buffer(bufptr + 1) = EOS # Properly terminate packet if (xonwait == YES) { # Now wait for DC1 (XON) 'prompt' character #ifdef TIMO call setioc (lfdin, IO_TIMO, timint) # set timeout # HP3000 DEPENDENT #enddef repeat { c = getch(c, lfdin) if (c == DC1 | c == SOH | c == EOF) break #ifdef(TIMO) else if (c == TIMO) break #enddef } #ifdef(TIMO) call setioc (lfdin, IO_TIMO, 0) # turn off timeout # HP3000 DEPENDENT #enddef } call putbuf(buffer,bufptr,lfdout) # Send the packet return end #-t- spack 1861 local 12/29/83 14:30:20 #-h- spar 780 local 12/29/83 14:15:30 # # S P A R # # Fill the data array with my send-init parameters # Different machines may require different parameter definitions. # subroutine spar(data) character data(ARB) # Array of parameters include cint character ctl # ctl function data(1) = tochar(MAXPACK) # Biggest packet I can receive data(2) = tochar(MYTIME) # When I want to be timed out data(3) = tochar(mypad) # How much padding I need data(4) = ctl(MYPCHAR) # Padding character I want data(5) = tochar(MYEOL) # End of Line character I want data(6) = MYQUOTE # Control-Quote character I send data(7) = MYBQUOTE # Binary-Quote character I send data(8) = MYCHECK # My preferred type of checksum data(9) = MYREPTC # Repeat-Quote character I send data(10) = tochar(MYCAPS) # My capabilities mask data(INIT_SIZ+1) = EOS # in case this gets printed return end #-t- spar 780 local 12/29/83 14:15:30 #-h- usage 198 local 12/29/83 14:15:30 # U S A G E # subroutine usage call remark("usage: kermit [ixd].") call remark(" kermit [rixd].") call remark(" kermit [sixd] [file [-as remote_name]]@.@.@..") call unsetraw call endst(ERR) stop end #-t- usage 198 local 12/29/83 14:15:30 #-h- chgnam 34 ascii 02/19/84 01:48:00 # # # MACHINE DEPENDENT ROUTINES APPEAR AFTER THIS POINT # # # # # C H G N A M # # Change name of file to compatible name # *** MACHINE DEPENDENT SUBROUTINE *** # Many systems use the file naming format 'filename.ext'. # Many systems have a '.' at the end of a file name that does not # have an extension. This creates problems for the Univac since # usually a Univac element is what is thought of as a file. The # Univac file is more like a directory on other systems. The file # name followed by a '.' would be interpreted as a Univac file by # by the 1100. In most cases what we want to work with is an element. # This routine chops off a trailing '.' . # Other systems may need to make allowances for this # same sort of problem. # subroutine chgnam(name) character name(ARB) # Name holder integer index integer loc1, loc2 # Indices loc1 = index(name,NULL) # Check for UNIX NULL on end of name if (loc1 != 0) # U1100 & name(loc1+1) == EOS) name(loc1) = EOS # If found strip it off loc1 = index(name,PERIOD) # Check for '.' in name #loc2 = iindex(name,STAR) # Check for '*' in name # U1100 if (loc1 != 0 & name(loc1+1) == EOS) # & loc2 == 0) # If '.' is last char name(loc1) = EOS # Strip '.' off return end #-t- chgnam 34 ascii 02/19/84 01:48:00 #-h- chksum 29 ascii 02/19/84 01:48:01 # # C H K S U M # # Compute checksum. # The Kermit Protocol Manual details how the checksum is formed. # integer function chksum(sum) integer sum # Checksum holder integer c # Holder of checksum copy #integer mod # Mod function # MACHINE DEPENDENT c = mod(sum,64) + mod(sum/64,4) # Add the low 6 bits to the next two bits return (mod(c,64)) # Return six bits of that result end #-t- chksum 29 ascii 02/19/84 01:48:01 #-h- hdlprd 20 ascii 02/19/84 01:48:01 # # H D L P R D # # Handle period in incoming file name. # *** U1100 DEPENDENT SUBROUTINE *** # subroutine hdlprd(name) character name(ARB) integer index integer loc1 loc1 = index(name,PERIOD) # Locate '.' in name if (loc1 != 0) # If there, replace it with '/' name(loc1) = SLASH return end #-t- hdlprd 20 ascii 02/19/84 01:48:01 #-h- innam 33 ascii 02/19/84 01:48:02 # # I N N A M # # Change file name to a local compatible name. # # *** MACHINE DEPENDENT SUBROUTINE *** # Makes sure that an incoming file has a name that the local system # recognizes as valid. # subroutine innam(name) character name(ARB) # File name holder call chgnam(name) # Strip trailing NULL '.' #call hdlprd(name) # Replace interior '.' with '/' # U1100 call validate(name) # Delete invalid chars call truncate(name) # Truncate if neeeded return end #-t- innam 33 ascii 02/19/84 01:48:02 #-h- mask 15 ascii 02/19/84 01:48:02 # # M A S K # # Mask off parity. Returns 7 low-order bits. # integer function mask(n) integer n #integer mod # Needed on some machines # MACHINE DEPENDENT return(mod(n,128)) # Mask off all but 7 low bits end #-t- mask 15 ascii 02/19/84 01:48:02 #-h- outnam 72 ascii 02/19/84 01:48:03 # # O U T N A M # # This routine converts a local file name to a name recognizable to # most other systems. # *** MACHINE DEPENDENT SUBROUTINE *** # # The format of the name is : # # name.ext # # Where "name" can be 8 characters long and "ext" can be 3 characters long # or not even present. (Never present on the HP 3000.) # subroutine outnam(name) character name(ARB) integer i, loc1, loc2 # Counter, array indices integer length # Length function integer index # HP3000 DEPENDENT loc1 = index(name,COLON) # strip off :modifier specifier if (loc1 > 0) name(loc1) = EOS loc1 = index(name,UNDERLINE) # strip off _machine specifier if (loc1 > 0) name(loc1) = EOS loc1 = index(name,PERIOD) # strip off .group specifier if (loc1 > 0) name(loc1) = EOS call upper (name) # uppercase name # U1100 DEPENDENT #i = 1 # Initialize counter #loc1 = iindex(name,PERIOD) # Locate PERIOD #if (name(loc1+1) == EOS) { # Name is "qualifier*fileid." # loc1 = iindex(name,STAR) # Locate asterisk # while (name(loc1+1) != EOS) { # Use "fileid" only # name(i) = name(loc1+1) # Remove "qualifier*" # INCR(i) # Increment indices # INCR(loc1) # } # if (i > 9) # If name too long .. # name(9) = EOS # Truncate it. # else # name(i-1) = EOS # } #else { # Name is an element specification # if (loc1 != 0) { # If name contains '.' # while (name(loc1+1) != EOS) { # Use element name only # name(i) = name(loc1+1) # Remove "qualifier*fileid" # INCR(i) # Increment indices # INCR(loc1) # } # name(i) = EOS # Terminate string # } # loc1 = iindex(name,SLASH) # Locate '/' # if (loc1 > 9) { # name(9) = PERIOD # Replace '/' with '.' # i = 10 # And truncate name to 8 characters # while (name(loc1+1) != EOS) { # Do till end of string # name(i) = name(loc1+1) # Shift characters to left # INCR(i) # Increment indices # INCR(loc1) # } # name(i) = EOS # Terminate new string # if (i-9 > 3) # If extension is too long .... # name(13) = EOS # Truncate it. # } # else if (loc1 != 0) { # If SLASH is found and length is OK, .. # name(loc1) = PERIOD # Replace '/' with '.' # loc2 = iindex(name,EOS) # Locate End Of String # if (loc2-loc1 > 4) # If extension is too long ... # name(loc1+4) = EOS # Truncate it. # } # else # if (length(name) > 8) # If name too long ... # name(9) = EOS # Truncate it. #} # END MACHINE DEPENDENT return end #-t- outnam 72 ascii 02/19/84 01:48:03 #-h- putbuf 44 ascii 02/19/84 01:48:04 # # P U T B U F # # Put a buffer full of data to given file # *** CONTAINS MACHINE DEPENDENT CODE *** # Because the U of U Univac 1100 strips trailing blanks during I/O # the padding used in this routine ensures that packets with trailing # blanks go out correctly formed. The computation used makes sure # that the final Univac word is filled. # subroutine putbuf(line, x, file) character line(ARB) # Array that holds packet filedes file # File descriptor integer x # Length of packet include cint # Common block of integers include cchar # Common block of characters integer i # Counter if (debug >= 3) call eprintf (" spack (raw):%s@n.", line) call putlin(line,file) # Send packet # U1100 DEPENDENT # for (i = (4 - mod(x,4)); i>0; i=i-1) # Compute padding to fill last word # call putch(PADU,file) # Put out padding # END MACHINE DEPENDENT call putch (eol, file) # put out requested end-of-line # MOST MACHINES # call putch(NEWLINE,file) # Use NEWLINE to flush output buffer # HP3000 DEPENDENT call putch (DC3, file) # make use of XON-XOFF control if it exists # should be ignored by other end otherwise call flush (file) # flush output buffer without NEWLINE # to avoid nullifying above XOFF call sleepm (swait) # debug # This is purely for testing robustness - it simulates a slow machine. # If we can take a few seconds here, we are safe. # END MACHINE DEPENDENT return end #-t- putbuf 44 ascii 02/19/84 01:48:04 #-h- quit # # Q U I T # # Kill Kermit and logout the session. # Session logout doesn't work on the 3000. # subroutine quit #call atat('term',4) # @@term command for Univac call unsetraw call endst(OK) # Clean up files. return end #-t- quit #-h- quiti # # Q U I T I # # Kill Kermit. # subroutine quiti include cint include cchar if (debug > 0) call eprintf ("%s: Control-Y Interrupt@n.", msghdr) call unsetraw call endst(INTERRUPT) # Clean up files. # HP3000 DEPENDENT return end #-t- quiti #-h- setraw 41 ascii 02/19/84 01:48:04 # # S E T R A W # # This routine sets tty line to raw mode. # *** MACHINE DEPENDENT SUBROUTINE *** # By raw mode we mean that the echo to the terminal is turned off and # the computer is configured to accept control characters as input. # Each system will probably have it's own way of accomplishing this. # subroutine setraw include cint integer isatty # HP3000 DEPENDENT on controly call quiti # set interrupt trap to cleanup procedure call setioc (lfdin, IO_ECHO, NO) # turn off echo if (isatty(lfdin) == YES) { call ffcontrol (lfdin, 39, ttype) # remember term type call ffcontrol (lfdin, 38, TERMTYPE) # set terminal type to # turn off HP's enk-ack handshaking call ffcontrol (lfdout, 36, 0) # turn off parity generation } #call setioc (lfdin, IO_MODE, RARE) # U1100 DEPENDENT #call atat('cque',4) # set type-ahead mode #call putch(MAGIC,lfdout) #call putch(MAGIC,lfdout) #call putch(MAGIC,lfdout) #call putch(MAGIC,lfdout) #call putch(NULL,lfdout) #call putch(NULL,lfdout) #call putch(NULL,lfdout) #call putch(SOH,lfdout) #call putch(NULL,lfdout) #call putch(NULL,lfdout) #call putch(NULL,lfdout) #call putch(NULL,lfdout) #call putch(NEWLINE,lfdout) # END OF MACHINE DEPENDENT CODE return end #-t- setraw 41 ascii 02/19/84 01:48:04 #-h- sleepm # # S L E E P M # # Sleep (suspend execution) for a given number of milliseconds. # subroutine sleepm (t) integer t # time to sleep in milliseconds # MOST MACHINES # call sleep (t/1000) # HP3000 DEPENDENT system intrinsic pause call pause (t/1000.0) # U1100 DEPENDENT # call twait (t) # END MACHINE DEPENDENT return end #-t- sleepm #-h- trunca 40 ascii 02/19/84 01:48:05 # # T R U N C A T E # # Truncate incoming file name. # *** MACHINE DEPENDENT SUBROUTINE *** # On the HP3000, expects a name consisting only of letters, digits, # and periods. # subroutine truncate(name) character name(ARB) integer index, length integer loc1,loc2, i, l2, l3 # HP3000 DEPENDENT loc1 = index (name, PERIOD) if (loc1 == 0) name(9) = EOS # Simple truncation else { loc2 = loc1 + index(name(loc1+1), PERIOD) # look for next period if (loc2 > 0) name(loc2) = EOS # truncate anything after a second period call scopy (name, loc1+1, name, loc1) # remove period name (max(9,loc1+2)) = EOS # truncate extension (leave at least 2 chrs) l2 = length(name) if (l2 > 8) call scopy(name,loc1,name,loc1-(l2-8)) # truncate name part to fit } # U1100 DEPENDENT #loc1 = iindex(name,SLASH) # Locate '/' in name #if (loc1 > 13) { # If location > 13 # name(13) = SLASH # Truncate name # i = 14 # while (name(loc1+1) != EOS) { # Shift extension left # name(i) = name(loc1+1) # INCR(i) # INCR(loc1) # } # name(i) = EOS # if (i > 26) # If extension > 12 # name(26) = EOS # Truncate it # } #else if (loc1 == 0) { # If no '/' in name # loc1 = length(name) # Check length of name # if (loc1 > 12) # If name > 12 characters # name(13) = EOS # Truncate it # } #else if (loc1 < 13) { # If name has '/' but location < 13 # loc2 = length(name) # Check length of extension # if (loc2 - loc1 > 12) # If extension > 12 characters # name(loc1+13) = EOS # Truncate it # } # END MACHINE DEPENDENT CODE return end #-t- trunca 40 ascii 02/19/84 01:48:05 #-h- unsetr 34 ascii 02/19/84 01:48:05 # # U N S E T R A W # # This routine undoes the effects of setraw. # *** MACHINE DEPENDENT SUBROUTINE *** # subroutine unsetraw include cint integer isatty # HP3000 DEPENDENT call setioc (lfdin, IO_ECHO, YES) if (isatty(lfdin) == YES) call ffcontrol (lfdin, 38, ttype) # restore terminal type #call setioc (lfdin, IO_MODE, COOKED) # U1100 DEPENDENT #call putch(MAGIC,lfdout) #call putch(MAGIC,lfdout) #call putch(MAGIC,lfdout) #call putch(MAGIC,lfdout) #call putch(NULL,lfdout) #call putch(NULL,lfdout) #call putch(NULL,lfdout) #call putch(CTRL_B,lfdout) #call putch(NULL,lfdout) #call putch(NULL,lfdout) #call putch(NULL,lfdout) #call putch(NULL,lfdout) #call putch(NEWLINE,lfdout) # END OF MACHINE DEPENDENT CODE return end #-t- unsetr 34 ascii 02/19/84 01:48:05 #-h- valida 27 ascii 02/19/84 01:48:05 # # V A L I D A T E # # Make sure name has valid characters. # *** MACHINE DEPENDENT SUBROUTINE *** # On the HP3000, invalid chars are deleted rather than replaced. # subroutine validate(name) character name(ARB) integer index, length integer loc1, i, j # HP3000 DEPENDENT call lower(name) # Lowercase name if (IS_DIGIT(name(1))) # If it has a leading digit { # insert a leading 'a' for (i=length(name)+1; i >= 1; i=i-1) name(i+1) = name(i) name(1) = LETA } j = 1 for (i=1; name(i) ^= EOS; i=i+1) if (IS_LETTER(name(i)) | IS_DIGIT(name(i)) | name(i) == PERIOD) { name(j) = name(i) # keep letters and digits only j = j + 1 } name(j) = EOS # terminate the string # U1100 DEPENDENT #string valid "ABCDEFGHIJKLMNOPQRSTUVWXYZ$/1234567890" #i = 1 #call upper(name) # Uppercase name #while (name(i) != EOS) { # Scan name # loc1 = iindex(valid,name(i)) # Checking for valid characters # if (loc1 == 0) # If invalid character is found # name(i) = MINUS # Replace it with '-' # INCR(i) # } # END MACHINE DEPENDENT return end #-t- valida 27 ascii 02/19/84 01:48:05 #-h- testbu # test_buf --- test kermit's bufill and bufemp functions - debug use only # Use of this routine (via call from main) makes kermit # copy from STDIN to STDOUT using bufill and bufemp. # The intermediate packets are displayed on ERROUT. subroutine test_buf character line(MAXLIN) include cint include cchar integer bufill, length dorept = YES dobquo = YES fd = STDIN repeat { i = bufill(line) if (i == EOF) break call eprintf ("packet (%d long):%s:@n.", i, line) if (length(line) ^= i) { call eprintf ("length = %d :.", length(line)) for (j=1; j<=i; j=j+1) call putch(line(j), ERROUT) call putch (NEWLINE, ERROUT) } call bufemp (line, STDOUT, i) } call flush(STDOUT) call endst(OK) # exit program return # dummy end #-t- testbu #-t- kermit.r 2486 ascii 05/30/84 23:45:50