Module male(entries=(inquire,finuname,checkmail,listmail,typemail, Display,Getdate,help,savemail),reserve(1,2,3,4))= Begin Require machop.bli; Require macros.bli; Require extern.bli; Forward Inquire; External Opnchn,Lkpchn,Entchn,Bytein,Byteout,Clschn,Sixochn,Otschn; External Datchn,Crlfchn,Decchn,Octchn,whois; Global routine Inform(Block)= Begin Own Job,Batbit,Status,PPN,loop,trmblk[3],Buff[50],flag,sptr,aptr,pptr,byte,tmp[3],tstppn; Status _ 0; Job _ 1; Loop _ true; Flag _ FALSE; if (mlrext EQL sixbit'TST') then Return(.flag); tstppn _ ..block; If (.tstppn EQL Xwd(1,2)) then return(.flag); If (.tstppn GEQ #11) then tstppn _ .tstppn; tmp[0] _ .((.block)+1); tmp[1] _ .((.block)+2); tmp[2] _ 0; sptr _ tmp[0]<36,6>; aptr _ buff[0]<36,7>; pptr _ Byteptr(PLIT ASCIZ '?M?J?G[MAILER: '); byte _ scani(pptr); Until (.byte EQL 0) do Begin replacei(aptr,.byte); byte _ scani(pptr); End; byte _ scani(sptr); Until (.byte EQL 0) do Begin byte _ .byte + #40; replacei(aptr,.byte); byte _ scani(sptr); End; Pptr _ Byteptr(plit asciz ' has new mail from '); If (.tstppn EQL #777777) then pptr _ Byteptr(plit asciz 'New system mail exists from '); tmp[0] _ .((.block)+3); tmp[1] _ .((.block)+4); sptr _ tmp[0]<36,6>; byte _ scani(pptr); Until (.byte EQL 0) do Begin replacei(aptr,.byte); byte _ scani(pptr); End; byte _ scani(sptr); Until (.byte EQL 0) do Begin byte _ .byte + #40; replacei(aptr,.byte); byte _ scani(sptr); End; replacei(aptr,"]"); replacei(aptr,"?M"); replacei(aptr,"?J"); replacei(aptr,"?G"); replacei(aptr,0); While (.loop EQL true) do Begin Pjob(ac1); If (.Job EQL .ac1) then Job _ .Job + 1; Ac1 _ -.Job; Ifskip Jobsts(ac1) then Begin Status _ .ac1; PPN _ Gettab(.Job,#2); If (.PPN GEQ #11) then ppn _ .ppn; Batbit _ Gettab(.job,#40); If (.Batbit<25,1> EQL 0) then Begin If (.ppn EQL .tstppn)OR(.tstppn EQL #777777) then Begin ac1 _ .job; Ifskip Trmno(ac1) then Begin Trmblk[0] _ #25; Trmblk[1] _ .ac1; Trmblk[2] _ Address(Buff); ac1 _ Xwd(3,Address(Trmblk)); Ifskip Trmop(ac1) then flag _ true; End; End; End; End Else Loop _ FALSE; Job _ .Job + 1; End; Return(.flag); End; Global routine Display(PPN)= Begin Own acct2[accmax],a,lookuparg[4],opb[4],wrd,lub1,tstppn,b,word; Filblock(lub1,'.ACCT.',mlrext,#777^27,mlrppn); ifskip open(aux,plit(12,mlrdev,address(tmpbuf),0)) then ifskip lookup(aux,address(lub1)) then Begin wrd _ 0; While .wrd NEQ "EOF" do Begin a _ 0; acct2[accppn] _ 0; wrd _ 0; until (.wrd EQL -1) or (.a EQL accmax) or (.wrd EQL "EOF") do Begin wrd _ infile("AUX"); acct2[.a] _ .wrd; a _ .a + 1; End; Tstppn _ .Acct2[accppn]; If (.ppn EQL 0) then If (.Acct2[accppn] GEQ #11) then Tstppn _ .Acct2[accppn]; if (.tstppn EQL .ppn) then Begin Lookuparg[0] _ .acct2[accmlf]; Lookuparg[1] _ .acct2[accmfe]; Lookuparg[2] _ 0; Lookuparg[3] _ .acct2[accppn]; Opb[0] _ 12; Opb[1] _ .acct2[accmfd]; Opb[2] _ address(Ibufhdr); Opb[3] _ 0; Ifskip open(in,address(opb)) then Ifskip lookup(in,address(lookuparg)) then Begin If NOT Batch() then Begin word _ 0; b _ 0; until (.word EQL -1)OR(.word EQL "EOF") do Begin word _ INFILE("IN"); auxbuf[.b] _ .word; if (.word EQL -1)AND(.b LEQ mlfsub) then word _ 0; b _ .b + 1; If (.word EQL -1) then If (bittst(.auxbuf[mlfflg],mfgred)) Then (word _ 0; b _ 0) else Begin Print('?M?J?G[MAILER: New mail exists for '); Sixout(.acct2[accnm1],-1); Sixout(.acct2[accnm2],-1); Print(']?G?M?J'); End; If (.b GEQ maxbuf) then Begin Print('?M?J?G??MAIMFC Mail file is corrupt?M?J'); word _ -1; End; End; End; Close(in); Releas(in); End Else Begin Releas(In); End Else 0; End; End; Close(aux); Releas(aux); End Else Releas(aux); Return 0; End; Global routine getdate(uname1,uname2,change)= Begin Own argblk[4],current[3],a,outblk[4],b,c,opb[4]; % Bug Fix - 2(15) DLE If date file is unavailable when LOGIN is true, we do not modify for this PPN and we return a day in the future. Unless the file is being modified, then we wait one second and recall the routine. NOTE: An infinite loop can occur here if someone opens the date file and fails to close it. This MUST be the only routine that manipulates the DATE file. % Filblock(argblk,'.DATE.',mlrext,#777^27,mlrppn); Filblock(outblk,'.DATE.',mlrext,#777^27,mlrppn); Reset; opb[0] _ 12; opb[1] _ mlrdev; opb[2] _ Xwd(address(obufhdr),0); opb[3] _ 0; a _ FALSE; Ifskip Open(in,plit(12,mlrdev,address(ibufhdr),0)) then Ifskip Lookup(In,address(argblk)) then Begin If NOT lockchn(in,3) then Begin Releas(IN); Return; End; Ifskip Open(out,address(opb)) then Ifskip Enter(Out,address(outblk)) then 0 else Begin If (.outblk[1] EQL 3) then Begin Releas(in); Releas(out); Ac1 _ 1; Sleep(ac1); Return(Getdate(.uname1,.uname2,.change)); End; If (.login) then RETURN(#377777777777); % Return someday in the future % Print('?M?J?G??MAIESD Error with system date file?M?J'); Error(.outblk[1]); Releas(out); Releas(in); Return 0; End else Begin Releas(in); Print('?M?J?G??MAIDNA Error with mailer disk for system date file?M?J'); Return 0; End; End Else Begin Releas(in); a _ true; ifskip Open(out,address(opb)) then ifskip Enter(out,address(outblk)) then Print('?M?J[Creating system date file]?M?J') else Begin Releas(out); Print('?M?J?G??MAICCD Error creating system date file?M?J'); Error(.outblk[1]); Return 0; end else Begin Print('?M?J?G??MAIDNA Unable to open mailer disk for system date file?M?J'); Return 0; end; End Else Begin Print('?M?J?G??MAIDNA Unable to open mailer disk for system date file?M?J'); Return 0; End; current[0] _ (if .a EQL true then "EOF" else 0); a _ true; b _ 0; While (.current[0] NEQ "EOF") do Begin Incr c from 0 to 2 do current[.c]_infile("IN"); If (.current[0] NEQ "EOF") then Outfile(.current[0]); If (.current[1] NEQ "EOF") then Outfile(.current[1]); If Usern(.current[0],.current[1],.uname1,.uname2) then Begin If (.change EQL TRUE) then Begin Current[2] _ Gettab(#53,#11); Outfile(.Current[2]); End else Outfile(.Current[2]); B _ .Current[2]; a _ FALSE; End Else If .current[2] NEQ "EOF" then Outfile(.current[2]); End; If .a then Begin Outfile(.uname1); Outfile(.uname2); Outfile(Gettab(#53,#11)); End; If NOT .a then Close(in); Close(out); If NOT .a then Releas(in); Releas(out); return .b; End; Global ROUTINE HELP= BEGIN OWN LUB[4]; Filblock(Lub,'MAILER',sixbit 'HLP',0,0); IFSKIP OPEN(IN,PLIT(0,SIXBIT 'HLP',ADDRESS(IBUFHDR),0)) THEN IFSKIP LOOKUP(IN,ADDRESS(LUB)) THEN UNTIL (IFSKIP INPUT(IN) THEN 1 ELSE 0) DO WHILE (IBUFHDR[2]_.IBUFHDR[2]-1) GEQ 0 DO OUTC(SCANI(IBUFHDR[1])) ELSE BEGIN ERROR(.Lub[1]); RELEAS(IN); END ELSE BEGIN PRINT('?M?J??MAIHNA Device HLP: is unavailable?M?J'); RETURN 0; END; CLOSE(IN); RELEAS(IN); END; Global ROUTINE SAVEMAIL(Pntr,Buffer)= BEGIN Own Flags,Tmpptr,b,word; Filbuf[ffdev] _ sixbit'DSK'; Filbuf[ffnam] _ sixbit'MAILER'; Filbuf[ffext] _ sixbit'TXT'; Filbuf[ffpth] _ 0; ! Default path Flags _ Getfile(.pntr); ! Get the filespec If (.flags EQL -1) then Begin Print('?M?J?G??MAIIFS Illegal filespec - Save cancelled?M?J'); Return(); End; If (.Filbuf[ffdev] NEQ sixbit"TTY") then Begin If (.filbuf[ffdev] NEQ sixbit"LPT") then Print('[Saving message in ') else Print('[Listing message to '); Sixout(.Filbuf[ffdev],-1); Outc(":"); Sixout(.Filbuf[ffnam],-1); Outc("."); Sixout(.Filbuf[ffext],-1); If (.Filbuf[ffpth] EQL 0) then Print('[-]') else Outpth(); Print(']?M?J'); End; If (OPNCHN() EQL -1) then return; If (ENTCHN() EQL -1) then return; If NOT(.summary) then Datchn(.(.buffer+Mlftim),.(.buffer+Mlfdat),.(.buffer+Mlfyer)); If NOT (.summary) then Crlfchn(); If NOT(Bittst(.(.buffer+Mlfflg),Mfgsnd)) then Begin Cprint('To: '); If Bittst(.(.buffer+Mlfflg),Mfggrp) then ! Group Begin Cprint('Group '); If (not .summary) then Sixochn(.(.buffer+Mlfgrp),-1) else Sixochn(.(.buffer+Mlfgrp),6); End Else Begin If Bittst(.(.buffer+Mlfflg),Mfgsys) then ! System Begin Cprint('System '); End Else Begin Sixochn(.Acct[accnm1],6); Sixochn(.Acct[accnm2],6); End; End; If NOT(.summary) then Crlfchn(); If (.summary) then Cprint(' '); End; Cprint('From: '); If NOT(.summary) then Begin Sixochn(.(.Buffer+Mlfnm1),-1); Sixochn(.(.Buffer+Mlfnm2),-1); End Else Begin Sixochn(.(.buffer+Mlfnm1),6); Sixochn(.(.buffer+Mlfnm2),6); End; If NOT(.summary) then Begin Cprint(' Node: '); Sixochn(.(.Buffer+Mlfloc),-1); Cprint(' Tty: '); Octchn(.(.Buffer+Mlftty)); End Else Begin Cprint(' '); Datchn(.(.buffer+Mlftim),.(.buffer+Mlfdat),.(.buffer+Mlfyer)); If NOT(Bittst(.(.buffer+Mlfflg),Mfgred)) then Cprint(' *NEW*'); Crlfchn(); End; If NOT(.summary) then Cprint('?M?J?M?J'); Cprint('Subject: '); Tmpptr _ Byteptr(.Buffer+Mlfsub); Scani(Tmpptr); While (scann(Tmpptr) NEQ 0) do Begin Byteout(scann(Tmpptr)); Scani(Tmpptr); End; If (.summary) then Begin Crlfchn(); Clschn(); Return; End; Until (scani(Tmpptr) NEQ 0) do 0; Cprint('?M?J?M?JMessage:?M?J?J'); b _ mlfsub; word _ -1; until (.word EQL 0) do Begin word _ .(.buffer+.b); b _ .b + 1; End; until .(.buffer+.b) NEQ 0 do b _ .b + 1; b _ .b + 2; ! Skip counts Otschn(.buffer+.b); Cprint('?M?J?M?J'); Clschn(); END; Global routine Typemail(buffer)= Begin Own Buff[3]; Buff[0] _ 'TTY:?J'; ! Send to TTY: Buff[1] _ 0; Buff[2] _ Byteptr(Address(buff)); Scani(Buff[2]); Savemail(.Buff[2],.buffer); If (.login) then Print('?M?J?G-----------------?M?J'); End; Global routine Listmail(buffer)= Begin Own Buff[3]; Buff[0] _ 'LPT:?J'; ! Send to LPT: Buff[1] _ 0; Buff[2] _ Byteptr(address(Buff)); Scani(buff[2]); Savemail(.Buff[2],.buffer); End; Global routine checkmail= Begin Own Lookuparg[#15], a,b,word, opb[4]; Incr a from 0 to 1 do Begin Lookuparg[0]_#15; Lookuparg[1]_(If .a EQL 1 then .ACCT[accppn] else mlrppn); Lookuparg[2]_(if .a EQL 1 then .ACCT[accmlf] else sixbit '.ALL.'); Lookuparg[3]_(if .a EQL 1 then .acct[accmfe] else Mlrext); Incr b from 4 to #14 do Lookuparg[.b] _ 0; Opb[0]_12; Opb[1]_(If .a EQL 1 then .acct[accmfd] else mlrdev); Opb[2]_address(Ibufhdr); Opb[3]_0; Reset; Ifskip Open(in,address(opb)) then Ifskip Lookup(in,address(lookuparg)) then Begin if .a EQL 0 then if .lookuparg[#14] GEQ .sysdate then Print('?M?J[New system mail exists]?M?J') else 0 Else Begin word _ 0; b _ 0; until (.word EQL -1)OR(.word EQL "EOF") do Begin word _ INFILE("IN"); auxbuf[.b] _ .word; if (.word EQL -1)AND(.b LEQ mlfsub) then word _ 0; b _ .b + 1; If (.word EQL -1) then If (bittst(.auxbuf[mlfflg],mfgred)) Then (word _ 0; b _ 0) else Print('?M?J?G[You have new mail]?G?M?J'); If (.b GEQ maxbuf) then Begin Print('?M?J?G??MAIMFC Mail file is corrupt?M?J'); word _ -1; End; End; End; Close(In); Releas(In); If .acct[accnm1] EQL sixbit 'ALL' then a _ 1; End else Releas(In) else if .a EQL 0 then Print('?M?J?G%Problem with mailer disk?M?J') else Print('?M?J?G%Problem with your disk?M?J'); End; Return 0; End; Global ROUTINE FINUNAME(UNAME1,UNAME2)= BEGIN OWN ARGBLK[4],wrd,A; RESET; INCR a FROM 0 TO accmx1 DO acct[.a]_0; FILBLOCK(ARGBLK,'.ACCT.',mlrext,#777^27,mlrppn); WHILE .UNAME1 EQL 0 DO (PRINT('?M?JUname: '); uname1_sixin(0,12); if .ac1 EQL 0 then uname2_.ac2 ELSE uname2 _ 0); IFSKIP OPEN(IN,PLIT(12,mlrdev,ADDRESS(IBUFHDR),0)) THEN IFSKIP LOOKUP(IN,ADDRESS(ARGBLK)) THEN UNTIL Auser(.uname1,.uname2) OR .acct[0] EQL "EOF" DO BEGIN A _ 0; WRD _ 0; UNTIL .wrd EQL -1 OR .A EQL accmax DO BEGIN wrd _ INFILE("IN"); acct[.a] _ .wrd; a _ .a + 1; END; If (.acct[accnm1] EQL .uname1)AND(.acct[accnm2] NEQ .uname2) then Begin Ifskip Getppn(ac1) then 0; If (.acct[accppn] EQL .ac1) then Begin Print('?M?J?G??MAIUCF Uname conflicts with another uname in this PPN?M?J'); Stop(); End; End; END ELSE acct[0] _ "EOF" ELSE BEGIN PRINT('?M?J??MAIDNA Mailer disk is unavailable?M?J'); STOP; END; CLOSE(IN); RELEAS(IN); IF .ACCT[0] EQL "EOF" THEN INQUIRE(.uname1,.uname2); END; Global routine inquire(uname1,uname2)= begin own acctfil[4], tmp[2], tmpbuf[4], filopblk[6], mailfilblk[4], strptr, a, b, jbstr[4], opb[4]; tmp[0]_tmp[1]_0; print('?M?JPlease answer all questions y(yes), n(no)?M?J'); print('There is no record of "'); sixout(.uname1,-1); sixout(.uname2,-1); print('". Was this a typing error?? '); if yesno() then begin print('?M?JUname: '); uname1 _ sixin(0,12); if .ac1 EQL 0 then uname2 _ .ac2 else uname2 _ 0; finuname(.uname1,.uname2); return 0; end; Print('?M?JDo you wish to apply for a Uname?? '); if not(yesno()) then stop; Print('?M?JYou are currently logged into: '); Ifskip Getppn(ac1) then 0; Outppn(.ac1); Crlf; Print('Is this the PPN that you normally use?? '); if not(yesno()) then Begin Print('?M?JPlease log into your default area and run MAILER?M?J'); Print('Otherwise you will not receive messages at login time.?M?J'); Stop(); End; filopblk[0]_xwd(out,6); filopblk[1]_12; filopblk[2]_mlrdev; filopblk[3]_xwd(obufhdr,0); filopblk[4]_xwd(-1,0); filopblk[5]_address(acctfil); filblock(acctfil,'.acct.',mlrext,#777^27,mlrppn); reset; Psicrt(); ac1 _ xwd(6,address(filopblk)); ifskip filop(address(ac1)) then 0 else begin filopblk[0]_xwd(out,2); ac1 _ xwd(6,address(filopblk)); ifskip filop(address(ac1)) then 0 else begin print('?M?J??MAIAFE Accounting file error: '); error(.ac1); stop(); end; end; If NOT Lockchn(out,1) then Begin Print('?M?JPlease try later?M?J'); Stop(); End; incr a from 0 to accmax-1 do acct[.a]_0; a _ 0; While .a EQL 0 do Begin print('?M?JWho is "'); sixout(.uname1,-1); sixout(.uname2,-1); print('" (full name) ?? '); a _ rdtty(byteptr(acct[accfnm]),30); End; while Begin print('?M?JIs this correct for your full name???M?J'); outs(address(acct[accfnm])); print('?M?J'); a _ 0; not(yesno()) end do Begin While .a EQL 0 do Begin Print('?M?JWhat is your full name?? '); a _ rdtty(byteptr(acct[accfnm]),30); End; end; acct[accnm1]_.uname1; acct[accnm2]_.uname2; acct[accppn]_gettab(-1,2); if .uname1 EQL sixbit'ALL' then acct[accppn] _ mlrppn; acct[accprv] _ 0; acct[accprv]<35-pvcnam,1>_1; acct[accprv]<35-pvcpas,1>_1; acct[accprv]<35-pvcfnm,1>_1; if .acct[accnm1] EQL Sixbit'ALL' then acct[accprv]_#377777777777; print('?M?JIn order to keep your mail confidential, a password is'); print(' required.?M?JWhat will yours be (6 chars): '); noecho(); acct[accpas] _ 0; While .acct[accpas] EQL 0 do Begin acct[accpas]_sixin(0,6); If .acct[accpas] EQL 0 then Print('?M?J?G??MAIPSR Password required - Password: '); End; print('?M?JTo avoid errors, type it in again: '); if .acct[accpas] neq sixin(0,6) then begin print('?M?JNot correct... Try again: '); if sixin(0,6) neq .acct[accpas] Then Begin print('?M?JThe password you typed was: '); sixout(.acct[accpas],-1); crlf; If prvbit(pvcpas) then Print('You may change it with the ALTER command.?M?J'); end; end; echo(); acct[accus1]_gettab(-1,#31); acct[accus2]_gettab(-1,#32); Acct[accmfd] _ sixbit'DSK'; Jbstr[0]_-1; Incr a from 1 to 3 do Jbstr[.a]_0; Until (.Jbstr[0] EQL 0) OR (.acct[accmfd] NEQ sixbit'DSK') do Begin ac1 _ Xwd(3,Address(jbstr[0])); Ifskip Jobstr(address(ac1)) then If .Jbstr[2] Eql 0 AND .Jbstr[0] NEQ 0 then Begin Ac1 _ Xwd(2,Address(ac2)); Ac2 _ .Jbstr[0]; Ifskip Dskchr(ac1) then If .ac3 NEQ 0 then Acct[accmfd] _ .jbstr[0] Else 0 else Print('?M?J?G??MAIDUF Unexpected DSKCHR failure?M?J'); End Else 0 else (Print('?M?J?G??MAIJUF JOBSTR failed?M?J');Jbstr[0] _ 0); End; If .Acct[accmfd] EQL sixbit'DSK' then Print('?M?J?G%No search list for job - Using default?M?J'); if .uname1 EQL sixbit'ALL' then acct[accmfd] _ mlrdev; acct[accmlf]_.uname1^2; acct[accmfe]_mflext; if .uname1 EQL sixbit'ALL' then begin acct[accmlf]_sixbit'.all.'; acct[accmfe]_Mlrext; end; a_0; incr a from 0 to accfnm-1 do outfile(.acct[.a]); a _ accfnm; while .acct[.a] NEQ 0 do Begin outfile(.acct[.a]); a _ .a + 1; End; outfile(-1); echo(); Print('?M?J[You are now part of the mailer]?M?J'); close(out); releas(out); return 0; end; end eludom