#-h- chyp            1534  asc  11-nov-82 07:18:16  tools (lblh csam sventek)
common / chyp / chan, receive, start_time, nxmt, nrcv, request(32),
                rcvbuf(512), xmtbuf(512)

integer chan			# channel number from assign
integer receive			# YES/NO if this is the receiver
integer start_time		# start of transfer (receive only)
integer nxmt			# number of bytes transmitted (receive only)
integer nrcv			# number of bytes received (receive only)
logical*1 request		# THC request buffer
logical*1 rcvbuf		# receive buffer
logical*1 xmtbuf		# transmit buffer

logical*1 type, node_to, text_mode, rspnse_mode, name(8)
integer*2 timeout, text_code, response_code, text_count, response_count,
          response_buffer_length
integer*4 text_data_address, response_data_address

equivalence (type, request(1)),			# type of request
            (node_to, request(2)),		# node id - 0 => solicit
            (timeout, request(3)),		# timeout value
            (name(1), request(5)),		# connection name
            (text_code, request(13)),		# connect code | ignored
            (response_code, request(15)),	# connect code | ignored
            (text_count, request(17)),		# size of sent data
            (response_count, request(19)),	# size of response data
            (text_mode, request(21)),		# mode of sent data ('A')
            (rspnse_mode, request(22)),		# mode of response data
            (response_buffer_length, request(23)), # size of receive buffer
            (text_data_address, request(25)),	# address of send buffer
            (response_data_address, request(29))# address of receive buffer
#-h- hypdef           253  asc  22-dec-82 22:33:13  tools (lblh csam sventek)
define(initrx,hypirx)
define(inittx,hypitx)
define(netfin,hypfin)
define(netget,hypget)
define(netput,hypput)
define(smtptx,hmtptx)
define(NETWORK_TYPE,"HYPER")
define(CONTINUOUS_SERVER,)		# after call to finish routine, wait
					# for another connect
#-h- hyper.r         9438  asc  08-aug-83 20:49:11  system (system manager)
#-h- defns            387  asc  19-jul-82 09:17:46  tools (lblh csam sventek)
include mailsym

define(HYP_POST,5)
define(HYP_ACK,1)
define(HYP_CLOSE,3)
define(HYP_CONNECT,4)
define(HYP_XMT,8)
define(IO_ACCESS,16%32)
define(KLUDGE_TIME,5)		# number of seconds to sleep waiting for
				# receiver to be able to avoid
				# "Protocol Errors"
define(CRC_MASK,8%120001)	# mask for CRC-16 (see VAX arch. p.305)
define(CRC_SEED,0)		# seed for CRC-16 (see VAX arch. p.305)
#-h- hypirx          1867  asc  08-aug-83 20:28:23  system (system manager)
integer function hypirx(host)

character host(ARB)
integer dsc(2), i, status, j, junk, stat
integer hypqio, sys$assign, exetim, sleep

include chyp

string thc    "THC"
string service(9)   "SMTP"
string passwd "PASSWORD"
string msg0   "Posting offer for "
string msg1   "Acknowledging connect request from "
string netnam "hyper"

receive = YES
call setlog(LEVEL_NDX, L_TRACE)
call setlog(COUNT_NDX, 0)
call dscbld(dsc, thc)
repeat
  {
  status = sys$assign(dsc, chan,,)
  if (status)
    break
  junk = sleep(300)
  }
call gthost(netnam, host)
for (i=2, j=5; host(i) != EOS; i=i+1, j=j+1)
  if (i > 5)
    break
  else
    service(j) = host(i)
for ( ; j <= 8; j=j+1)
  service(j) = ' '
service(j) = EOS
call upper(service)
call concat(passwd, service, xmtbuf)
type = HYP_POST			# post offer
node_to = 0			# local host
timeout = 0			# wait forever
for (i=1; i <= 8; i=i+1)
  name(i) = service(9 - i)
text_code = 16%18		# wait until corresponding connect
response_code = 0
text_count = 24			# Wayne, why is this?
response_count = 0
text_mode = 'A'			# ASCII text
rspnse_mode = 0
response_buffer_length = 512	# full buffer size
text_data_address = %loc(xmtbuf)# address of transmit buffer
response_data_address = %loc(rcvbuf)	# address of receive buffer
call errlog(msg0, service, L_TRACE)
repeat				# wait for success or !Network-timeout
  stat = hypqio(status)
until (stat == OK | (stat == ERR & status != 8%42))
if (stat == ERR)
  {
  call hyplog("Error posting offer.", status, ERROUT)
  call sys$dassgn(%val(chan))
  chan = 0
  return(ERR)
  }
text_code = 16%18
text_count = 0
text_mode = 'A'
type = HYP_ACK
call errlog(msg1, rcvbuf(33), L_TRACE)
if (hypqio(status) == ERR)
  {
  call hyplog("Error acknowledging connect request.", status, ERROUT)
  call sys$dassgn(%val(chan))
  chan = 0
  return(ERR)
  }
start_time = exetim(0)
nxmt = 0
nrcv = 0

