Trailing-Edge
-
PDP-10 Archives
-
decuslib10-11
-
43,50527/male.bli
There are no other files named male.bli in the archive.
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<lefthalf> GEQ #11) then tstppn _ .tstppn<righthalf>;
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<lefthalf> GEQ #11) then ppn _ .ppn<righthalf>;
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<lefthalf> EQL 0) then
If (.Acct2[accppn]<lefthalf> GEQ #11) then
Tstppn _ .Acct2[accppn]<righthalf>;
if (.tstppn EQL .ppn) then
Begin
Lookuparg[0] _ .acct2[accmlf];
Lookuparg[1]<lefthalf> _ .acct2[accmfe]<lefthalf>;
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]<righthalf> 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]<righthalf>);
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]<righthalf>);
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]<righthalf>);
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]<Lefthalf> NEQ sixbit"TTY") then
Begin
If (.filbuf[ffdev]<lefthalf> 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<righthalf> 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