!***********************************************************************
!*
!*                    ALERT and SUGGESTION commands
!*
!*      New version by R.D. Eager   University of Kent   MCMLXXXIII
!*
!***********************************************************************
!
!
!***********************************************************************
!*
!*          Site-dependent items
!*
!***********************************************************************
!
constantstring (20) suggestion rname = "EMAS Suggestions@UKC"
!
!
!***********************************************************************
!*
!*          Constants
!*
!***********************************************************************
!
constantinteger  no = 0, yes = 1
constantinteger  hdsize = 32;           ! Size of a file header
constantinteger  sscharfiletype = 3;    ! Subsystem file type
constantinteger  maxsuggestionlength = 4000
constantinteger  max mflag = 529;       ! Max MAILER error number
constantbyteinteger  em character = 25; ! End of medium character
constantstring (1) snl = "
"
constantstring (8) profile key = "SS#ALERT"
constantstring (18) alertfile = "SUBSYS.ALERTINF"
                                        ! Alert file
constantstring (11) sugg tempfile = "M#MSG"
                                        ! Temporary file for mailing suggestions
constantstring (11) reportfile = "M#DREPORT"
                                        ! Mail report file
constantstring (28)array  mailer mess(501:max mflag) = c 
"Invalid parameters",
"Duplicate component:",
"Unknown component",
"Invalid command",
"No valid recipients",
"Too many recipients",
"Addr table full",
"Name table full",
"Illegal name",
"Mail service closed",
"Recipient offline",
"Message too long",
"",
"Missing component:",
"No free message descriptors",
"Invalid component:",
"Total message kb exceeded",
"Cannot return report file",
"Message stored",
"Forbidden component",
"Create file fails",
"User not accredited",
"Invalid password",
"Name not accredited",
"Name already accredited",
"Name belongs to another user",
"Uncollected mail for R-name",
"Invalid date/time after",
"Not allowed in student procs"
!
!
!***********************************************************************
!*
!*          Record formats
!*
!***********************************************************************
!
recordformat  hf(integer  dataend,datastart,filesize,filetype,
                 sum,datetime,format,records)
recordformat  pe(integer  dest,srce,p1,p2,p3,p4,p5,p6)
recordformat  rf(integer  conad,filetype,datastart,dataend)
!
!
!***********************************************************************
!*
!*          Subsystem references
!*
!***********************************************************************
!
systemroutinespec  connect(string (31) file,integer  mode,hole,
                           prot,record (rf)name  r,integername  flag)
systemroutinespec  console(integer  ep,integername  start,len)
systemroutinespec  disconnect(string (31) file,integername  flag)
systemroutinespec  destroy(string (31) file,integername  flag)
systemintegerfunctionspec  iocp(integer  ep,parm)
systemstringfunctionspec  itos(integer  n)
systemroutinespec  move(integer  length,from,to)
systemroutinespec  outfile(string (31) file,integer  size,hole,
                           prot,integername  conad,flag)
systemintegerfunctionspec  parmap
systemroutinespec  permit(string (31) file,string (6) user,
                          integer  mode,integername  flag)
externalroutinespec  prompt(string (255) s)
systemroutinespec  psysmes(integer  root,mess)
externalroutinespec  readprofile(string (11) key,name  info,
                                 integername  version,flag)
systemroutinespec  setfname(string (63) s)
systemroutinespec  setpar(string (255) s)
externalroutinespec  set return code(integer  i)
systemstringfunctionspec  spar(integer  n)
externalintegerfunctionspec  uinfi(integer  entry)
externalroutinespec  writeprofile(string (11) key,name  info,
                                  integername  version,flag)
dynamicroutinespec  zview alias  "S#ZVIEW" (string (255) s)
!
!
!***********************************************************************
!*
!*          Director references
!*
!***********************************************************************
!
externalstringfunctionspec  derrs(integer  n)
externalintegerfunctionspec  dmail(record (pe)name  p,integer  len,adr)
!
!
!***********************************************************************
!*
!*          A L E R T
!*
!***********************************************************************
!
externalroutine  alert(string (255) parms)
integer  flag,adate,pversion,ad,len
record (rf) rr
record (hf)name  r
string (23) out
string (63) mes
!
setpar(parms)
if  parmap > 1 then  start 
   flag = 263;                          ! Wrong number of parameters
   -> err
