410 lines
13 KiB
Plaintext
410 lines
13 KiB
Plaintext
{$X+,B-,V-} {essential compiler directives}
|
|
|
|
Unit pmail;
|
|
|
|
{Example unit for the nwMess unit / NwTP 0.6 API. (c) 1993,1995, R.Spronk }
|
|
|
|
INTERFACE
|
|
|
|
uses nwMisc,nwBindry,nwMess,nwServ;
|
|
{nwserv used for GetFileServerDateAndTime only. }
|
|
|
|
CONST {Mail Options}
|
|
PM_NO_NOTIFY =$02;
|
|
PM_DELIVER_IF_AF=$10;
|
|
PM_NO_CONF_REQ =$08;
|
|
PM_NO_MAIL =$04;
|
|
|
|
Var result:word;
|
|
|
|
Function PMailInstalled:boolean;
|
|
{ Checks if an object PEGASUS_MAIL of type OT_PEGASUS_MAIL exists
|
|
in the bindery. If the object exists, pmail is installed.}
|
|
|
|
Function SendMailFile(DestObjectName:string;objType:word;
|
|
subject,fileName:string):boolean;
|
|
{ PEGASUS MAIL V3.0 Compatible:
|
|
|
|
Sends a messagebody textfile (ASCII) to the mail directory of the
|
|
destination object. The object can either be a user or a group object.
|
|
Wildcards are allowed.
|
|
|
|
The destination object will see the calling object as the message
|
|
originating object.
|
|
|
|
Notes:
|
|
-Autoforwarding will be ignored.
|
|
-This is a single server function.
|
|
-Possible resultcodes:
|
|
$0 Success;
|
|
|
|
$100 * The given file could not be found. Supply full path and filename.
|
|
$101 * User and Group objects only;
|
|
$102 ? Error scanning bindery, see Nwbindry.Result for netware error # ;
|
|
$110 ? Group has no members / error reading members of a group.
|
|
$111 * Group or user object doesn't exist
|
|
|
|
$200 * Insufficient privilege to use the mail system.
|
|
$201 * You are not allowed to send to groups.
|
|
$202 * The supplied receiver user object has no access to mail /
|
|
has halted all incoming mail OR
|
|
the receiving object equals the sending object.
|
|
|
|
-All msgs were sent when the resultcode is $00;
|
|
-No msgs are send. (resultcodes marked with *)
|
|
-Some or no msgs may have been sent before this error occured.(marked ?)
|
|
}
|
|
|
|
IMPLEMENTATION{=============================================================}
|
|
|
|
Function PMailInstalled:boolean;
|
|
Var lastObj :LongInt;
|
|
foundObjName:string;
|
|
rt :word;
|
|
rid :LongInt;
|
|
rf,rs :byte;
|
|
rhp :Boolean;
|
|
begin
|
|
{ Checks if an object PEGASUS_MAIL of type OT_PEGASUS_MAIL exists
|
|
in the bindery. If the object exists, pmail is installed.}
|
|
lastObj:=-1;
|
|
PmailInstalled:=ScanBinderyObject('PEGASUS_MAIL',OT_PEGASUS_MAIL,lastObj,
|
|
foundObjName,rt,rid,rf,rs,rhp);
|
|
end;
|
|
|
|
{------------------Send file as message--------------------------------------}
|
|
|
|
Type TPmailHdr=record
|
|
from,too,date,subject,xmailer:string;
|
|
end;
|
|
|
|
var senderObjId:LongInt;
|
|
warning :byte;
|
|
time :TnovTime;
|
|
|
|
|
|
Procedure getRandomFileName(Var filename:string);
|
|
{ construct a semi-random filename out of the current date & time }
|
|
Var tim:TnovTime;
|
|
t :byte;
|
|
begin
|
|
nwServ.GetFileServerDateAndTime(tim);
|
|
fileName[0]:=#8;
|
|
filename[1]:=chr(tim.month);
|
|
filename[2]:=chr(tim.day);
|
|
filename[3]:=chr(tim.hour);
|
|
filename[4]:=chr(tim.min DIV 2);
|
|
filename[5]:=chr(tim.sec DIV 2);
|
|
filename[6]:=chr(random(36));
|
|
filename[7]:=chr(random(36));
|
|
filename[8]:=chr(random(36));
|
|
for t:=1 to 8
|
|
do if filename[t]<=#9 then inc(filename[t],ord('0'))
|
|
else inc(filename[t],ord('A')-10);
|
|
end;
|
|
|
|
Function IsObjGroupMember(objId:longInt;GroupName:string):boolean;
|
|
Var objName:string;
|
|
objType:word;
|
|
begin
|
|
IsObjGroupMember:=GetBinderyObjectName(objId,objName,objType)
|
|
and IsBinderyObjectInSet(GroupName,OT_USER_GROUP,'GROUP_MEMBERS',
|
|
objName,OT_USER);
|
|
end;
|
|
|
|
Function PmailNotifyUser(objName:string):boolean;
|
|
{ Read the MAIL_OPTIONS property (created by Pmail) of the destination object.
|
|
Structure of the property:
|
|
|
|
01 len Pmail_forwarding_adress_(asciiz) [OPTIONAL]
|
|
02 len Internet_forwarding_adress_(asciiz) [OPTIONAL]
|
|
03 04 extended_features_byte ???_byte [NOT optional]
|
|
04 len Charon 3.5+ sender synonym. [OPTIONAL]
|
|
|
|
Notes: -len= 3+length of the next asciiz string (excluding trailing 0)
|
|
-the above fields appear within the property in random order.
|
|
|
|
If the PM_NO_NOTIFY or the PM_NO_MAIL flag within the extended features
|
|
byte is set, then the destination object won't be notified. }
|
|
Var segNbr :word;
|
|
propValue:Tproperty;
|
|
moreSeg :boolean;
|
|
propFlags:Byte;
|
|
t :word;
|
|
fieldFlag:byte;
|
|
Notify :boolean;
|
|
begin
|
|
SegNbr:=1;
|
|
warning:=$00;
|
|
IF ReadPropertyValue(objName,OT_USER,'MAIL_OPTIONS',SegNbr,
|
|
propValue,moreSeg,propFlags)
|
|
then begin
|
|
t:=1;
|
|
|
|
REPEAT
|
|
fieldFlag:=propValue[t];
|
|
if fieldFlag<>3 then t:=t+propValue[t+1];
|
|
UNTIL (t>127) or (fieldFlag=3);
|
|
|
|
if fieldFlag=3
|
|
then begin
|
|
Notify:=((propValue[t+2] and PM_NO_NOTIFY)=0)
|
|
and ((propValue[t+2] and PM_NO_MAIL)=0);
|
|
if (propValue[t+2] and PM_NO_MAIL)>0
|
|
then warning:=$02;
|
|
end;
|
|
end
|
|
else if nwBindry.result=$EC { empty property, default: notify. }
|
|
then Notify:=true
|
|
else Notify:=false; { when in doubt, don't notify }
|
|
PmailNotifyUser:=Notify;
|
|
end;
|
|
|
|
|
|
Procedure SendMsgToUser(UserObjID:LongInt;VAR Hdr:TPmailHdr;fileName:string);
|
|
{copy file as a msg to the users' mail directory.}
|
|
Var userObjName:string;
|
|
objType :word;
|
|
buffer :array[1..4096] of byte;
|
|
bytesRead,bufOffs:word;
|
|
MsgFilePath,MailDir,MailFile:string;
|
|
Fin,Fout :file;
|
|
sendIt,NotifyReceiver:boolean;
|
|
MsgFrom :string;
|
|
begin
|
|
SendIt:=NOT(UserObjId=SenderObjId); { don't mail yourself }
|
|
|
|
{ checking Pmail settings.. }
|
|
IF IsObjGroupMember(UserObjId,'NOMAILBOX')
|
|
then SendIt:=false;
|
|
|
|
IsObjGroupMember(UserObjId,'MAILUSERS');
|
|
if (nwBindry.result=$EA) { no such member }
|
|
OR IsObjGroupMember(UserObjId,'NOMAIL')
|
|
then sendit:=false;
|
|
|
|
GetBinderyObjectName(UserObjID,UserObjName,objType);
|
|
NotifyReceiver:=PmailNotifyUser(UserObjName);
|
|
if warning=$02 { receiving user has PM_NO_MAIL flag raised }
|
|
then sendit:=false;
|
|
|
|
if sendit
|
|
then begin
|
|
warning:=$00;
|
|
if pos('From',hdr.from)=0
|
|
then Hdr.from:= 'From: '+Hdr.from;
|
|
MsgFrom:=Hdr.From; delete(MsgFrom,1,16);
|
|
Hdr.too := 'To: '+UserObjName;
|
|
if pos('Date',Hdr.date)=0
|
|
then Hdr.date:= 'Date: '+Hdr.date;
|
|
if pos('Subj',Hdr.subject)=0
|
|
then Hdr.subject:='Subject: '+hdr.subject;
|
|
Hdr.xmailer:='X-mailer: NwTP gateway to Pmail.';
|
|
|
|
bufOffs:=1;
|
|
move(hdr.from[1],buffer[bufOffs],ord(hdr.from[0]));
|
|
inc(bufOffs,2+ord(hdr.from[0]));
|
|
buffer[bufOffs-2]:=13;buffer[bufOffs-1]:=10; { ret/ lf }
|
|
move(hdr.too[1],buffer[bufOffs],ord(hdr.too[0]));
|
|
inc(bufOffs,2+ord(hdr.too[0]));
|
|
buffer[bufOffs-2]:=13;buffer[bufOffs-1]:=10; { ret/ lf }
|
|
move(hdr.date[1],buffer[bufOffs],ord(hdr.date[0]));
|
|
inc(bufOffs,2+ord(hdr.date[0]));
|
|
buffer[bufOffs-2]:=13;buffer[bufOffs-1]:=10; { ret/ lf }
|
|
move(hdr.subject[1],buffer[bufOffs],ord(hdr.subject[0]));
|
|
inc(bufOffs,2+ord(hdr.subject[0]));
|
|
buffer[bufOffs-2]:=13;buffer[bufOffs-1]:=10; { ret/ lf }
|
|
move(hdr.xmailer[1],buffer[bufOffs],ord(hdr.xmailer[0]));
|
|
inc(bufOffs,2+ord(hdr.xmailer[0]));
|
|
buffer[bufOffs-2]:=13;buffer[bufOffs-1]:=10; { ret/ lf }
|
|
buffer[bufOffs]:=13;buffer[bufOffs+1]:=10; { empty line }
|
|
inc(bufOffs,2);
|
|
|
|
MailDir:=HexStr(UserObjId,8);
|
|
while maildir[1]='0' do delete(Maildir,1,1);
|
|
GetRandomFileName(MailFile);
|
|
|
|
{$I-}
|
|
MsgFilePath:='SYS:MAIL\'+MailDir+'\'+MailFile+'.CNM';
|
|
assign(Fin,fileName);
|
|
reset(Fin,1);
|
|
assign(Fout,MsgFilePath);
|
|
rewrite(Fout,1);
|
|
{ buffOfs-1 = number of bytes in buffer already filled }
|
|
BlockRead(Fin,buffer[bufOffs],4096-(bufOffs-1),bytesRead);
|
|
BlockWrite(Fout,buffer[1],bytesRead+(bufOffs-1));
|
|
REPEAT
|
|
BlockRead(Fin,buffer[1],4096,bytesRead);
|
|
BlockWrite(Fout,buffer[1],bytesRead);
|
|
UNTIL bytesRead<4096;
|
|
close(Fin);
|
|
close(Fout);
|
|
{$I+}
|
|
|
|
IF NotifyReceiver
|
|
then nwMess.SendmessageToUser(UserObjName,
|
|
'(NwTP/Pmail:) You have mail. (From:'+MsgFrom+')')
|
|
end
|
|
else warning:=$01;
|
|
end;
|
|
|
|
Procedure SendMsgToGroup(GroupObjName:string;Hdr:TPmailHdr;fileName:string);
|
|
Label abrt;
|
|
Var NbrOfWrites:word;
|
|
i :byte;
|
|
|
|
lastObj :LongInt;
|
|
foundGroupName:string;
|
|
rt :word;
|
|
rid :LongInt;
|
|
rf,rs :byte;
|
|
rhp :boolean;
|
|
|
|
SegNbr :byte;
|
|
propValue:Tproperty;
|
|
moreSeg :boolean;
|
|
propFlags:byte;
|
|
|
|
objId : LongInt;
|
|
begin
|
|
NbrOfWrites:=0;
|
|
lastObj:=-1;
|
|
WHILE ScanBinderyObject(GroupObjName,OT_USER_GROUP,lastObj,
|
|
foundGroupName,rt,rid,rf,rs,rhp)
|
|
do begin {1}
|
|
if (GroupObjName<>'NOMAIL') and (GroupObjName<>'NOMAILBOX')
|
|
then begin {3}
|
|
SegNbr:=1;
|
|
While ReadPropertyValue(foundGroupName,OT_USER_GROUP,'GROUP_MEMBERS',
|
|
SegNbr,propValue,moreSeg,propFlags)
|
|
do begin {5}
|
|
i:=1;
|
|
Repeat
|
|
objId:=MakeLong((PropValue[i] *256 +PropValue[i+1]),
|
|
(PropValue[i+2] *256 + PropValue[i+3] ) );
|
|
if objId<>0
|
|
then begin
|
|
SendMsgToUser(objId,Hdr,fileName);
|
|
inc(NbrOfWrites);
|
|
end;
|
|
inc(i,4);
|
|
Until (i>128) or (objId=0);
|
|
inc(SegNbr);
|
|
end; {5}
|
|
If nwBindry.Result<>$EC {no such segment}
|
|
then begin
|
|
Result:=$110;
|
|
goto abrt;
|
|
end;
|
|
end; {3}
|
|
end; {1}
|
|
if nwBindry.Result<>$FC {no such object}
|
|
then begin
|
|
result:=$111;
|
|
goto abrt;
|
|
end;
|
|
if NbrOfWrites=0 {no users found}
|
|
then result:=$110;
|
|
|
|
abrt: ;
|
|
end;
|
|
|
|
|
|
Function SendMailFile(DestObjectName:string;objType:word;
|
|
subject,fileName:string):boolean;
|
|
Var secLevel :byte;
|
|
senderName:string;
|
|
SenderObjType:word;
|
|
Hdr :TPmailHdr;
|
|
lastObj :longInt;
|
|
foundUserName:string;
|
|
rt :word;
|
|
rf,rs :byte;
|
|
rhp :boolean;
|
|
DestObjId :longint;
|
|
testFile :file;
|
|
begin
|
|
Warning:=$00;
|
|
|
|
{ check: does filename exist? if not, stop right away. error $100 }
|
|
{$I-}
|
|
assign(testFile,filename);
|
|
reset(testFile);
|
|
if IOresult<>0
|
|
then begin
|
|
result:=$100;
|
|
SendmailFile:=False;
|
|
exit;
|
|
end
|
|
else close(testFile);
|
|
{$I+}
|
|
|
|
GetBinderyAccessLevel(secLevel,senderObjId);
|
|
GetBinderyObjectName(senderObjId,senderName,SenderObjType);
|
|
|
|
{checking pmail config. groups... }
|
|
IsObjGroupMember(senderObjId,'MAILUSERS');
|
|
if (nwBindry.result=$EA) { mailusers group exists, sender not a member }
|
|
OR IsObjGroupMember(senderObjId,'NOMAIL')
|
|
then begin
|
|
result:=$200; { Insufficient privilege to use the mail system. }
|
|
SendMailFile:=false;
|
|
exit;
|
|
end;
|
|
|
|
Hdr.from:=senderName;
|
|
Hdr.subject:=subject;
|
|
GetFileServerDateAndTime(time);
|
|
NovTime2String(time,Hdr.date);
|
|
|
|
Result:=0;
|
|
if objType=OT_USER
|
|
then begin
|
|
lastObj:=-1;
|
|
WHILE ScanBinderyObject(DestObjectName,OT_USER,lastObj,
|
|
foundUserName,rt,DestObjID,rf,rs,rhp)
|
|
do begin
|
|
SendMsgToUser(DestObjId,Hdr,fileName);
|
|
end;
|
|
IF nwBindry.result<>$FC { no such object } then result:=$102;
|
|
end
|
|
else if objType=OT_USER_GROUP
|
|
then begin
|
|
IsObjGroupMember(senderObjId,'GROUPMAIL');
|
|
if (nwBindry.result=$EA) { group groupmail exists, sender not a member }
|
|
OR IsObjGroupMember(senderObjId,'NOGROUPMAIL')
|
|
then result:=$201 { don't send }
|
|
else SendMsgToGroup(DestObjectName,Hdr,fileName)
|
|
end
|
|
else result:=$101;
|
|
|
|
if (warning=$01) and (objType=OT_USER) and (result=$00)
|
|
and (pos('*',DestObjectName)=0) and (pos('?',DestObjectName)=0)
|
|
then result:=$202;
|
|
|
|
SendMailFile:=(result=0);
|
|
{ possible resultcodes:
|
|
$0 Success;
|
|
|
|
$100 * The given file could not be found. Supply full path and filename.
|
|
$101 * User and Group objects only;
|
|
$102 ? Error scanning bindery, see Nwbindry.Result for netware error # ;
|
|
$110 ? Group has no members / error reading members of a group.
|
|
$111 * Group or user object doesn't exist
|
|
|
|
$200 * Insufficient privilege to use the mail system.
|
|
$201 * You are not allowed to send to groups.
|
|
$202 * The supplied receiver user object has no access to mail /
|
|
has halted all incoming mail OR
|
|
the receiving object equals the sending object.
|
|
|
|
Note: -All msgs were send when the resultcode is $00;
|
|
-No msgs are send. (resultcodes marked with *)
|
|
-Some or no msgs may have been send before this error occured.(marked ?)
|
|
}
|
|
end;
|
|
|
|
begin
|
|
Randomize;
|
|
end.
|