begin ; ! EFTP - Ethernet File Transfer Program
option  "-nocheck-nodiag"

! RWT 04/11/85 filename strings 31 -> 127
! RWT 10/05/85 newline before potentially long error reports
! RWT 02/04/85 as follows:
! - heap stuff tidied up to fit in with V0 Imp
! - changed all references to FSPORT to LSAP
! - wildcard 'Illegal userno' bug fixed
! - removed support for old Interdata filestore (16_70)
! - removed alternative names "Big" and "Wee"
! JHB 30/10/84 but not happy about heap stuff - nasty hack in READIN.
! JHB 27/06/86 VAX generation numbers made innocuous
! JHB 10/02/87 Filestores "D" and "M" added
! RWT 15/10/87 Catch duplicated (sequence-number-zero?) packets

include  "inc:util.imp"
include  "inc:fs.imp"
constinteger  bel=7

!Commands available

constinteger  maxcommand = 8
ownstring (15)array  commandname(1:maxcommand)=
"Login","Transfer","Compare","Backup","Exit","Files",
"Source","Destination"

!Filename stuff

constinteger  maxnodes=7
conststring (15)array  nodename(1:maxnodes)=
  "Alpha","Bravo","Charlie","Demo",
  "Vax","Met","Portable"
constbytearray  nodenum(1:maxnodes)=
  16_14, 16_15, 16_1B, 16_35,
  16_72, 16_44, 16_3F
recordformat  slotf(integer  portno,nodeno,userno)
recordformat  filef(integer  nodeno,xno,stamp,record (slotf)name  slot,
                    string (127)node,path,file,record (filef)name  next)
constinteger  maxslot=31
record (filef)source,destination,nodefault
record (slotf)array  slot(1:maxslot)

routine  fillin(string (*)name  s,integer  dte)
integer  i
  dte = rdte if  dte=0
  for  i = 1,1,maxnodes cycle 
    s = nodename(i) andreturnif  nodenum(i)=dte
  repeat 
end 

routine  fail
  printsymbol(bel)
  signal  15
end 

! Miscellaneous string operations

predicate  eq(string (*)name  a,b)  {A full, B partial}
! True iff string B is a leading substring of A.
! Case not significant.
integer  i,m,n
  falseunless  length(a)>=length(b)
  for  i = 1,1,length(b) cycle 
    m = charno(a,i); n = charno(b,i)
    m = m!32 and  n = n!32 if  'a'<=n!32<='z'
    falseunless  m=n
  repeat 
  true 
end 

integerfn  htoi(string (*)name  s,integername  p)
! Return the integer value of the hex number, if any, starting at
! charno(P,S), advancing P past any digits actually processed.
integer  k,n = 0
  cycle 
    result  = n if  p>length(s)
    k = charno(s,p)
    k = k!32 if  'A'<=k<='F'
    if  'a'<=k<='f' start 
      k = k-'a'+10
    elseif  '0'<=k<='9'
      k = k-'0'
    finishelseresult  = n
    n = n<<4+k; p = p+1
  repeat 
end 

integerfn  dtoi(string (*)name  s,integername  p)
! Return a decimal number from S, skipping terminator
integer  k,n=0
  p = p+1 while  p<=length(s) and  charno(s,p)<=' '
  cycle 
    result  = n if  p>length(s)
    k = charno(s,p)-'0'; p = p+1
    result  = n unless  0<=k<=9
    n = n*10+k
  repeat 
end 

string (255)fn  wtos(string (*)name  s,integername  p)
! Read a word (delimited by spaces) from S.
string (255)t = ""
integer  k
  p = p+1 while  p<=length(s) and  charno(s,p)<=' '
  cycle 
    result  = t if  p>length(s)
    k = charno(s,p); p = p+1
    result  = t if  k<=' '
    t = t.tostring(k)
  repeat 
end 

integerfn  stamp(string (*)name  s,integername  p)
! Assuming S contains a date/time of the form `DD/MM/YY HH.SS`,
! read that and turn it into a monotonic integer.
! Year should be in the range 75-95 approx
integer  day=0,month=0,year=0,hour=0,minute=0
  predicate  skipped(integer  c)
    falseif  p-1>length(s)
    trueif  charno(s,p-1)=c
    false 
  end 
  day = dtoi(s,p)
  if  skipped('/') start 
    month = dtoi(s,p)
    if  skipped('/') start 
      year = dtoi(s,p)
      if  skipped(' ') start 
        hour = dtoi(s,p)
        if  skipped('.') start 
          minute = dtoi(s,p)
        finish 
      finish 
    finish 
  elseif  skipped('.')
    hour = day; day = 0
    minute = dtoi(s,p)
  finishelse  day = 0
  year = 75 if  year<75
  result  = ((((year-75)*100+month)*100+day)*100+hour)*100+minute
