home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
hp3000st
/
stkermit.w
< prev
next >
Wrap
Text File
|
2020-01-01
|
92KB
|
2,624 lines
#-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<BLANK | c7==DEL | c7==MYQUOTE |
(c7==MYBQUOTE & dobquo==YES) | (c7==MYREPTC & dorept==YES))
{ # need to quote this char
CHCOPY (MYQUOTE, buffer, i) # add quote char
if (c7<BLANK | c7==DEL)
{
c = ctl(c) # de-controlify control char
c7 = ctl(c7)
}
}
if (binfil == YES) # If in binary mode
CHCOPY (c, buffer, i) # Use the eight bit version
else # if in ascii mode
CHCOPY (c7, buffer, i) # Use the seven bit version
}
if (i-1 >= 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
