{$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.