return(OK)
end
#-h- hypqio           500  asc  16-jul-82 08:07:49  tools (lblh csam sventek)
integer function hypqio(status)

integer efn, stat, status
integer sys$qiow
logical*1 iosb(8)

include chyp

integer*2 return_status
logical*1 return_error
equivalence (return_status, iosb(1)), (return_error,iosb(5))

data efn/0/

if (efn == 0)
  call lib$get_ef(efn)
stat = ERR
status = sys$qiow(%val(efn), %val(chan), %val(IO_ACCESS), %ref(iosb),,,
                  %ref(request),,,,,)
if (status)			# qiow was OK
  {
  status = return_error
  if (status == 0)
    stat = OK
  }

return(stat)
end
#-h- hypfin           910  asc  19-jul-82 08:13:04  tools (lblh csam sventek)
subroutine hypfin

integer junk, status, dsc(2)
integer hypqio, exetim, itoc

include chyp

string null   ""
string command "hmtprx ??~msg/hyper.log"

type = HYP_CLOSE
text_count = 0
junk = hypqio(status)
if (receive == YES)
  {
  junk = exetim(start_time)
  call fmttim("Elapsed wall time for transfer = ", junk, xmtbuf)
  call errlog(xmtbuf, null, L_TRACE)
  junk = itoc(nxmt, xmtbuf, 20)
  call errlog("Number of transmitted bytes = ", xmtbuf, L_BABBLE)
  junk = itoc(nrcv, xmtbuf, 20)
  call errlog("Number of received bytes = ", xmtbuf, L_BABBLE)
  junk = nxmt+nrcv
  junk = itoc(junk, xmtbuf, 20)
  call errlog("Total number of bytes in transaction = ", xmtbuf, L_TRACE)
  call sys$dassgn(%val(chan))
  chan = 0
#  call getimg(xmtbuf)
#  call upper(xmtbuf)
#  call dscbld(dsc, command)
#  call lib$run_program(dsc)
#  call lib$do_command(dsc)
#  call remark("Error in chaining to self.")
  }

return
end
#-h- hypitx          1600  asc  08-aug-83 20:28:23  system (system manager)
integer function hypitx(thost, fhost)

character thost(ARB), fhost(HOST_SIZE)
integer dsc(2), i, status, j, junk
integer hypqio, sys$assign, sleep

include chyp

string thc    "THC"
string service(9)   "SMTP"
string hyper  "hyper"
string msg0   "Error assigning channel to device: "
string msg1   "Error connecting to server: "
string passwd "PASSWORD"

receive = NO
call gthost(hyper, fhost)
call dscbld(dsc, thc)
if (.not. sys$assign(dsc, chan,,))
  {
  call errlog(msg0, thc, L_COMM)
  return(ERR)
  }
for (i=1, j=5; thost(i) != EOS; i=i+1, j=j+1)
  if (i > 4)
    break
  else
    service(j) = thost(i)
for ( ; j <= 8; j=j+1)
  service(j) = ' '
service(j) = EOS
call upper(service)
call concat(passwd, service, xmtbuf)
for (i=17; i <= 24; i=i+1)
  xmtbuf(i) = 0			# <REMOTE-PROCESS> field
call stcopy(fhost, 2, xmtbuf, i)# pass our host name as <PARAMETERS>
text_count = i			# number of bytes to xmit
type = HYP_CONNECT		# connect to server
node_to = 0			# solicit offers
timeout = 0
for (i=1; i <= 8; i=i+1)
  name(i) = service(9 - i)
text_code = 16%10		# wait until corresponding connect
response_code = 0
response_count = 0
text_mode = 'A'			# ASCII text
rspnse_mode = 0
response_buffer_length = 512	# full buffer size
text_data_address = %loc(xmtbuf)# address of transmit buffer
response_data_address = %loc(rcvbuf)	# address of receive buffer
if (hypqio(status) == ERR)
  {
  call errlog(msg1, service, L_COMM)
  call hyplog("Error ", status, ERROUT)
  call sys$dassgn(%val(chan))
  chan = 0
  return(ERR)
  }
junk = sleep(KLUDGE_TIME)	# wait for receiver to get it together

return(OK)
end
#-h- hypget           671  asc  19-jul-82 09:09:44  tools (lblh csam sventek)
integer function hypget(buf)

character buf(ARB)
integer status, n
integer hypqio, check_crc

include chyp

string rcv "R: "
string null ""
string msg0 "Invalid CRC for received data"

text_count = 24
text_code = 1
text_mode = 'A'
timeout = 60
response_buffer_length = 512
type = HYP_XMT
if (hypqio(status) == ERR)
  {
  call hyplog("hypget - ", status, ERROUT)
  return(EOF)
  }
else
  {
  n = response_count
  if (check_crc(rcvbuf, n) == ERR)
    {
    call errlog(msg0, null, L_COMM)
    return(EOF)
    }
  for (i=1; i <= n; i=i+1)
    buf(i) = rcvbuf(i)
  buf(i) = EOS
  call errlog(rcv, buf, L_BABBLE)
  if (receive == YES)
    nrcv = nrcv + n
  return(n)
  }

