%begin; ! Ethernet File Transfer Program
! 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/6/86  VAX generation numbers made innocuous
! JHB 10/2/87  Filestores "D" and "M" added

%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 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
%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
%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