finish 
!
out <- spar(1)
if  out # "" and  out # "?" and  out # "??" then  out = ",F<".out."/W>,Q"
!
connect(alertfile,1,0,0,rr,flag)
-> err if  flag # 0
r == record(rr_conad)
!
if  out = "?" or  out = "??" then  start 
                                        ! Query for new ALERT information
   readprofile(profile key,adate,pversion,flag)
   if  (r_datetime & x'7fffffff') > (adate & x'7fffffff') then  start 
      mes = "There is new alert information.".snl
      if  out = "?" or  uinfi(2) = 2 then  start 
         printstring(mes)
      else 
         ad = addr(mes) + 1
         len = length(mes)
         console(10,ad,len);            ! Guarantee output to terminal
      finish 
   finish 
else ;                                  ! Request to VIEW alert file
   zview(alertfile.out)
   pversion = 1
   adate = r_datetime
   writeprofile(profile key,adate,pversion,flag)
   flag = 0 if  flag = 1;               ! OK if just created SS#PROFILE
   if  flag # 0 then  start 
      printstring("Failed to write to file SS#PROFILE, flag = ".itos(flag).snl)
   finish 
finish 
flag = 0
!
err:
!
set return code(flag)
if  flag # 0 then  psysmes(70,flag)
end ;   ! of alert
!
!
!***********************************************************************
!*
!*          S U G G E S T I O N
!*
!***********************************************************************
!
externalroutine  suggestion(string (255) parms)
integer  flag,ad,len,hlen,conad,i,ch,nlsw
string (31) file
string (63) header,s
record (pe) p
record (rf) rr
record (hf)name  r
!
setpar(parms)
if  parmap > 1 then  start 
   flag = 263;                          ! Wrong number of parameters
   -> err
finish 
!
header = "To: ".suggestion rname.snl.c 
         "Subject: Suggestion".snl.snl
hlen = length(header)
outfile(sugg tempfile,maxsuggestionlength+hlen+hdsize,0,0,conad,flag)
-> err if  flag # 0
r == record(conad)
r_filetype = sscharfiletype
move(hlen,addr(header)+1,conad+r_dataend)
r_dataend = r_dataend + hlen
!
file = spar(1)
if  file # "" then  start 
   connect(file,0,0,0,rr,flag);         ! Contains text of suggestion
   -> err if  flag # 0
   if  rr_filetype # sscharfiletype then  start 
      setfname(file)
      flag = 267;                       ! Invalid filetype
      -> err
   finish 
   ad = rr_conad + rr_datastart
   len = rr_dataend - rr_datastart
   if  len > maxsuggestionlength then  start 
      setfname("Message too long")
      flag = 233;                       ! General error
      -> err
   finish 
   move(len,rr_conad+rr_datastart,conad+r_dataend)
   r_dataend = r_dataend + len
else ;                                  ! Text input from terminal
   printstring("Please type your suggestion.".snl)
   printstring("End it with a line containing only an asterisk (*),".snl)
   printstring("or by Control-D or Control-Y".snl)
   prompt("Text: ")
   nlsw = 0
   for  i = 0,1,maxsuggestionlength - 1 cycle 
      readch(ch)
      if  ch = '*' and  nlsw = 1 and  nextsymbol = nl then  start 
         skipsymbol
         exit 
      finish 
      if  ch = em character then  start 
         flag = iocp(12,0);             ! Reset end of file from terminal
         exit 
      finish 
      if  ch = nl then  nlsw = 1 else  nlsw = 0
      byteinteger(conad+r_dataend) = ch
      r_dataend = r_dataend + 1
   repeat 
finish 
!
s = "MAILSERVER POST ".sugg tempfile.",".itos(r_datastart).",".c 
    itos(r_dataend-r_datastart).",".reportfile
disconnect(sugg tempfile,flag)
permit(sugg tempfile,"MAILER",3,flag)
-> err if  flag # 0
!
p = 0
flag = dmail(p,length(s),addr(s)+1)
flag = p_p1 if  flag = 0
if  flag # 0 then  start 
   if  flag < 500 then  s = derrs(flag) else  start 
      flag = 513 if  flag > max mflag
      s = mailer mess(flag)
      setfname(s)
      flag = 233;                       ! General error flag
    finish 
finish  else  printstring("Suggestion recorded".snl)
!
err:
!
set return code(flag)
if  flag # 0 then  psysmes(69,flag)
destroy(reportfile,flag)
destroy(sugg tempfile,flag)
end ;   ! of suggestion
endoffile