! LOG
! Logs off the current user.
! If a parameter is given, this is a new user name, whom we attempt
! to log on.  This user name may include (or, in fact, just be) a
! filestore identifier, in which case we connect to the new filestore.
! This involves disconnecting from the current filestore if the new
! filestore is a different one.
! If no parameter is given, we always disconnect.
! As an option, a log is kept of all loggings-on/off.
! On Gandalf machines DCD is waggled, causing the connection to be broken.

! RWT 10/90: added automatic trying on the "other" filestore if owner not found.

option  "-nocheck-nodiag-low"
include  "inc:fs.imp"
include  "inc:util.imp"
include  "inc:fsutil.imp"
include  "inc:dict.imp"

begin 
ownstring (3)terminal = ":t"

record (dictf)map  ofildict
  result  == fildict
end 

record (dictf)map  oextdict
  result  == extdict
end 

record (dictf)map  xxx(integer  parm)
  integer  p
  p = integer(16_3f9c)+parm
  result  == record(integer(p))
end 

record (dictf)map  fildict
  result  == xxx(740)
end 

record (dictf)map  extdict
  result  == xxx(736)
end 

constinteger  max=3
conststring (15)array  fname(1:max)=
  "A", "B", "C"
! "ALPHA", "BRAVO", "CHARLIE"
! "DEMO", "VAX", "MET"
constbytearray  fnumber(1:max)=
  16_14, 16_15, 16_1B
! 16_35, 16_72, 16_44

routine  confirm filestore(integer  x)
integer  i
  printstring("You are using filestore "); phex2(x)
  for  i = 1,1,max cycle 
    if  fnumber(i)=x start 