end 

!Wildcard stuff

constinteger  wildmax=10
string (127)array  wc(1:wildmax)
integer  wp=0

integerfn  wildness(string (*)name  s)
integer  k,i,w=0
  for  i=1,1,length(s) cycle 
    k = charno(s,i); w = w+1 if  k='*' or  k='%'
  repeat 
  result  = w
end 

predicate  matches(string (*)name  s,p,integer  w)
! S=Subject, P=Pattern. Pattern is the one with the stars in it.
! The bits in S corresponding to wildcards in P are
! stored in global array WC at index position W upwards.
! The global WC index pointer WP is updated appropriately.
integer  slen,plen
  predicate  m(integer  spos,ppos,wpos)
  integer  psym,ssym
    cycle 
      if  ppos=plen start 
        trueif  spos=slen; false 
      finish 
      ppos = ppos+1; psym = charno(p,ppos)
      exitif  psym='*'
      falseif  spos=slen
      spos = spos+1; ssym = charno(s,spos)
      psym = ssym if  ssym!32=psym!32 and  'a'<=psym!32<='z'
      unless  ssym=psym start 
        falseunless  psym='%'
        wpos = wpos+1; wc(wpos) = tostring(ssym)
        wp = wpos
      finish 
    repeat 
    wpos = wpos+1; wc(wpos) = ""; wp = wpos
    cycle 
      trueif  m(spos,ppos,wpos)
      exitif  spos=slen
      spos = spos+1; ssym = charno(s,spos)
      wc(wpos) = wc(wpos).tostring(ssym)
    repeat 
    wp = wpos-1; false 
  end 
  slen = length(s); plen = length(p)
  wp = w
  trueif  m(0,0,w); false 
end 

