%constinteger debug=1 ;! non-0 for no debug
%if debug#0 %start
%const %string (255) incoming bb name= "uktex-in"
%finishelsestart
%const %string(255) incoming bb name="uktex-test"
%finish
%const %string (1) snl= "
"
%external %routine GetMailUktex(%string (255) incoming mail bundle)
   %external %routine %spec EMAS3(%string %name command,par, %integer %name f)
   %external %string %fn %spec derrs %alias "s#derrs"(%integer flag)
   %external %routine %spec destroy %alias "S#DESTROY"(%string (255) file,
      %integer %name flag)
   %constant %integer max mflag= 529;    ! Max MAILER error number
   %integer flag
!
! Getmail V0.09 17/09/87
! Author: Graham Toal
! Copyright: public domain
!
! This program reads any incoming mail addressed to uktex-in.
! The incoming mail is assumed to be a bundle of mail messages
! separated by lines of '---------'es.  It splits the file up
! into individual mail messages which it then reposts to 'uktex'.
!
! The mail is slightly altered so that REPLY sends a reply both
! to the original sender and to the master UKTEX depository at Aston.
!
   %constant %string (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",
 "See advisory",                  { this occurs for various reasons - including }
 "Missing component:",            { no accredited recipient - check mail dir    }
 "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"
   %const %string (255) uktex bboard= "uktex"; ! Should change to "uktex"
   %own %string (255) mailtmp= "M#UKTEX"
   %const %string (255) mailerr= "M#ERROR"
   %string (255) real sender,uktex
   real sender = "ABBOTTP@UK.AC.ASTON.MAIL"
   uktex = "info-tex@uk.ac.aston.mail"
   %integer Bundle start,Bundle length,Unit start,Next unit start,len
   %const %integer Read Shared= 1
   %string (255) s,rest
   %const %integer true=0,false=1

   %integer %fn Starts(%string %name s,%string(255) lit,%stringname rest)
      %string (255) Dummy
      %if s->Dummy.(Lit).rest %and Dummy="" %then %result = true
      %result = False
   %end

   %integer %fn Connect(%string (255) text file, %integer mode,
      %integer %name len)
      %external %routine %spec EMAS3CONNECT(%string %name File,
         %integer %name m,h,p,c,t,s,e,f)
      %integer hole,prot,type,start,end,flag,conad
      hole = 0; prot = 0; conad = 0
      EMAS3CONNECT(text file,mode,hole,prot,conad,type,start,end,flag)
      len = end-start
      %result = conad+start
   %end

   %string (255) %fn lineat(%integer a)
      %integer ch
      %string (255) s
      s = ""
      %cycle
         ch = BYTE INTEGER(a); a = a+1
         %if ch=nl %then %exit
         S = S.TO STRING(ch)
         %if LENGTH(S)=255 %then %exit
      %repeat
      %result = s
   %end

   %routine mailer send
      %external %routine %spec disconnect %alias "S#DISCONNECT"(%string %c
         (255) file, %integer %name flag)
      %external %routine %spec permit %alias "S#PERMIT"(%string (255) file,
         %string (6) user, %integer mode, %integer %name flag)
      %record %format pe(%integer dest,srce,p1,p2,p3,p4,p5,p6)
      %record (pe) p
      %external %integer %function %spec ddelay(%integer %name secs)
      %external %integer %function %spec dmail(%record (pe) %name p,
         %integer %name len,adr)
      %string (255) mailer command
      %external %routine %spec emas3itos(%integer %name s, %string %name i)
      %string (255) s
      %integer conad,maillen
      conad = Connect(":".mailtmp,Read shared,maillen)
      %if maillen<16 %then ->skip mail
      emas3itos(maillen,s)
      mailer command = "MAILSERVER POST ".mailtmp.",32,".s.",".mailerr
      disconnect(":".mailtmp,flag)
      %if flag#0 %then s = "Disconnect?" %and ->Err
      flag = 0
      EMAS3("permit",":".mailtmp.",MAILER",flag)
!     permit(":".mailtmp,"MAILER",3,flag)
      s = "permit failure" %and ->err %if flag#0
      p = 0
      disconnect(":".mailtmp,flag)
      flag = ddelay(2)
      flag = dmail(p,length(mailer command),ADDR(mailer command)+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)
            flag = 233;                  ! General error flag
         %finish
         ->err
      %finish
skip mail:
      disconnect(":".mailtmp,flag)
      destroy(":".mailtmp,flag)
      s = "Destroy failure" %and ->err %if flag#0
      %return
err:
      print string("ERROR: ".s)
      newline
   %end

   %routine Locate mail unit(%integer %name len)
      %integer a
      len = -1
      a = Next unit start
      %cycle
         s = lineat(a)
         %if Starts(s,"--------------",rest)=True %start
            a = a+LENGTH(s)+1
            Next unit start = a
            %cycle
               s = lineat(a)
               %if Starts(s,"--------------",rest)=True %then %exit
               a = a+LENGTH(s)+1
               %if a>=Bundle start+bundle length %then %exit
            %repeat
            len = a-Next unit start
            Unit start = Next unit start
            Next unit start = a
            %return
         %finish %else %start
            a = a+LENGTH(s)+1
         %finish
         %if a>=bundle start+bundle length %then %exit
      %repeat
   %end


   %routine Post mail unit(%integer start,len)
      %integer finish; finish = start+len-1
                                         ! Scan first few lines for X400 mail header. If valid, Use it,
                                         ! otherwise generate one and use whole body as text.
      %string (255) %array Line(0:255)
      %integer %array saved start(0:255)
      %integer from,to,subject,reply to,date
      %integer first line,last line,i
      from = -1; to = -1; subject = -1; reply to = -1; date = -1
      last line = -1
      %cycle
         %if start>=finish %then %exit
         last line = last line+1
         saved start(last line) = start
         line(last line) = lineat(start); start = start+LENGTH(line %c
            (last line))+1
      %repeat
                                         ! Now have line(0:last line) valid
      first line = 0
      first line = first line+1 %while %c
         line(first line)="" %and first line<last line
      %if first line=last line %then %return; ! One-line mail message?
      %for i = first line,1,last line %cycle
         %if from<0 %and Starts(line(i),"From:",rest)=True %then from = i
         %if to<0 %and Starts(line(i),"To:",rest)=True %then to = i
         %if Subject<0 %and Starts(line(i),"Subject:",rest)=True %then %c
            Subject = i
         %if Starts(line(i),"Reply-to:",rest)=True %then %c
            CHARNO(line(i),7) = 'T'
         %if reply to<0 %and Starts(line(i),"Reply-To:",rest)=True %then %c
            reply to = i
         %if date<0 %and Starts(line(i),"Date:",rest)=True %then date = i
      %repeat
      EMAS3("DEFINE","1,:".mailtmp,flag)
      %if debug=true %then select output(0) %else select output(1)
      %if from>=0 %and to>=0 %start
         %for i = first line,1,last line %cycle
            %if line(i)="" %then %exit
         %repeat
         start = saved start(i)
         %if reply to>=0 %start
            Line(reply to) = Line(reply to).", ".uktex
         %else
            Line(from) -> ("From:").rest
            reply to = i+1
            Line(reply to) <- "Reply-To:".rest.", ".uktex
         %finish
         Line(to) = "To: ".uktex bboard
         print string(line(from).snl)
         print string(line(tO).snl)
         print string(line(subject).snl) %if subject>=0
         print string(line(date).snl) %if date>=0
         print string(line(reply to).snl) %if reply to>=0
      %else
         start = saved start(0)
         print string("From: ".real sender.snl)
         print string("To: ".uktex bboard.snl)
         print string("Reply-To: ".uktex.snl)
      %finish
      newline
      %for i = start,1,finish %cycle
         printsymbol(BYTEINTEGER(i))
      %repeat
      select output(0)
      %if debug#true %then Close stream(1)
      mailer send %if debug#true
   %end

   %integer units posted,i

   Bundle start = Connect(incoming mail bundle,Read Shared,Bundle length)
   Next Unit start = Bundle start


   Units posted = 0
   %cycle
      Locate mail unit(len)
      %if len<0 %and Units posted=0 %then %start
         post mail unit(bundle start,bundle length)
         %exit
      %finish
      %exit %if len<0
      Post mail unit(Unit start,len)
      Units posted = Units posted+1
      Unit start = Next unit start
      %exit %if Unit start+len>=Bundle start+bundle length
   %repeat
   destroy(":".mailtmp,flag)
   destroy(mailerr,flag)
   destroy(incoming mail bundle,flag)
%end
%external %routine kick uktex
%string (255) Kicked BB
  Kicked BB = "uktex-in"

   %integer flag,mcount,count
   %integer %array dsfia(0:1)
   %string (1) dummys

   %constant %integer pf max=800;        !for dfilenames

   %record %format frecf(%string (11) name, %integer sp12,kbytes,
      %byte %integer arch,codes,cct,ownp,eep,codes2,ssbyte,flags,sp29,sp30,
      sp31)
   %record %format paf(%integer dest,srce,flag,message count,secs,ident,
      bad bitcomp,p6)

   { some of these specs also appear elsewhere in this file     }
   { but I am leaving them here as this command is quite useful }
   { enought that I want to be able to move it about at will    }
   %external %integer %function %spec dfilenames(%string %name group,
      %integer %name fileno,maxrec,nfiles,fsys,type,
      %record (frecf) %array %name inf)
   %external %integer %function %spec dmail(%record (paf) %name p,
      %integer %name len,adr)
   %external %integer %function %spec dsfi(%string %name index,
      %integer %name fsys,type,set, %string %name s, %integer %array %name is)
   %external %string %function %spec date %alias "S#DATE"
   %external %integer %function %spec existtype %alias "S#EXISTTYPE"(%string %c
      (255) file)
   %external %string %function %spec next temp %alias "S#NEXTTEMP"
   %external %routine %spec rename %alias "S#RENAME"(%string (255) file,
      newfile, %integer %name flag)
   %external %string %function %spec time %alias "S#TIME"
   %external %integer %function %spec uinfi %alias "S#UINFI"(%integer i)
   %external %string %function %spec uinfs %alias "S#UINFS"(%integer i)

   %integer %function start of(%string (255) whole string,first part,
      %string (*) %name rest)
      %result = 0 %unless %c
         0<length(first part)<=length(whole string) %and %c
         first part=substring(whole string,1,length(first part))
      whole string -> (first part).rest
      %result = 1
   %end;                                 ! of start of

   %routine get mail messages
      %integer count,flag
      %string (255) line
      %record (paf) pa

      count = 0
      pa = 0
      line = "MAILSERVER ACCEPT M#,".incoming bb name
      flag = dmail(pa,length(line),addr(line)+1)
      count = pa_message count
      %if flag#0 %then %return
      %if pa_flag#0 %then flag = pa_flag %and %return
   %end;                                 ! of get mail messages

   %routine read m hash files
      %record (frecf) %array pf(0:pfmax-1)
      %integer filenum,maxrec,nfiles,flag,i
      %string (8) num
      filenum = 0
      maxrec = pfmax
      flag = dfilenames(uinfs(1),filenum,maxrec,nfiles,uinfi(1),0,pf)
      %if flag#0 %then %return
      %for i = 0,1,(maxrec-1) %cycle
         %if start of(pf(i)_name,"M#",num)=1 %and length(pf(i)_name)=10 %start
                                         ! Really need test that rest of name is numeric...
            %if existtype(":".pf(i)_name)=3 %then %start
               mcount = mcount+1
               GetMailUktex(":".pf(i)_name)
            %finish
         %finish
      %repeat
   %end;                                 !of {read m hash files}

   dummys = ""
   mcount = 0
   flag = dsfi(uinfs(1),uinfi(1),43,0,dummys,dsfia)
   %if dsfia(0)#0 %then %start
      get mail messages
      read m hash files
   %finish
%end;                                    ! of Read mail
%end %of %file