Trailing-Edge
-
PDP-10 Archives
-
decuslib10-11
-
43,50527/sendma.bli
There are no other files named sendma.bli in the archive.
Module Sendma(entries=(sendmail),reserve(1,2,3,4))=
Begin
Require machop.bli;
Require macros.bli;
Require extern.bli;
External Inform,typemail,opnchn,lkpchn,bytein,otschn,savemail;
Forward setsend;
Routine GetAEntry(uname1,uname2)=
Begin
!
! This routine searches the accounting file for the
! specified Uname and returns TRUE if Uname is found.
! If TRUE is returned the AUXACT contains the entry.
! This routine uses the AUX channel for input. The
! channel should already be open. This routine can be
! called repeatedly since it does a USETI to the
! beginning of the file each time. If FALSE is returned
! then AUXACT contains garbage.
!
Own Wrd,a;
Useti(aux,1); ! Start at file beginning
wrd _ 0;
While (.wrd NEQ "EOF") do
Begin
wrd _ a _ 0;
Until (.wrd EQL -1) or (.a EQL accmax) do
Begin
Wrd _ Infile("AUX");
auxact[.a] _ .wrd;
a _ .a + 1;
End;
If Usern(.auxact[accnm1],.auxact[accnm2],.uname1,.uname2) then
Return(TRUE);
End;
Return(FALSE);
End;
Routine GetNextSend(Block,Pntr)=
Begin
!
! This routine returns Non-zero if there is another user
! in SENDTO and returns zero when there are no more. Pntr should start
! as zero and then be the value returned. Block will contain a SENDTO
! block if a non-zero return is given.
!
If (.SENDTO[.pntr] EQL 0) then Return(0);
(.block)+stonm1 _ .sendto[.pntr+stonm1];
(.block)+stonm2 _ .sendto[.pntr+stonm2];
(.block)+stogrp _ .sendto[.pntr+stogrp];
Return(.pntr+stosiz);
End;
Routine Getgroup(grpname)=
Begin
Own Found,a,wrd,acct2[accmax],lub[4],grpsav;
Routine Dogroup=
Begin
If (.acct2[accnm1] EQL sixbit'ALL') then
Begin
Print('?M?J?G%Accounting file error: ALL is a member of a group. Ignored.?M?J');
Return;
End;
Setsend(.acct2[accnm1],.acct2[accnm2],.grpsav);
Found _ true;
Return(0);
End;
Filblock(lub,'.ACCT.',mlrext,#777^27,mlrppn);
grpsav _ .grpname;
wrd _ 0;
found _ FALSE;
ifskip open(Aux,PLIT(12,mlrdev,address(tmpbuf),0)) then
ifskip lookup(Aux,address(lub)) then
Begin
While (.wrd NEQ "EOF") do
Begin
a _ wrd _ 0;
Until (.wrd EQL -1) or (.a EQL accmax) do
Begin
Wrd _ Infile("AUX");
acct2[.a] _ .wrd;
a _ .a + 1;
End;
Select .grpname of
NSET
.acct2[accgp1]:Dogroup();
.acct2[accgp2]:Dogroup();
.acct2[accgp3]:Dogroup();
.acct2[accgp4]:Dogroup();
.acct2[accgp5]:Dogroup();
TESN;
End;
If (NOT .found) then
Begin
Print('?M?J?G%No user found for GROUP:');
Sixout(.grpname,-1);
Crlf;
End;
Close(AUX);
Releas(AUX);
End
Else
Begin
Print('?M?J?G??MAIEAF Error on accounting file');
Error(.lub[1]<righthalf>);
Releas(Aux);
End
else Print('?M?J?G??MAIDNA Mailer device not available?M?J');
End; ! End of routine GETGROUP
Routine Setsend(uname1,uname2,grpname)=
Begin
!
! This routine returns TRUE is send was to ALL and FALSE otherwise.
!
Own b,all;
b _ 0;
all _ FALSE;
If (.uname1 EQL sixbit'ALL') then
If NOT (Prvbit(pvsall)) then
Begin ! Request to SEND ALL without privs
Print('?M?J?G??You are not privileged to send to ALL?M?J');
Return(FALSE);
End
Else All _ TRUE;
If (.uname1 EQL 0) then
Return(.all); ! No request; Nothing to do
While (.sendto[.b] NEQ 0) do
Begin
If Usern(.sendto[.b+stonm1],.sendto[.b+stonm2],.uname1,.uname2) then
Begin
If (.grpname EQL 0)AND(.sendto[.b+stogrp] EQL 0)
Then Begin
Print('?M?J?G%Duplicate user: ');
Sixout(.uname1,-1);
Sixout(.uname2,-1);
Crlf;
End;
If (.grpname EQL 0) then sendto[.b+stogrp] _ 0;
Return (.all);
End;
b _ .b + stosiz;
If (.b GEQ stomax) then
Begin
Print('?M?J?G??MAITMU Too many users in SEND command - User: ');
Sixout(.uname1,-1);
Sixout(.uname2,-1);
Print(' ignored.');
Return (FALSE);
End;
End;
sendto[.b+stonm1]_.uname1;
sendto[.b+stonm2]_.uname2;
sendto[.b+stogrp]_.grpname;
b _ .b + stosiz;
If (.b LSS stomax) then
Begin
sendto[.b+stonm1]_0;
sendto[.b+stonm2]_0;
sendto[.b+stogrp]_0;
End;
Return(.all);
End;
Global routine sendmail(uname1,uname2,rst)=
Begin
Own tmp[3],txtptr,flg,chars,lines,message,cmd,tmpptr,allsnd,
txtstr,tmpbyt,txtpnt,infblk[5],retry,
a,wrd,suser[stosiz],sptr,lub1[4],lub2[#15],fob[6],Datbuf[20];
Label Inmsg;
sendto[stonm1] _ 0; ! Insure that this is init
sendto[stonm2] _ 0;
sendto[stogrp] _ 0;
IF (.uname1 NEQ -1) then Allsnd _ Setsend(.uname1,.uname2,0); ! Set up first entry
If (.uname1 EQL 0)OR(.uname1 EQL -1) then ! Did the user request 1?
Begin
If (.uname1 EQL -1) then
Begin
tmp[0] _ .uname2;
If(sixin(.tmp[0],6)EQL 0) THEN uname1 _ 0;
tmpptr _ .uname2;
End;
If (.uname1 EQL 0) THEN
BEGIN
Print('?M?JList users and groups to receive message.?M?J');
Print('Seperate with commas. Express groups as ''GROUP:name''?M?J');
tmp[0] _ 0;
ac1 _ "?J";
While (.tmp[0] EQL 0)and((.ac1 EQL "?J")or(.ac1 EQL "?L")) do
Begin
Print('To: ');
ac2 _ Byteptr(Address(Cmdbuff));
tmp[0] _ Rdtty(.ac2,maxcmd);
End;
If (.ac1 EQL "?G") then
Begin
Print('?M?J?G[Send aborted]?M?J');
Return 0;
End;
tmpptr _ Byteptr(Address(Cmdbuff));
Scani(tmpptr);
END;
tmp[2] _ ",";
While (.tmp[2] EQL ",") do
Begin
tmp[0] _ Sixin(.tmpptr,-6);
tmp[2] _ .ac1;
tmpptr _ .ac3;
If (.ac1 EQL 0) then tmp[1] _ Sixin(.tmpptr,-6)
else tmp[1] _ 0;
tmp[2] _ .ac1;
tmpptr _ .ac3;
While (.ac1 EQL 0) do
Begin
Sixin(.tmpptr,-6);
tmp[2] _ .ac1;
tmpptr _ .ac3;
End;
If (.ac1 EQL ":")and(.tmp[0] EQL sixbit'GROUP') then
Begin
Scani(tmpptr);
tmp[1] _ Sixin(.tmpptr,-6);
tmp[2] _ .ac1;
tmpptr _ .ac3;
If (.tmp[1] EQL 0) then
Begin
Print('?M?J?G??MAINGI Null group illegal?M?J');
Return 0;
End;
While (.ac1 EQL 0) do
Begin
Sixin(.tmpptr,-6);
tmp[2] _ .ac1;
tmpptr _ .ac3;
End;
If (NOT prvbit(pvsagp)) then
Begin
Select .tmp[1] of
NSET
.acct[accgp1]:flg _ true;
.acct[accgp2]:flg _ true;
.acct[accgp3]:flg _ true;
.acct[accgp4]:flg _ true;
.acct[accgp5]:flg _ true;
otherwise:flg _ false;
TESN;
If NOT(prvbit(pvsogp)) then flg _ false;
If (.flg) then
Begin
getgroup(.tmp[1]);
End
Else
Begin
Print('?M?J?G??MAICSG You may not send to GROUP:');
Sixout(.tmp[1],-1);
Crlf;
End;
End
Else Getgroup(.tmp[1]);
End
Else
Begin
If (.tmp[2] EQL -1)or(.tmp[2] EQL ",") then
If (.tmp[0] NEQ 0) then
If (Setsend(.tmp[0],.tmp[1],0)) then allsnd _ true
else 0
else 0
else
Begin
Print('?M?J?G??MAIILS Illegal seperator ''');
Outc(.tmp[2]);
Outc("'");
Crlf;
Return 0;
End;
End;
Scani(tmpptr);
End;
End;
! Now check to see if we are sending to anyone.
if (.sendto[stonm1] EQL 0) then
Begin
Print('?M?J?G%No one in mail list. Send request cancelled.?M?J');
Return 0;
End;
! We now know who to send this message TO. Set up global information.
msg[mlfnm1] _ .acct[accnm1];
msg[mlfnm2] _ .acct[accnm2];
msg[mlfus1] _ .acct[accus1];
msg[mlfus2] _ .acct[accus2];
msg[mlfppn] _ .acct[accppn];
msg[mlfloc] _ node();
msg[mlftim] _ gettab(8,9);
msg[mlfdat] _ gettab(#57,9)^18 + gettab(#60,9);
msg[mlfyer] _ gettab(#56,9);
ac1 _ -1;
Ifskip Trmno(ac1) then 0 else print('?M?J?G??MAITUE TRMNO. uuo failure?M?J');
msg[mlftty] _ .ac1 - #200000;
msg[mlfsdt] _ gettab(#53,#11);
msg[mlfexp] _ 0;
msg[mlfrs2] _ 0;
msg[mlfrs3] _ 0;
msg[mlfrs4] _ 0;
msg[mlfrs5] _ 0;
msg[mlfrs6] _ 0;
msg[mlfrs7] _ 0;
msg[mlfrs8] _ 0;
Print('?M?JSubject (1 line): ');
Rdtty(Byteptr(Address(msg[mlfsub])),72);
Incr a from 1 to 10 do replacei(ac2,0);
If (.ac1 EQL "?G") then
Begin
Print('?M?J?G[Message aborted]?M?J');
Return(0);
End;
a _ mlfsub;
Until (.msg[.a] EQL 0) do a _ .a + 1;
a _ .a + 1;
msg[.a] _ 0;
a _ .a + 1;
lines _ msg[.a];
chars _ msg[.a+1];
a _ .a + 2;
message _ msg[.a];
ac2 _ Byteptr(Address(msg[.a]));
ac1 _ .chars _ .lines _ 0;
Print('?M?JMessage (Type ^Z to end; ^G to quit):?M?J?J');
INMSG:
While (.Ac1 NEQ "?Z") do
Begin
.Chars _ ..Chars + Rdtty(.ac2,MAXMSG-..chars);
Select .ac1 of
NSET
0:Begin
If (..chars + 2)LEQ Maxmsg then
Begin
.Chars _ ..Chars + 2;
.Lines _ ..Lines + 1;
Replacei(ac2,"?M");
Replacei(ac2,"?J");
End
Else
Begin
Print('?M?J?G??MAIMSE Maximum message size exceeded?M?J');
Leave Inmsg;
End;
end;
"?G":Begin
Print('?M?J[Message Aborted]?M?J');
Return (0);
end;
otherwise:Begin
If (..chars + 2)LEQ Maxmsg then
Begin
.Chars _ ..Chars + 2;
.Lines _ ..Lines + 1;
Replacei(ac2,"?M");
Replacei(ac2,"?J");
End
Else
Begin
Print('?M?J?G??MAIMSE Maximum message size exceeded?M?J');
Leave Inmsg;
End;
end;
TESN;
End;
Txtptr _ .ac2;
Txtstr _ .a;
Until (.msg[.a] EQL 0) do a _ .a + 1;
a _ .a + 1;
msg[.a] _ 0;
msg[.a+1] _ -1;
Crlf;
cmd _ 0;
While ((.cmd NEQ sixbit'SEND')) do
Begin
Print('SEND> ');
cmd _ sixin(0,-6);
tmpptr _ .ac3;
proccmd(cmd,'SEND',1);
proccmd(cmd,'ABORT',1);
proccmd(cmd,'HELP',1);
proccmd(cmd,'INSERT',1);
proccmd(cmd,'EXPIRE',1);
proccmd(cmd,'SAVE',2);
proccmd(cmd,'LIST',1);
proccmd(cmd,'TO',1);
If (.cmd EQL 0) then cmd _ sixbit'SEND';
Select .cmd of
NSET
Sixbit'SEND':
Begin
If (.allsnd) then
If (.msg[mlfexp] EQL 0) then
Begin
Print('?M?J?G??MAIAME Mail sent to ALL requires an expiration date?M?J');
Cmd _ 0;
End;
End;
Sixbit'ABORT':Return;
Sixbit'INSERT':Begin
Filbuf[ffdev] _ sixbit'DSK';
Filbuf[ffnam] _ sixbit'MAILER';
Filbuf[ffext] _ sixbit'TXT';
Filbuf[ffpth] _ 0;
If (Getfile(.tmpptr) NEQ -1) then
If (Opnchn() NEQ -1) then
If(Lkpchn() NEQ -1) then
Begin
If (.filbuf[ffdev]<lefthalf> EQL sixbit"TTY") then Cprint('?M?JType additional message (End on ^Z)?M?J');
Output(IO);
Tmpbyt _ 0;
While (.tmpbyt NEQ -1) do
Begin
Tmpbyt _ Bytein();
If (.tmpbyt NEQ 0)AND(.tmpbyt NEQ -1)AND(.tmpbyt NEQ "?Z") then
Begin
Replacei(Txtptr,.tmpbyt);
If (.tmpbyt EQL "?J") then lines _ .lines + 1;
txtpnt _ txtptr;
incr a from 1 to 6 by 1 do replacei(txtpnt,0);
chars _ .chars + 1;
If (..chars GTR maxmsg) then
Begin
Print('?M?J???GMAIMTB Message too big - Aborted');
Return;
End;
End;
End;
a _ .txtstr;
Until (.msg[.a] EQL 0) do a _ .a + 1;
a _ .a + 1;
msg[.a] _ 0;
msg[.a+1] _ -1;
End;
ac1 _ io;
Resdv(AC1);
End;
Sixbit'LIST':Begin
Bitset(msg[mlfflg],mfgsnd) _ 1;
Typemail(msg);
End;
Sixbit'SAVE':Begin
Bitset(msg[mlfflg],mfgsnd) _ 1;
Savemail(msg);
End;
Sixbit'TO':Begin
Print('?M?J?G%Not implemented?M?J');
End;
Sixbit'HELP':Begin
Print('?M?JSEND commands are:?M?J');
Tab; Print('Abort - Cancel the message?M?J');
Tab; Print('Expire - Set message expiration date?M?J');
Tab; Print('Help - Print this text?M?J');
Tab; Print('Insert - To insert a file into message?M?J');
Tab; Print('List - Print out entire message?M?J');
Tab; Print('SAve - Save a copy of the message?M?J');
Tab; Print('Send - Send message (same as <CR>)?M?J');
Tab; Print('To - Add another user or group?M?J');
End;
Sixbit'Expire':Begin
Msg[Mlfexp] _ Datin(.tmpptr);
Until (.Msg[Mlfexp] NEQ 0) do
Begin
Print('Date/time: ');
Tmpptr _ Byteptr(Address(datbuf));
If (Rdtty(.Tmpptr,72)EQL 0) Then Msg[Mlfexp] _ -1;
Scani(Tmpptr);
Msg[Mlfexp] _ Datin(.tmpptr);
End;
If (.Msg[Mlfexp] LEQ Gettab(#53,#11))AND(.Msg[Mlfexp]NEQ -1) then
Begin
Print('?M?J?G%Date/time is before now - Expiration cleared?M?J');
Msg[Mlfexp] _ 0;
End;
If (.Msg[Mlfexp] EQL -1) then
Begin
Print('?M?J?G%No date/time specified - Expiration cleared?M?J');
Msg[Mlfexp] _ 0;
End;
End;
Otherwise:Print('?G??MAIISC Invalid SEND command - Type HELP?M?J');
TESN;
End;
Print('?M?JProcessing mail...?M?J');
If (.Rst) then Reset; ! Reset if allowed.
Filblock(lub1,'.ACCT.',mlrext,#777^27,mlrppn);
Ifskip Open(Aux,PLIT(12,mlrdev,address(tmpbuf),0)) then
ifskip Lookup(Aux,address(lub1)) then 0
else
Begin
Print('?M?J?G??MAIAFE Accounting file error?M?J');
Error(.lub1[1]<righthalf>);
Return(0);
End
else
Begin
Print('?M?J?G??MAIDNA Unable to open MAILER device?M?J');
Return(0);
End;
Retry _ -1;
Sptr _ GetNextSend(suser,0); ! Get the first user
Until (.Sptr EQL 0) do ! Main send loop
Begin
msg[mlfgrp] _ .suser[stogrp];
Sixout(.suser[stonm1],-1);
Sixout(.suser[stonm2],-1);
If (.suser[stogrp] NEQ 0) then
Begin
Tab;
Sixout(.suser[stogrp],-1);
Print(' - ');
End
Else Print(' - ');
If NOT (GetAEntry(.suser[stonm1],.suser[stonm2]))
then Print('No such user?M?J')
else
Begin
Msg[mlfflg] _ 0;
If (.suser[stogrp] NEQ 0) then Bitset(Msg[mlfflg],mfggrp) _ 1;
If (.suser[stonm1] EQL sixbit'ALL') then Bitset(Msg[mlfflg],mfgsys) _ 1;
Lub2[0] _ #15; ! Number of arguments
Lub2[1] _ .auxact[accppn]; ! User PPN
Lub2[2] _ .auxact[accmlf]; ! Mail file name
Lub2[3] _ .auxact[accmfe]; ! Mail file extension
Lub2[4] _ Xwd(#777000,0); ! Protection
Incr a from 5 to #13 do lub2[.a] _ 0;
Lub2[#14] _ Gettab(#53,#11);
Fob[0] _ OUT2^18+6;
Fob[1] _ 12;
Fob[2] _ .Auxact[accmfd];
Fob[3] _ Address(Otmphdr)^18;
Fob[4] _ 1^18+0;
Fob[5] _ address(lub2);
If (.retry LSS 0) then retry _ 0;
Ac1 _ Xwd(6,Address(fob));
Ifskip FILOP(ac1) then
Begin
If NOT Lockchn(out2,7) then
Begin
Releas(out2);
Return(0);
End;
a _ 0;
wrd _ 0;
While (.wrd NEQ -1) do
Begin
Out2file(.msg[.a]);
a _ .a + 1;
wrd _ .msg[.a];
If (.a LEQ Mlfsub) then wrd _ 0;
End;
Out2file(-1);
Close(out2);
Releas(out2);
If (.auxact[accnm1] EQL sixbit'ALL') then auxact[accppn] _ #777777;
Print('Message sent');
Infblk[0] _ .auxact[accppn]; Infblk[1] _ 0; Infblk[2] _ 0;Infblk[3] _ .Acct[accnm1];Infblk[4] _ .Acct[accnm2];
If (.auxact[accppn] NEQ #777777) then
Begin
Infblk[1] _ .auxact[accnm1];
Infblk[2] _ .auxact[accnm2];
End;
If (Inform(Infblk)) then Print(' - User informed');
Crlf;
retry _ -1;
End
Else
Begin
retry _ .retry + 1;
if (.ac1 EQL 3) then
Begin
Print('Mailbox is busy - ');
If (.retry LEQ 5) then
Begin
Print('Retrying...');
ac1 _ 1;
Sleep(ac1);
End
else Begin
Print('Aborting?G');
retry _ -1;
End;
Crlf;
End
Else
Begin
Print('Error (');
Outoct(.ac1);
Print(') message aborted?G?M?J');
retry _ -1;
End;
End;
End;
if (.retry LSS 0) then Sptr _ GetNextSend(suser,.sptr);
End;
Close(aux);
Releas(aux);
End;
End
Eludom