end
#-h- hypput           563  asc  19-jul-82 09:09:45  tools (lblh csam sventek)
integer function hypput(buf)

character buf(ARB)
integer i, status, stat
integer hypqio

include chyp

string tos "T: "

for (i=1; buf(i) != EOS; i=i+1)
  xmtbuf(i) = buf(i)
i = i - 1				# number of bytes
call append_crc(xmtbuf, i)		# append 4 bytes of crc
text_count = i
type = HYP_XMT
text_mode = 'A'
text_code = 1
timeout = 60
response_buffer_length = 512
call errlog(tos, buf, L_BABBLE)
stat = hypqio(status)
if (stat == OK)
  {
  stat = i - 1
  if (receive == YES)
    nxmt = nxmt + stat
  }
else
  call hyplog("hypput - ", status, ERROUT)

return(stat)
end
#-h- hyplog           991  asc  08-aug-83 20:48:37  system (system manager)
subroutine hyplog(str, stat, fd)

character str(ARB), hyper_stat, temp(100)
integer stat, status
filedes fd

equivalence (status, hyper_stat)

string start(20)  " status = "

status = stat
switch (hyper_stat)
  {
  case 8%40: call strcpy("Protocol-Violation (40B)", temp)
  case 8%41: call strcpy("User-Timeout (41B)", temp)
  case 8%42: call strcpy("Network-Timeout (42B)", temp)
  case 8%43: call strcpy("Remote-Process-Error (43B)", temp)
  case 8%44: call strcpy("Remote-Process-Abort (44B)", temp)
  case 8%45: call strcpy("Operator-Disconnect (45B)", temp)
  case 8%46: call strcpy("Request-Already-Pending (46B)", temp)
  case 8%47: call strcpy("Offer-Not-Found (47B)", temp)
  case 8%50: call strcpy("Offer-In-Use (50B)", temp)
  case 8%51: call strcpy("Remote-Network-Timeout (51B)", temp)
  case 8%52: call strcpy("Remote-User-Timeout (52B)", temp)
  default:
    {
    call puthex(stat, start(11))
    call strcpy(start, temp)
    }
  }
call errlog(str, temp, L_COMM)

return
end
#-h- appcrc           425  asc  19-jul-82 09:17:47  tools (lblh csam sventek)
# subroutine to append 4-byte crc to buffer, incrementing length
subroutine append_crc(buf, n)

character buf(ARB)
integer n
logical*1 crc_b(4)
integer*4 crc_l, crc_table(16), dsc(2), i
integer*4 lib$crc

equivalence (crc_l, crc_b(1))

call lib$crc_table(CRC_MASK, crc_table)
dsc(1) = n
dsc(2) = %loc(buf)
crc_l = lib$crc(crc_table, CRC_SEED, dsc)
for (i=1; i <= 4; i=i+1)
  {
  n = n + 1
  buf(n) = crc_b(i)
  }

return
end
#-h- chkcrc           752  asc  08-aug-83 20:28:24  system (system manager)
# routine to check that the last four bytes of the buffer are a valid
# crc for the preceding bytes - see routine append_crc for the code
# which places the crc into the buffer
#
# if the crc matches, the length is reduced by 4 and the value OK is returned
#
# else ERR is returned
#
integer function check_crc(buf, n)

character buf(ARB)
integer n
integer*4 crc_table(16), dsc(2), crc_received, i, j, crc_sent
logical*1 crc_b(4)
integer*4 lib$crc

equivalence (crc_sent, crc_b(1))

call lib$crc_table(CRC_MASK, crc_table)
dsc(1) = n - 4
dsc(2) = %loc(buf)
crc_received = lib$crc(crc_table, CRC_SEED, dsc)
for (i=1, j=n-3; i <= 4; i=i+1, j=j+1)
  crc_b(i) = buf(j)
if (crc_received == crc_sent)
  {
  n = n - 4
  return(OK)
  }
else
  return(ERR)

end
#-h- starthyp.com     305  asc  22-dec-82 22:39:21  tools (lblh csam sventek)
$ hmtprx:==st_bin:hmtprx.exe
$ open/readonly/error=c1 unit st_usr:hmtprx.exe
$ close unit
$ hmtprx:==st_usr:hmtprx.exe
$ c1:
$ run/out=nla0:/input=nla0:/err=nla0:/process_name=hyper_smtp-
/prio=6/subp=0/file=15/buffer=4096/page=10240/queue=8/ast_limit=10-
/uic=[10,1]/priv=(nosame,tmpmbx,netmbx) 'hmtprx'
#-h- stophyp.com      161  asc  22-dec-82 22:40:02  tools (lblh csam sventek)
$ save_uic := 'f$user()'
$ save_dir := 'f$directory()'
$ set uic [10,1]
$ on error then continue
$ stop hyper_smtp
$ set uic 'save_uic'
$ set default 'save_dir'