routine  translate(record (filef)name  template,input,output)
! Substitutes the wild cards in OUTPUT with the bits of INPUT
! that correspond to the wildcards in TEMPLATE.
string (255)s,f,a,r
integer  i
  returnunless  wildness(output_file)>0 and  matches(input_file,template_file,0)
{printstring("With ".template_file." ".input_file." translates to ")
  r = ""; s = output_file
  s = f."*".a while  s->f.("%").a
  i = 1
  while  s->f.("*").a cycle 
    r = r.f
    r = r.wc(i) and  i = i+1 if  i<=wp
    s = a
  repeat 
  r = r.s
  output_file = r
{printstring(r);newline
end 

routine  printfilename(record (filef)name  r)
  printstring("::".r_node.":") unless  r_node=""
  printstring(r_path.r_file)
end 

! Ether primitives

predicate  gotack(integer  port)
! Wait for ACK and return TRUE.
! Return FALSE if fed up waiting.
integer  bit,deadline
  bit = 1<<port
  deadline = cputime+15000
  cycle 
    if  ack&bit#0 start 
      trueif  nak&bit=0
      nak = nak!!bit
      false 
    finish 
  repeatuntil  cputime>deadline
  false 
end 

predicate  gotdtx(integer  port)
! Wait for DTX and TRUE.  FALSE when fed up
integer  bit,deadline
  bit = 1<<port
  deadline = cputime+15000
  cycle 
    trueif  dtx&bit#0
  repeatuntil  cputime>deadline
  false 
end 

routine  check connection(integer  lsap)
string (255)s
bytename  b == length(s)
  routine  part1
    b = 3; b[1] = 'M'; b[2] = '0'; b[3] = nl
    etherwrite(lsap,b[1],b)
    unless  gotack(lsap) start 
      printstring("No 1st ack"); newline; return 
    finish 
    unless  gotdtx(lsap) start 
      printstring("Timeout waiting for 1st response"); newline; return 
    finish 
    b = etherread(lsap,b[1],255)
    b = 3; b[1] = 'G'; b[2] = '0'; b[3] = nl
    etherwrite(lsap,b[1],b)
    unless  gotack(lsap) start 
      printstring("No 2nd ack"); newline; return 
    finish 
    unless  gotdtx(lsap) start 
      printstring("Timeout waiting for 2nd response"); newline; return 
    finish 
    b = etherread(lsap,b[1],255)
    returnunless  b[1]='-'
    cycle 
      unless  gotdtx(lsap) start 
        printstring("Timeout waiting for extra response"); newline; return 
      finish 
      b = etherread(lsap,b[1],255)
    repeatuntil  b[1]#'-'
    printstring("Duplicate packet ignored"); newline
  end 
  routine  part2
    returnif  dtx&1=0
    b = etherread(0,b[1],255)
    printstring("Duplicate connect response ignored"); newline
  end 
  part1
  part2
end 

routine  connect(integer  port,node)
! Establish a connection between local port PORT
! and network server NODE providing facility 2 (Filestore)
string (127)reply
integer  i
byte  facility
{printstring("Attempting to connect port "); phex2(port)
{printstring(" to node "); phex2(node); newline
  facility = 2
  etheropen(port,node<<8)
  etherwrite(port,facility,1)
  unless  gotack(port) start 
    printstring("Node "); phex2(node)
    printstring(" not acknowledging connect request")
!   etherclose(port)
    newline
    fail
  finish 
  unless  gotdtx(port) start 
    printstring("Node "); phex2(node)
    printstring(" not responding to connect request")
!   etherclose(port)
    newline
    fail
  finish 
  length(reply) = etherread(port,charno(reply,1),127)
  i = charno(reply,length(reply))
  unless  i=nl and  length(reply)=2 and  charno(reply,1)>'0' start 
    printstring("Cannot connect to node "); phex2(node)
    printstring(": ".reply)
    etherclose(port)
    newline unless  i=nl
    fail
  finish 
  i = charno(reply,1)-'0'
  etheropen(port,node<<8+i)
{printstring("Local port "); phex2(port); printstring(" connected to node ")
{phex2(node); printstring(" port "); phex2(i); newline
  check connection(port)
end 

routine  disconnect(record (slotf)name  s)
byte  eot = 12
  onevent  15 start 
    return 
  finish 
  returnif  s_nodeno=-1
{printstring("Attempting to disconnect port "); phex2(s_portno)
{printstring(" from node "); phex2(s_nodeno); newline
  etherwrite(s_portno,eot,1)
  unless  gotack(s_portno) start 
    printstring("Cannot disconnect port "); phex2(s_portno)
    printstring(" from node "); phex2(s_nodeno)
    printstring(" - Nak")
    fail
  finish 
  etherclose(s_portno)
  s_nodeno = -1
{printstring("Disconnected port "); phex2(s_portno)
{printstring(" from node "); phex2(s_nodeno)
{newline
end 

! Filestore primitives

routine  chopcheck(record (filef)name  n)
  returnunless  n_nodeno=0 and  lsap{fsport}=0
  printstring("Default Node now meaningless"); newline; fail
end 

routine  logout(record (slotf)name  s)
string (127)cr
  onevent  15 start 
    return 
  finish 
  returnif  s_userno=0
{printstring("Attempting to log "); phex2(s_userno)
{printstring(" off node "); phex2(s_nodeno); newline
  cr = "M".tostring(s_userno+'0').tostring(nl)
  userno = 0 if  s_portno=lsap{fsport}
  etherwrite(s_portno,charno(cr,1),3)
  unless  gotack(s_portno) start 
    printstring("Log "); phex2(s_userno)
    printstring(" off "); phex2(s_nodeno)
    printstring(" fails - Nak"); newline
    fail
  finish 
  unless  gotdtx(s_portno) start 
    printstring("Log "); phex2(s_userno)
    printstring(" off "); phex2(s_nodeno)
    printstring(" fails - no response"); newline
    fail
  finish 
  length(cr) = etherread(s_portno,charno(cr,1),127)
{printstring("Logged "); phex2(s_userno)
{printstring(" off "); phex2(s_nodeno); newline
  printstring(cr) unless  cr=tostring(nl)
  s_userno = 0
end 

routine  login(record (filef)name  f)
string (127)cr
record (slotf)name  s
integer  len
  f_file = f_path and  f_path = "" if  f_file=""
  unless  f_path="" start 
    printstring("Try again with ".f_path.":".f_file); newline; fail
  finish 
  chopcheck(f)
  set terminalmode(noecho); prompt("Pass:")
  readline(cr); set terminalmode(nopage)
  cr = "L0".f_file.",".cr.tostring(nl)
  s == f_slot
  logout(s)
  etherwrite(s_portno,charno(cr,1),length(cr))
  unless  gotack(s_portno) start 
    printstring("Log ".f_file." on "); phex2(s_nodeno)
    printstring(" fails - Nak"); newline
    fail
  finish 
  unless  gotdtx(s_portno) start 
    printstring("Log ".f_file." on "); phex2(s_nodeno)
    printstring(" fails - no response"); newline
    fail
  finish 
  length(cr) = etherread(s_portno,charno(cr,1),127)
  len = length(cr)
  unless  len>=2 and  charno(cr,len)=nl and  charno(cr,1)>'0' start 
    printstring(substring(cr,3,length(cr)))
    newline unless  charno(cr,length(cr))=nl
    fail
  finish 
  s_userno = charno(cr,1)-'0'
{printstring("Logged ".f_file." on to "); phex2(s_nodeno)
{printstring(" as "); phex2(s_userno); newline
  userno = s_userno if  s_portno=lsap{fsport}
end 

integerfn  open(integer  mode,record (filef)name  f)
! Open a filestore file.  Mode should be 'S' for reading, 'T' for writing.
! 'T': result undefined
! 'S': result is file size (rounded up)
record (slotf)name  s
string (127)cr
integer  j,k,n
  chopcheck(f)
  s == f_slot
  cr = tostring(mode).tostring(s_userno+'0').f_path.f_file.tostring(nl)
  etherwrite(s_portno,charno(cr,1),length(cr))
  unless  gotack(s_portno) start 
    printstring("Open: Nak")
    newline; fail
  finish 
  unless  gotdtx(s_portno) start 
    printstring("Open: no response")
    newline; fail
  finish 
  length(cr) = etherread(s_portno,charno(cr,1),127)
  unless  length(cr)>0 and  charno(cr,1)>'0' start 
    newline
    printstring("Open: ".cr)
    newline unless  charno(cr,length(cr))=nl
    fail
  finish 
  f_xno = charno(cr,1)-'0'
  n = 0; j = 3
  while  j<length(cr) cycle 
    k = charno(cr,j); j = j+1; exitif  k<'0'
    n = n<<4-'0'+k
  repeat 
  result  = n<<9
{phex2(f_xno); space
end 

routine  close(record (filef)name  f)
record (slotf)name  s
string (127)cr
  onevent  15 start 
    return 
  finish 
  returnif  f_xno=0
  s == f_slot
  cr = "K".tostring(f_xno+'0').tostring(nl)
  etherwrite(s_portno,charno(cr,1),3)
  unless  gotack(s_portno) start 
    printstring("Close: Nak")
    newline; fail
  finish 
  unless  gotdtx(s_portno) start 
    printstring("Close: no response")
    newline; fail
  finish 
  length(cr) = etherread(s_portno,charno(cr,1),127)
  unless  cr=tostring(nl) start 
    newline
    printstring("Close: ".cr)
    newline unless  charno(cr,length(cr))=nl
  finish 
  f_xno = 0
end 

integerfn  readblock(record (filef)name  f,integer  address)
record (slotf)name  s
string (7)c
integer  count,pos,size,char
  onevent  15 start 
    result  = -1
  finish 
  s == f_slot
  c = "X".tostring(f_xno+'0').tostring(nl)
  etherwrite(s_portno,charno(c,1),3)
  unless  gotack(s_portno) start 
    printstring("Readblock: Nak"); newline; fail
  finish 
  unless  gotdtx(s_portno) start 
    printstring("Readblock: Timeout"); newline; fail
  finish 
  count = etherread(s_portno,byteinteger(address),999)
  pos = address; size = 0
  if  byteinteger(pos)<'0' start 
    newline
    printstring("Readblock: ")
    cycle 
      char = byteinteger(pos); pos = pos+1; printsymbol(char)
      count = count-1
    repeatuntil  char=nl or  count<=0
    newline unless  char=nl; fail
  finish 
  cycle 
    char = byteinteger(pos)-'0'; pos = pos+1
    exitif  char<0
    size = size<<4+char
  repeat 
  unless  size+pos-address=count start 
    printstring("Readblock: dubious size"); newline; fail
  finish 
  count = size
  while  count>0 cycle 
    count = count-1; byteinteger(address) = byteinteger(pos)
    address = address+1; pos = pos+1
  repeat 
  result  = size
end 

predicate  writeblock(record (filef)name  f,integer  address,size)
integer  save1,save2
record (slotf)name  s
string (127)cr
  onevent  15 start 
    false 
  finish 
  save1 = integer(address-4); save2 = integer(address-8)
  byteinteger(address-1) = nl
  byteinteger(address-2) = size&15+'0'
  byteinteger(address-3) = size>>4+'0'
  byteinteger(address-4) = f_xno+'0'
  byteinteger(address-5) = 'Y'
  s == f_slot
  etherwrite(s_portno,byteinteger(address-5),size+5)
  integer(address-4) = save1; integer(address-8) = save2
  unless  gotack(s_portno) start 
    printstring("Writeblock: Nak"); newline; fail
  finish 
  unless  gotdtx(s_portno) start 
    printstring("Writeblock: Timeout"); newline; fail
  finish 
  length(cr) = etherread(s_portno,charno(cr,1),127)
  trueif  cr = tostring(nl)
  newline
  printstring("Writeblock: ".cr); newline unless  charno(cr,length(cr))=nl
  fail
end 

routine  readin(record (filef)name  file,integername  start,length)
integer  pos,dif
  onevent  15 start 
    length = -1; return 
  finish 
! pos = heapget(0)
  pos = heapget(open('S',file))
  start = pos; length = 0
  cycle 
    dif = readblock(file,pos)
    if  dif<0 start 
      close(file); length = -1; return 
    finish 
    pos = pos+dif
    length = length+dif
  repeatuntil  dif#512
  close(file)
! pos = heapget(length)
{phex(length); space
end 

routine  writeout(record (filef)name  file,integer  pos,length)
integer  size,ignore
string  (255) jhb1, jhb2
string (7)guess
  onevent  15 start 
    return 
  finish 
  returnunless  length>0
  size = (length+511)>>9
  guess =       tostring(size>>8+'0')
  guess = guess.tostring(size>>4&15+'0')
  guess = guess.tostring(size>>0&15+'0')
  !JHB mod - remove VAX generation numbers if present
  if  file_file -> file_file.(";1") start ; finish 
  file_file = jhb1."_".jhb2 if  file_file -> jhb1.(";").jhb2
  file_file = file_file.",".guess
  ignore = open('T',file)
  while  length>=512 cycle 
    returnunless  writeblock(file,pos,512)
    pos = pos+512; length = length-512
  repeat 
  unless  length=0 start 
    returnunless  writeblock(file,pos,length)
  finish 
  close(file)
end 

! EFTP primitives

routine  transfer(record (filef)name  source,dest)
! Copy one file
integer  ad,len
  onevent  15 start 
    release; return 
  finish 
  mark
  printfilename(source); space
  readin(source,ad,len)
  release andreturnif  len<0
  printstring("to "); printfilename(dest); space
  writeout(dest,ad,len)
  newline
  release
end 

routine  compare(record (filef)name  s1,s2)
! Compare one file pair
integer  a1,a2,l1,l2
  onevent  15 start 
    release; return 
  finish 
  mark
  printfilename(s1); space
  readin(s1,a1,l1)
  release andreturnif  l1<0
  printstring("and "); printfilename(s2); space
  readin(s2,a2,l2)
  release andreturnif  l2<0
  ->no unless  l1=l2
  while  l1>=4 cycle 
    ->no unless  integer(a1)=integer(a2)
    a1 = a1+4; a2 = a2+4; l1 = l1-4
  repeat 
  while  l1>=1 cycle 
    ->no unless  byteinteger(a1)=byteinteger(a2)
    a1 = a1+1; a2 = a2+1; l1 = l1-1
  repeat 
  release
  printstring("are identical"); newline; return 
no: printstring("are different"); newline; fail
end 

record (filef)map  flist(record (filef)name  r)
! Return a list of file records which match the spec in R
record (filef)name  file,list
record (slotf)name  slot
string (127)c,s,dump
bytename  ms,ls
integer  fileno,i,j,l

  routine  finfo(integer  fileno)
    ms = fileno>>4+'0'; ls = fileno&15+'0'
    etherwrite(slot_portno,charno(c,1),length(c))
    unless  gotack(slot_portno) start 
      printstring("Finfo: Nak"); newline; fail
    finish 
    unless  gotdtx(slot_portno) start 
      printstring("Finfo: no response"); newline; fail
    finish 
    length(s) = etherread(slot_portno,charno(s,1),127)
    if  s="" or  charno(s,1)<'0' start 
      newline
      printstring("Finfo: ".s); newline unless  charno(s,length(s))=nl; fail
    finish 
  end 

  result  == r if  wildness(r_file)=0
  slot == r_slot
  list == nil
  fileno = 1
  c = "F".tostring(slot_userno+'0').r_path
  length(c) = length(c)-1 if  charno(r_path,length(r_path))=':'
  c = c.",00".tostring(nl)
  ms == charno(c,length(c)-2); ls == charno(c,length(c)-1)
  finfo(0)
  cycle 
    finfo(fileno)
    i = 1; j = htoi(s,i); i = i+1; exitif  j=0
    fileno = fileno+1
    dump = wtos(s,i)
    wp = 0
    if  matches(dump,r_file,0) start 
      l = sizeof(file); file == new(file){l)
      file = r; file_next == list; list == file
      file_file = dump
      dump = wtos(s,i)
      file_stamp = stamp(s,i)
    finish 
  repeat 
  result  == list
end 

routine  readfilename(record (filef)name  r,default)
!Read a file name, split it into its constituent parts,
!viz NODE (i.e. server machine name), PATH, and FILENAME.
!Translate the node name into a node number, and connect.
string (255)s,n,d,f
record (slotf)name  sl
integer  i

routine  read string terminated by space comma or slash(string (*)name  s)
string (255)fore,aft
integer  sym
  readsymbol(sym) until  sym>' '
  s = ""
  cycle 
    s = s.tostring(sym)
    sym = nextsymbol
    exitif  sym<=' ' or  sym='/' or  sym=','
    skipsymbol
  repeat 
  skipsymbol unless  sym<=' '
  if  s -> fore.("::").aft start 
    s = "::".fore.":".aft unless  fore=""
  finish 
end 

  read string terminated by space comma or slash (s)
  if  length(s)>=2 and  substring(s,1,2)="::" start 
    s = substring(s,3,length(s))
    n = s and  s = "" unless  s -> n.(":").s
  finishelse  n = ""
  s = substring(s,2,length(s)) if  length(s)>=1 and  charno(s,1)=':'
  if  s -> d.("]").f start 
    d = d."]"
  elseif  s -> d.(":").f
    d = d.":"
  else 
    d = ""; f = s
  finish 
  r = 0
  n = default_node if  n=""
  d = default_path if  d=""
  f = default_file if  f=""
  r_node = n
  r_path = d
  r_file = f
  unless  n="" start 
    for  i = 1,1,maxnodes cycle 
      if  eq(nodename(i),n) start 
        r_node = nodename(i)
        r_nodeno = nodenum(i); ->ref
      finish 
    repeat 
    i = 1; r_nodeno = htoi(n,i)
    if  i<=length(n) start 
      printstring("Unknown node `".n."`"); newline
      r_node = ""
    finish 
  finish 
ref:
!Plug in the slot through which node R_NODENO may be referenced.
  for  i = 1,1,maxslot cycle 
    sl == slot(i)
    if  sl_nodeno=r_nodeno start 
      r_slot == sl
      fillin(r_node,r_nodeno)
      return 
    finish 
  repeat 
  if  r_nodeno=0 start 
    printstring("Default node now meaningless"); newline; fail
  finish 
  i = 1
  cycle 
    if  i>maxslot start 
      printstring("No local port"); newline; fail
    finish 
    sl == slot(i); exitif  sl_nodeno=-1
    i = i+1
  repeat 
  connect(i,r_nodeno)
  sl_nodeno = r_nodeno
  r_slot == sl
end 

routine  shutdown
record (filef)name  reconnect
record (slotf)name  s
integer  i
  for  i = 1,1,maxslot cycle 
    s == slot(i)
    continueif  s_nodeno=0
    logout(s) unless  s_userno=0
    disconnect(s)
  repeat 
  returnunless  lsap{fsport}=0
  twait; ethc = 15; twait
  etheropen(lsap,rdte<<8+rsap); fsport = lsap
  printstring("Re-connected to node "); phex2(rdte); newline
  check connection(fsport)
end 

integerfn  command
string (127)v
integer  i
  prompt("EFTP>"); read(v); v = v."*"
  for  i = 1,1,maxcommand cycle 
    result  = i if  matches(commandname(i),v,0)
  repeat 
  result  = 0
end 

routine  do exit
  signal  9
end 

routine  do login
record (filef)r
  do exit if  nextsymbol=nl
  readfilename(r,nodefault); skipsymbol
  login(r)
end 

routine  do transfer
record (filef)s,d,temp
record (filef)name  list
  prompt("From "); readfilename(s,source)
  prompt("To "); readfilename(d,destination)
  s_file = "*" if  s_file=""
  d_file = s_file if  d_file=""
  mark
  list == flist(s)
  while  list##nil cycle 
    temp = d
    translate(s,list,temp)
    transfer(list,temp)
    list == list_next
  repeat 
  release
end 

routine  do compare
record (filef)s1,s2,temp
record (filef)name  list
  prompt("File 1 "); readfilename(s1,source)
  prompt("File 2 "); readfilename(s2,destination)
  s1_file = "*" if  s1_file=""
  s2_file = s1_file if  s2_file=""
  mark
  list == flist(s1)
  while  list##nil cycle 
    temp = s2
    translate(s1,list,temp)
    compare(list,temp)
    list == list_next
  repeat 
  release
end 

routine  do files
record (filef)file
record (filef)name  list
  prompt("Filename:"); readfilename(file,source)
  file_file = file_file."*" if  wildness(file_file)=0
  mark
  list == flist(file)
  if  list==nil start 
    release
    printstring("No such files"); newline
    return 
  finish 
  while  list##nil cycle 
    printstring(list_file); newline
    list == list_next
  repeat 
  release
end 

routine  do backup
record (filef)s,d,temp
record (filef)name  list
integer  p,now,since,dd,mm,yy
string (127)dt
  prompt("From "); readfilename(s,source)
  s_file = "*" if  s_file=""
  unless  wildness(s_file)>0 start 
    readsymbol(p) until  p=nl
    printstring("No wildcard?"); newline; fail
  finish 
  prompt("To "); readfilename(d,destination)
  d_file = s_file if  d_file=""
  prompt("Since "); read(dt)
  p = 1; since = stamp(dt,p)
  dt = datetime; p = 1; now = stamp(dt,p)
  yy = now//100000000
  mm = now//1000000-yy*100
  dd = now//10000-mm*100-yy*10000
  since = since+dd*10000 if  since//10000=0
  since = since+mm*1000000 if  since//1000000=0
  since = since+yy*100000000 if  since//100000000=0
{printstring("Threshold="); write(since,0); newline
  mark
  list == flist(s)
  while  list##nil cycle 
{printfilename(list); write(list_stamp,1); newline
    if  list_stamp>=since start 
      temp = d
      translate(s,list,temp)
      transfer(list,temp)
    finish 
    list == list_next
  repeat 
  release
end 

routine  do source
  prompt("Filename:"); readfilename(source,nodefault)
end 

routine  do destination
  prompt("Filename:"); readfilename(destination,nodefault)
end 

routine  do(integer  x)
integer  i
switch  sw(0:maxcommand)
  ->sw(x)
sw(0): printstring("The following commands are available:"); newline
  for  i = 1,1,maxcommand cycle 
    printstring(commandname(i))
    if  i=maxcommand then  newline else  space
  repeat 
  printstring("Type EXIT to leave this program,")
  printstring(" then HELP EFTP for more information."); newline
  readsymbol(x) until  x=nl; return 
sw(1): do login; return 
sw(2): do transfer; return 
sw(3): do compare; return 
sw(4): do backup; return 
sw(6): do files; return 
sw(7): do source; return 
sw(8): do destination; return 
sw(5): do exit
end 

routine  initialise
record (slotf)name  sl
integer  i
  for  i=1,1,maxslot cycle 
    sl == slot(i)
    sl_portno = i; sl_nodeno = -1; sl_userno = 0
  repeat 
  sl == slot(lsap{fsport})
  sl_nodeno = 0; sl_userno = userno
  source = 0; destination = 0; nodefault = 0
end 

routine  main program
integer  x
  onevent  0,3,9,15 start 
    unless  event_event=15 start 
      shutdown; return 
    finish 
    x = testsymbol until  x<0
  finish 
  cycle 
    do(command)
  repeat 
end 

!printstring("EFTP Version 04/11/85"); newline
set terminalmode(nopage)
initialise
main program

endofprogram