Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-11 - 43,50527/male.old
There are no other files named male.old 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 
			Outfile(Gettab(#53,#11))
		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;
	Datchn(.(.buffer+Mlftim),.(.buffer+Mlfdat),.(.buffer+Mlfyer));
	Crlfchn();
	If NOT(Bittst(.(.buffer+Mlfflg),Mfgsnd)) then
	Begin
		Cprint('To: ');
		If Bittst(.(.buffer+Mlfflg),Mfggrp) then		! Group
		Begin
			Cprint('Group ');
			Sixochn(.(.buffer+Mlfgrp),-1);
		End Else
		Begin
			If Bittst(.(.buffer+Mlfflg),Mfgsys) then	! System
			Begin
				Cprint('System');
			End Else
			Begin
				Sixochn(.Acct[accnm1],-1);
				Sixochn(.Acct[accnm2],-1);
			End;
		End;
		Crlfchn();
	End;
	Cprint('From: ');
	Sixochn(.(.Buffer+Mlfnm1),-1);
	Sixochn(.(.Buffer+Mlfnm2),-1);
	Cprint('   Node: ');
	Sixochn(.(.Buffer+Mlfloc),-1);
	Cprint('   Tty: ');
	Octchn(.(.Buffer+Mlftty));
	Cprint('?M?J?M?JSubject: ');
	Tmpptr _ Byteptr(.Buffer+Mlfsub);
	Scani(Tmpptr);
	While (scann(Tmpptr) NEQ 0) do
	Begin
		Byteout(scann(Tmpptr));
		Scani(Tmpptr);
	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;
			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