!     printstring(" - "); printstring(fname(i))
      printstring(" (filestore """); printstring(fname(i)); printstring(""")")
      exit 
    finish 
  repeat 
  newline
end 

integerfn  filestore(string (255)s)
string (15)fore,aft
integer  i,k,n
  result  = rdte if  s=""
  toupper(s)
  for  i = 1,1,max cycle 
    result  = fnumber(i) if  fname(i) -> fore.(s).aft and  fore=""
  repeat 
  n = 0
  for  i = 1,1,length(s) cycle 
    k = charno(s,i)
    if  '0'<=k<='9' start 
      n = n<<4+k-'0'
    elseif  'A'<=k<='F'
      n = n<<4+k-'A'+10
    else 
      n = 0; exit 
    finish 
  repeat 
  if  n=0 start 
    print line("Unknown filestore ".s)
    n = rdte
  finish 
  result  = n
end 

routine  do nothing
end 

predicate  nacked(integer  port)
integer  bit
  bit = 1<<port
  falseif  nak&bit=0
  nak = nak&¬bit
  true 
end 

routine  ackwait(integer  port)
integer  bit,deadline,marktime
  bit = 1<<port
  deadline = cputime+15000;  marktime=cputime+1000
  cycle 
    returnif  ack&bit#0
    printsymbol('.') and  marktime=marktime+1000 if  cputime>marktime
  repeatuntil  cputime>deadline
  print line("No ACK/NAK")
  signal  9
end 

routine  dtxwait(integer  port)
integer  bit,deadline,marktime
  bit = 1<<port
  deadline = cputime+7500; marktime=cputime+1000
  cycle 
    returnif  dtx&bit#0
    printsymbol('.') and  marktime=marktime+1000 if  cputime>marktime
  repeatuntil  cputime>deadline
  print line("No response")
  signal  9
end 

predicate  gotack(integer  port)
  on  9 start 
    false 
  finish 
  ackwait(port)
  falseif  nacked(port)
  true 
end 

predicate  gotdtx(integer  port)
  on  9 start 
    false 
  finish 
  dtxwait(port)
  true 
end 

routine  disconnect from filestore
byte  disc = {4}12
  returnif  rdte=0
  etherwrite(fsport,disc,1)
  ackwait(fsport)
  do nothing if  nacked(fsport)
  rdte = 0; rsap = 0
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 to filestore(integer  remote)
@16_ff7 byte  default
string (80)s
byte  con = 2
integer  port,original=rdte
  on  9 start 
    original = default if  original=0
    remote = original
    printstring("Going for "); phex2(remote); newline
  finish 
  returnif  remote=rdte
  disconnect from filestore
  lsap = 1; fsport = 1
  etheropen(fsport,remote<<8)
  etherwrite(fsport,con,1)
  ackwait(fsport)
  if  nacked(fsport) start 
    printstring("No Ack from station "); phex2(remote)
    return 
  finish 
  dtxwait(fsport)
  length(s) = etherread(fsport,charno(s,1),80)
  port = charno(s,1)-'0'
  if  port<0 start 
    printstring(substring(s,3,length(s)))
    return 
  finish 
  rdte = remote; rsap = port
  etheropen(fsport,remote<<8+port)
  check connection(fsport)
end 

routine  parse(string (255)name  s)
string (255)fore,aft,server,directory,pass=""
  s = fore and  pass = ",".aft if  s -> fore.(",").aft
  if  s -> fore.("::").aft start 
    if  fore="" start 
      s = aft
      if  s -> fore.(":").aft start 
        server = fore; directory = aft
      else 
        server = s; directory = ""
      finish 
    else 
      server = fore; directory = aft
    finish 
  else 
    server = ""; directory = s
  finish 
  s = directory.pass
  connect to filestore(filestore(server))
end 

@16_3ff0 integer  freebot
constinteger  bel=7
string (255)line
integer  dummy,quickflag
string  (255) user, pass

predicate  ended in(integer  sym,string (*)name  s)
  bytename  l
  l == length(s)
  falseif  l=0 or  charno(s,l)#sym
  l = l-1; true 
end 

routine  push(string (15)n,record (dictf)name  d)
record (dictf)name  old
integer  i = d_lim-d_pos
  if  i<24 start 
    print line(n." dictionary too full")
    return 
  finish 
  old == record(d_pos)
  old = d
  old_lim = old_pos
  d_beg = d_pos+16; d_alt = d_pos; d_pos = d_beg+8
  integer(i) = 0 for  i = d_beg,4,d_lim-4
end 

routine  pop(string (15)n,record (dictf)name  d)
record (dictf)name  old
  if  d_alt=0 start 
    print line(n." not popped")
    return 
  finish 
  old == record(d_alt)
  d_beg = old_beg; d_pos = old_pos; d_alt = old_alt
end 

routine  autoforget
record (dictf)name  d
string (255)s
integername  w1,w2
integer  tag,min
  min = freebot
  d == fildict
  tag = d_beg+8
  while  tag<d_pos cycle 
    tag = tag+4 until  byteinteger(tag)=0
    tag = tag+4
    w1 == integer(tag); w2 == integer(tag+4)
    if  w1#0 and  w1<w2 start 
      min = w1 if  w1<min
    finish 
    tag = tag+8
  repeat 
restart:
  d == fildict
  cycle 
    tag = d_beg+8
    while  tag<d_pos cycle 
      tag = tag+4 until  byteinteger(tag)=0
      tag = tag+4
      w1 == integer(tag); w2 == integer(tag+4)
      if  w1>=min and  w1<w2 and  w2=freebot start 
        w2 = w1; freebot = w1; ->restart
      finish 
      tag = tag+8
    repeat 
    exitif  d_alt=0
    d == record(d_alt)
  repeat 
end 

predicate  exists(string (31)file)
  onevent  3 start 
    false 
  finish 
  openinput(0,file); selectinput(0)
  true 
end 

routine  copy
integer  sym
  onevent  9 start 
    closeinput
    return 
  finish 
  cycle 
    readsymbol(sym); printsymbol(sym)
  repeat 
end 

routine  log off
integer  dump
  onevent  3 start 
    selectoutput(0)
    print line("Logoff: ".event_message)
    return 
  finish 
  dump = fcomm('M'<<8,"") unless  userno=0
end 

routine  stop
constinteger  bel=7,esc=27,dim='4',bright='3'
integer  original

  routine  await activity
    onevent  0,9 start 
      openinput(0,terminal); selectinput(0)
      printsymbol(bel)
    finish 
    prompt(" } ")
    skipsymbol whilenot  ' '#nextsymbol#nl
  end 

  predicate  on gandalf
  string (255)x
  integer  tag
    tag = refname("GANDALF",comdict)
    falseif  tag<=0
    tag = integer(tag)
    transname(tag,x)
    tag = length(x)
    falseif  tag=0
    tag = charno(x,tag)&1
    falseif  tag=0
    true 
  end 

  routine  disconnect from gandalf
  @16_4000c1 byte  s

    routine  wait
    integer  delay=40000
    integer  i
      for  i = 1,1,delay cycle ; repeat 
    end 

!   %routine break on
!     s = 16_71
!   %end

!   %routine break off
!     s = 16_91
!   %end

    routine  dcd off
      s = 16_55
    end 

    routine  dcd on
      s = 16_95
    end 

    onevent  0 start 
      return 
    finish 

    returnunless  on gandalf
    printstring("Goodbye!"); newline
!   wait; break on; wait; break off
!   wait; break on; wait; break off
!   wait; break on; wait; break off
    wait; dcd off; wait; dcd on
    cycle ; repeat ; ! wait for ^Y or ^T/R
  end 
  original = rdte
  disconnect from filestore
  disconnect from gandalf
  await activity
  connect to filestore(original)
  stop 
end 

routine  get user pass(string  (255) line, string  (255) name  user, pass)
! Inspect the parameter line.  If it contains comma or space,
! then that is assumed to separate the ownername from the password.
! Otherwise we suppress echo and ask for the password.
  integer  sym
  return  if  line -> user.(" ").pass or  line -> user.(",").pass
  user=line; pass=""
  prompt("Pass:")
  set terminal mode(1); ! Disable echo
  cycle 
    readsymbol(sym); exitif  sym=nl
    pass = pass.tostring(sym)
  repeat 
  set terminal mode(0); ! Back to normal
end 

routine  pds(string  (255) user, integer  flag)
! Make an entry in the log file LOG:.logfile, giving the date,
! 1 for on, 0 for off, the machine number, and the username.
! encoding is to minimise space: Date/Time is stored as minutes since 1/1/86
! (23-bit integer). This is shifted left 1 and the logon/off bit added
! Bytes 1-3 as above
! Byte 4:  Station no.
! Bytes 5-10 User number, padded to right with spaces

integerfn  kday(integer  d,m,y)
      if  m>2 then  m=m-3 else  m=m+9 and  y=y-1
      result =1461*y//4+(153*m+2)//5+d+58
end ; ! of kday

! Bytes 5-10: Username, padded with spaces

integer  lives=2
integer  dd,mm,yy,hh,nn,magic
string (31)t
  on  3 start 
    selectoutput(0)
!    printstring("Trouble"); write(event_sub,1); write(event_extra,1); newline
    lives = lives-1; ->retry if  lives>0
    return 
  finish 

  returnif  userno=0
  to upper(user)
  t = datetime
  dd=stoi(substring(t,1,2)); mm=stoi(substring(t, 4,5)); yy=stoi(substring(t, 7,8))
  hh=stoi(substring(t,11,12)); nn=stoi(substring(t,14,15))
  magic = (((kday(dd,mm,yy)-31411)*24+hh)*60+nn)<<1+flag
! 31411 is the day no for 1/1/86.   
! Date part of magic won't overflow this century.

retry: openappend(1,"LOG:.logfile"); selectoutput(1)
  printsymbol(magic>>16);printsymbol(magic>>8);printsymbol(magic);printsymbol(ldte)
  printstring(user); spaces(6-length(user))
  closeoutput; selectoutput(0)
end 

!*  MAIN PROGRAM

onevent  3 start 
  selectoutput(0)
  event_message = "Fingertrouble" if  event_extra='T'-'0' or  event_extra=4
  print line("Logon: ".event_message)
  stop 
finish 

pam_groupsep = '/';  pam_keyflag = '-';  !restore defaults
if  fildict_alt#0 start 
  autoforget
  pop("System",sysdict)
  pop("File",fildict)
  pop("Symbol",comdict)
  pop("External",extdict)
  pop("Oldfile",ofildict)
  pop("Oldexternal",oextdict)
finish 

line = cliparam
selectinput(0); closeinput
openinput(0,terminal); selectinput(0)

quickflag = 0
quickflag = 1 if  ended in(pam_keyflag,line)
quickflag = 1 if  ended in(pam_groupsep,line)

pds(current user, 0) if  quickflag=0
log off

parse(line)
stop if  line=""; !user-name absent: log off only

get user pass(line, user, pass)
line = user.",".pass

begin 
integer  attempts=0
  on  3 start 
    signal  3,event_sub,event_extra,event_message unless  event_extra=12 -
    and  attempts<=1 and  (rdte=16_15 or  rdte=16_1B)
    attempts = attempts+1
    connect to filestore(rdte!!(16_15!!16_1B))
  finish 
  dummy = fcomm('L'<<8,line) unless  line=""
end 

push("System",sysdict)
push("External",extdict)
push("File",fildict)
push("Symbol",comdict)
push("Oldfile",ofildict)
push("Oldexternal",oextdict)

if  quickflag=0 start 
  pds(user, 1)
  confirm filestore(rdte)
  copy if  exists("fmac:alert")
  openinput(0,terminal) unless  exists("login.com")
finish 

endofprogram