MaintMail.xxm

[[@txDefs,txSession,Windows,Classes,DataLank,
txFilter,txFilterSql,Variants,txCache,txTerms,txNodes,xxmString]][[!var
sl:TStringList;
qr,qr1,qr2:TQueryResult;
sl_i,users_i,users_l,limit,dMax,id,pid,i,j,l,d,c1,c2:integer;
f:TtxFilter;
fq,fq1,fq2:TtxSqlQueryFragments;
fs,fsu,s,msgURL,msgFrom,msgSubject:string;
sql1,sql2:UTF8String;
users:array of record
  id,sid,uid:integer;
  email,name,subject:string;
end;
tc1,tc2,tc3,tc4:TTimerIndex;
qs1,qs2,dryrun,msgSubjDyn:boolean;
d0,d1,d2:TDateTime;
rpFilter:TtxRealmPermission;
LocationCache:TItemCache;
TermDomains:TIndexCache;
msg:TStringContext;
ln:TLocationNode;
mm:AnsiString;
ff:TFileStream;

const
  Base64Codes:array[0..63] of AnsiChar=
    'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';

function base64encode(var Data;DataSize:cardinal):AnsiString;
type
  PByte=^byte;
var
  i:integer;
  d1,d2,d3:byte;
  p,pl:PByte;
begin
  i:=(DataSize div 3);
  if (DataSize mod 3)<>0 then inc(i);
  SetLength(Result,i*4);//+(DataSize div 57)*2);
  p:=@Data;
  pl:=p;inc(pl,DataSize);
  i:=0;
  while cardinal(p)<cardinal(pl) do
   begin
    d1:=p^;inc(p);
    if p=pl then
     begin
      inc(i);Result[i]:=Base64Codes[  d1 shr  2];
      inc(i);Result[i]:=Base64Codes[((d1 and $3) shl 4)];
      inc(i);Result[i]:='=';
      inc(i);Result[i]:='=';
     end
    else
     begin
      d2:=p^;inc(p);
      if p=pl then
       begin
        inc(i);Result[i]:=Base64Codes[  d1 shr  2];
        inc(i);Result[i]:=Base64Codes[((d1 and $3) shl 4) or (d2 shr 4)];
        inc(i);Result[i]:=Base64Codes[((d2 and $F) shl 2)];
        inc(i);Result[i]:='=';
       end
      else
       begin
        d3:=p^;inc(p);
        inc(i);Result[i]:=Base64Codes[  d1 shr  2];
        inc(i);Result[i]:=Base64Codes[((d1 and $3) shl 4) or (d2 shr 4)];
        inc(i);Result[i]:=Base64Codes[((d2 and $F) shl 2) or (d3 shr 6)];
        inc(i);Result[i]:=Base64Codes[  d3 and $3F];
       end;
      //if ((cardinal(p)-cardinal(@Data)) mod 57)=0 then Result:=Result+#13#10;
     end;
   end;
end;

function ProcessImages(const FallbackURL,Body:AnsiString):AnsiString;
var
  bi,bj,bl,i:integer;
  newBody,fn,fd,fx,fn1,bn1,bn2:AnsiString;
  sl:TStringList;
  m:TMemoryStream;
begin
  bn1:=AnsiString('txUpdate'+FormatDateTime('yyyymmddhhnnsszzz',Now)+Format('%.4x%.4x%.8x',[GetCurrentProcessID,GetCurrentThreadID,integer(Self)]));
  bn2:=AnsiString('txBody'+FormatDateTime('yyyymmddhhnnsszzz',Now)+Format('%.4x%.4x%.8x',[GetCurrentProcessID,GetCurrentThreadID,integer(Self)]));
  sl:=TStringList.Create;
  m:=TMemoryStream.Create;
  try
    Result:='';
    newBody:='';
    //TODO: quoted-printable?
    sl.Sorted:=true;
    bl:=Length(Body);
    bi:=1;
    while bi<=bl do
     begin
      bj:=bi;
      while (bi<=bl) and (Copy(Body,bi,13)<>'<img src="img') do inc(bi);
      newBody:=newBody+Copy(Body,bj,bi-bj);
      if (bi<=bl) then
       begin
        inc(bi,13);
        bj:=bi;
        while (bi<=bl) and (Body[bi]<>'"') do inc(bi);

        if Body[bj]='/' then
         begin
          inc(bj);
          fd:='img\';
          fn:=Copy(Body,bj,bi-bj);
         end
        else
         begin
          fd:='';
          fn:='img'+Copy(Body,bj,bi-bj);
         end;
        fx:=fn;
        for i:=1 to Length(fx)-1 do if AnsiChar(fx[i]) in ['.','_','/','\','?'] then fx[i]:='X';
        newBody:=newBody+'<img src="cid:'+fx;
        if sl.IndexOf(string(fn))=-1 then
         begin
          i:=Length(globalImgExt+globalImgVer);
          if Copy(fn,Length(fn)-i+1,i)=globalImgExt+globalImgVer then
            fn1:=Copy(fn,1,Length(fn)-i-1)+'.png'
          else
            fn1:=fn;//raise? skip?
          m.LoadFromFile(ModulePath+string(fd+fn1));
          sl.Add(string(fn));
          //
          Result:=Result+'--'+bn1+
            #13#10'Content-Type: image/png; name="'+fn1+'"'+
            #13#10'Content-Disposition: inline; filename="'+fn1+'"'+
            #13#10'Content-Transfer-Encoding: base64'+
            #13#10'Content-ID: <'+fx+'>'+
            #13#10'X-Attachment-Id: '+fx+
            #13#10#13#10+
            base64Encode(m.Memory^,m.Size)+
            #13#10#13#10;
         end;
       end;
     end;
    Result:=
      #13#10'MIME-version: 1.0'+
      #13#10'Content-Type: multipart/related; boundary="'+bn1+'"'+
      #13#10#13#10'--'+bn1+
      #13#10'Content-Type: multipart/alternative; boundary="'+bn2+'"'+
      #13#10#13#10'--'+bn2+
      #13#10'Content-Type: text/plain'+
      #13#10#13#10'[This e-mail has the body text in HTML format only]'+
      #13#10#13#10+FallbackURL+
      #13#10#13#10'--'+bn2+
      #13#10'Content-Type: text/html; charset="UTF-8"'+
      #13#10#13#10+newBody+
      #13#10#13#10'--'+bn2+'--'+
      #13#10#13#10+Result+'--'+bn1+'--'#13#10;
  finally
    sl.Free;
    m.Free;
  end;
end;

function CheckEmail(const emailaddress:string):boolean;
var
  i:integer;
begin
  i:=Length(emailaddress);
  while (i<>0) and (emailaddress[i]<>'.') do dec(i);
  while (i<>0) and (emailaddress[i]<>'@') do dec(i);
  //TODO: more? regex?
  Result:=i<>0;
end;

]][[
Context.ContentType:='text/plain';
Context.BufferSize:=0;
CheckMaintProtect(Context);

//defaults
msgFrom:=AdministratorEmailAddress;
msgSubject:='tx Updates';
limit:=100;
dMax:=7;

msgURL:=Context.URL;
i:=Length(msgURL)-13;
if Copy(msgURL,i+1,13)='MaintMail.xxm' then SetLength(msgURL,i);

dryrun:=Context['dry'].AsInteger=1;

sl:=TStringList.Create;
try
  fs:=Context['f'].Value;
  if fs='' then fs:='MaintMail.txt';
  sl.LoadFromFile(ModulePath+fs);
  sl_i:=0;
  while sl_i<sl.Count do
   begin
    if (sl[sl_i]<>'') and not(AnsiChar(sl[sl_i][1]) in [';','#']) then
     begin
      s:=sl[sl_i];
      if Copy(s,1,5)='From=' then msgFrom:=Copy(s,6,Length(s)-5)
      else
      if Copy(s,1,8)='Subject=' then msgSubject:=Copy(s,9,Length(s)-8)
      else
      if Copy(s,1,4)='URL=' then msgURL:=Copy(s,5,Length(s)-4)
      else
      if Copy(s,1,6)='Title=' then Context.SendHTML(Copy(s,7,Length(s)-6)+#13#10)
      else
      if Copy(s,1,6)='Limit=' then limit:=StrToInt(Copy(s,7,Length(s)-6))
      else
      if Copy(s,1,5)='DMax=' then dMax:=StrToInt(Copy(s,6,Length(s)-5))
      else
       begin
        if msgSubject='' then msgSubject:='tx Updates';//default
        msgSubjDyn:=msgSubject[1]='*';
        if msgSubjDyn then msgSubject:=Copy(msgSubject,2,Length(msgSubject)-1);
        f:=TtxFilter.Create;
        fq:=TtxSqlQueryFragments.Create(itObj);//(itUser);
        try
          Context.SendHTML('Users...'#13#10);
          f.FilterExpression:=UTF8Encode(sl[sl_i]);
          if f.ParseError<>'' then raise Exception.Create('User filter: '+f.ParseError);
          if msgSubjDyn then
           begin
            fq.Fields:='Usr.id, Usr.uid, Usr.email, UObj.name, Obj.id as sid, Obj.name as subject';
            fq.AddFrom('INNER JOIN Obj UObj ON UObj.id=Obj.pid');
            fq.AddFrom('INNER JOIN Usr ON Usr.uid=UObj.id AND Usr.email<>''''');
           end
          else
           begin
            fq.Fields:='Usr.id, Usr.uid, Usr.email, Obj.id as sid, Obj.name';
            fq.AddFrom('INNER JOIN Usr ON Usr.uid=Obj.id AND Usr.email<>''''');
           end;
          fq.AddFilter(f);
          fq.OrderBy:='';
          //fq.GroupBy
          sql1:=fq.SQL;
        finally
          f.Free;
          fq.Free;
        end;
        qr:=TQueryResult.Create(Session.DbCon,sql1,[]);
        try
          i:=0;
          l:=0;
          while qr.Read do
           begin
            s:=qr.GetStr('email');
            if CheckEmail(s) then
             begin
              if i=l then
               begin
                inc(l,$100);//growstep
                SetLength(users,l);
               end;
              users[i].id:=qr.GetInt('id');
              users[i].sid:=qr.GetInt('sid');
              users[i].uid:=qr.GetInt('uid');
              users[i].email:=s;//qr.GetStr('email')
              users[i].name:=qr.GetStr('name');
              if msgSubjDyn then users[i].subject:=qr.GetStr('subject') else users[i].subject:='';
              inc(i);
             end
            else
              Context.SendHTML('ERROR: Invalid e-mail address "'+s+'"'#13#10);
           end;
          users_l:=i;
        finally
          qr.Free;
        end;
        Context.SendHTML(IntToStr(users_l)+' users'#13#10);
        inc(sl_i);
        while (sl_i<sl.Count) and not((sl[sl_i]<>'') and not(AnsiChar(sl[sl_i][1]) in [';','#'])) do inc(sl_i);
        if sl_i=sl.Count then
          raise Exception.Create('Update items filter expression missing');
        fs:=sl[sl_i];
        fsu:=string(URLEncode(fs));
        for users_i:=0 to users_l-1 do
          try
            if msgSubjDyn then
              Context.SendHTML(users[users_i].name+' <'+users[users_i].email+'> ('+users[users_i].subject+')...'#13#10)
            else
              Context.SendHTML(users[users_i].name+' <'+users[users_i].email+'>...'#13#10);
            tc1:=GetTimerIndex;
            qr:=TQueryResult.Create(Session.DbCon,'SELECT ? AS uid, ? AS email, 0 AS isanon',[users[users_i].uid,users[users_i].email]);
            try
              Session.LoadUser(qr);
            finally
              qr.Free;
            end;

            tc2:=GetTimerIndex;
            rpFilter:=rpView;//?
            sql1:='ASC';//?

            f:=TtxFilter.Create;
            fq1:=TtxSqlQueryFragments.Create(itObj);
            fq1.EnvVars[feThis]:=users[users_i].sid;
            fq1.OrderBy:='Obj.c_ts '+sql1+', Obj.weight, Obj.name';//m_ts?
            if limit<>0 then fq1.Limit:=limit;
            fq2:=TtxSqlQueryFragments.Create(itReport);
            fq2.EnvVars[feThis]:=users[users_i].sid;
            fq2.OrderBy:='Rpt.ts '+sql1;
            if limit<>0 then fq2.Limit:=limit;
            try
              f.FilterExpression:=UTF8Encode(fs);
              if f.ParseError<>'' then raise Exception.Create('User filter: '+f.ParseError);

              fq1.AddFrom('LEFT OUTER JOIN Umi ON Umi.usr_id='+IntToStrU(users[users_i].id)+' AND Umi.obj_id=Obj.id');
              fq1.AddFilter(f);
              fq1.Where:='Umi.id IS NULL AND Obj.c_uid<>'+IntToStrU(Session.UserID)+
                ' AND Obj.m_uid<>'+IntToStrU(Session.UserID)+
                ' AND Obj.c_ts>?'+
                ' AND Obj.rlm_id'+Session.Realms[rpFilter].SQL+' AND ('+fq1.Where+')';

              fq2.AddFrom('LEFT OUTER JOIN Umr ON Umr.usr_id='+IntToStrU(users[users_i].id)+' AND Umr.rpt_id=Rpt.id');
              fq2.AddFilter(f);
              fq2.Where:='Umr.id IS NULL AND Rpt.uid<>'+IntToStrU(Session.UserID)+
                ' AND Rpt.ts>?'+
                ' AND Obj.rlm_id'+Session.Realms[rpFilter].SQL+' AND ('+fq2.Where+')';

              sql1:=fq1.SQL;
              sql2:=fq2.SQL;
            finally
              f.Free;
              fq1.Free;
              fq2.Free;
            end;

            Session.DbCon.BeginTrans;
            try
              tc3:=GetTimerIndex;
              d0:=Now-dMax;
              qr1:=TQueryResult.Create(Session.DbCon,sql1,[d0]);
              qr2:=TQueryResult.Create(Session.DbCon,sql2,[d0]);
              c1:=0;
              c2:=0;
              LocationCache:=TItemCache.Create;
              TermDomains:=TIndexCache.Create;
              msg:=TStringContext.Create(Context,Self);
              try
                msg.Include('dMailHead.xxmi',[msgURL]);

                tc4:=GetTimerIndex;

                qs1:=qr1.Read;
                qs2:=qr2.Read;

                while (qs1 or qs2) and (c1<limit) and (c2<limit) do
                 begin
                  if qs1 then d1:=qr1.GetDate('c_ts') else d1:=0.0;//m_ts?
                  if qs2 then d2:=qr2.GetDate('ts') else d2:=0.0;

                  if qs1 and not(qs2 and (d1>d2)) then
                   begin
                    //object
                    id:=qr1.GetInt('id');
                    d:=TermDomains[id];
                    if d=-1 then
                     begin
                      d:=TermStore.GetDomainID(id);
                      TermDomains[id]:=d;
                     end;
                    msg.SendHTML('<div style="border-right: 3px dotted #8080FF;">');
                    msg.Include('dObjLocation.xxmi',[],[qr1,LocationCache]);
                    msg.SendHTML(['<p class="objecttitle"><a href="Item.xxm?x=i',qr1['id'],'" title="',HTMLEncode(qr1.GetStr('typename')),'">',txImg(qr1.GetInt('icon')),'&nbsp;',HTMLEncode(qr1.GetStr('name')),'</a></p>']);
                    msg.SendHTML(TermStore.TermLinks(itObj,id,d,qr1.GetStr('desc')));
                    msg.SendHTML('<p><span class="date">');
                    //msg.Include('d_cmw.xxmi',[],[qr1]);
                    if not qr1.IsNull('c_ts') then
                      msg.SendHTML([' c:&nbsp;<a href="Item.xxm?x=i',qr1['c_uid'],'">',NiceDateTime(qr1['c_ts']),'</a>']);
                    if not qr1.IsNull('m_ts') then
                      msg.SendHTML([' m:&nbsp;<a href="Item.xxm?x=i',qr1['m_uid'],'">',NiceDateTime(qr1['m_ts']),'</a>']);
                    msg.SendHTML('</span></p>');
                    msg.Include('dObjTokRef.xxmi',[id,'','','<p class="objectinfo">','</p>'],[qr1]);
                    msg.SendHTML('</div>');

                    if not dryrun then
                      Session.DbCon.Insert('Umi',['usr_id',users[users_i].id,'obj_id',id]);
                    inc(c1);
                    qs1:=qr1.Read;
                   end
                  else
                   begin
                    //report
                    id:=qr2.GetInt('obj_id');
                    d:=TermDomains[id];
                    if d=-1 then
                     begin
                      d:=TermStore.GetDomainID(id);
                      TermDomains[id]:=d;
                     end;
                    msg.SendHTML(['<div style="margin-left: 4em; border-right: 3px dotted #8080FF;">',
                      '<p class="reportheader"><a href="Item.xxm?x=i',qr2['uid'],'" title="',HTMLEncode(qr2.GetStr('usrtypename')),'">',txImg(qr2.GetInt('usricon')),' ',HTMLEncode(qr2.GetStr('usrname')),'</a>',
                      '&nbsp;<span class="date">reported on ',NiceDateTime(qr2['ts']),'</span>&nbsp;']);
                    pid:=qr2.GetInt('pid');
                    s:='';
                    while pid<>0 do
                     begin
                      ln:=LocationCache[pid] as TLocationNode;
                      if ln=nil then ln:=LocationCache.Add(pid,TLocationNode.Create(itObj,pid)) as TLocationNode;
                      s:=ln.GetHTML([ghLink,ghIcon,ghTitle],pid)+s;
                     end;
                    msg.SendHTML(s);
                    msg.SendHTML([#13#10'<a href="Item.xxm?x=i',id,'&amp;hr=',qr2['id'],'" title="',HTMLEncode(qr2.GetStr('typename')),'">',txImg(qr2.GetInt('icon')),' ',HTMLEncode(qr2.GetStr('name')),'</a>']);
                    msg.SendHTML('</p>');

                    //TODO: path of obj_id?
                    if not(qr2.IsNull('tokicon')) then
                     begin
                      s:=qr2.GetStr('toksystem');
                      if (s<>'') and (s[1]=':') then
                        msg.SendHTML(['<p>',lblTokens,
                        '<a href="Log.xxm?filter=tt',qr2['toktype_id'],'*" title="',HTMLEncode(qr2.GetStr('tokname')),'"><img src="img/cat_',Copy(s,2,Length(s)-1),'.png" width="54" height="16" alt="',HTMLEncode(qr2.GetStr('tokname')),'" ',globalIconAlign,'/></a>',
                        '</p>'])
                      else
                        msg.SendHTML(['<p>',lblTokens,
                        txImg(qr2['tokicon']),
                        HTMLEncode(qr2.GetStr('tokname')),
                        '</p>']);
                     end;
                    if not(qr2.IsNull('reficon')) then
                      msg.SendHTML(['<p>',lblReferences,
                      txImg(qr2['reficon']),
                      HTMLEncode(qr2.GetStr('refname')),
                      '</p>']);
                    msg.SendHTML(TermStore.TermLinks(itObj,id,d,qr2.GetStr('desc')));
                    if not(qr2.IsNull('relicon')) then
                      msg.SendHTML(['<p><a href="Item.xxm?x=i',qr2['obj2_id'],'" title="',HTMLEncode(qr2.GetStr('reltypename')),'">',txImg(qr2['relicon']),' ',HTMLEncode(qr2.GetStr('relname')),'</a></p>']);
                    msg.SendHTML('</div>');

                    if not dryrun then
                      Session.DbCon.Insert('Umr',['usr_id',users[users_i].id,'rpt_id',qr2['id']]);
                    inc(c2);
                    qs2:=qr2.Read;
                   end;
                 end;

                Context.SendHTML(['  i#',c1,' r#',c2,' [ms] user:',GetTimerDeltaMS(tc1,tc2),' filter:',GetTimerDeltaMS(tc2,tc3),' query:',GetTimerDeltaMS(tc3,tc4),' build:',GetTimerIndexMS(tc4)]);
                if not((c1=0) and (c2=0)) then
                 begin
                  msg.SendHTML([#13#10'<p class="midnav"><span class="date">',
                    '<a href="Item.xxm?x=i'+IntToStr(users[users_i].id)+'">user</a>:',GetTimerDeltaMS(tc1,tc2),'ms, ',
                    '<a href="FilterBuild.xxm?filter='+fsu+'">filter</a>:',GetTimerDeltaMS(tc2,tc3),'ms, ',
                    '<a href="Filter.xxm?filter='+fsu+'">query</a>:',GetTimerDeltaMS(tc3,tc4),'ms, ',
                    '<a href="Log.xxm?filter='+fsu+'">build</a>:',GetTimerIndexMS(tc4),'ms',
                    '</span></p>',
                    #13#10'</body></html>'#13#10]);

                  tc1:=GetTimerIndex;
                  mm:=AnsiString('Subject: '+msgSubject+users[users_i].subject+
                    #13#10'To: "'+users[users_i].name+'" <'+users[users_i].email+'>'+
                    #13#10'From: '+msgFrom)+
                    ProcessImages(AnsiString(msgURL+'Log.xxm?filter='+fsu),UTF8Encode(msg.Result));
                  if dryrun then
                    Context.SendHTML([' dry-run:',GetTimerIndexMS(tc1),' [bytes] ',Length(mm)])
                  else
                   begin
                    ff:=TFileStream.Create(EmailPickupFolder+'\txUpdate'+IntToStr(users[users_i].id)+'_'+FormatDateTime('yyyymmddhhnnss',Now)+'.eml',fmCreate);
                    try
                      ff.Write(mm[1],Length(mm));
                    finally
                      ff.Free;
                    end;
                    Context.SendHTML([' output:',GetTimerIndexMS(tc1),' [bytes] ',Length(mm)]);
                   end;
                 end;
                Context.SendHTML(#13#10);

              finally
                qr1.Free;
                qr2.Free;
                LocationCache.Free;
                TermDomains.Free;
                msg.Free;
              end;
              if dryrun then
                Session.DbCon.RollbackTrans
              else
                Session.DbCon.CommitTrans;
            except
              Session.DbCon.RollbackTrans;
              raise;
            end;

          except
            on e:Exception do
              Context.SendHTML('EXCEPTION!!!'#13#10+e.Message+#13#10#13#10);
          end;
       end;
     end;

    inc(sl_i);
   end;
finally
  sl.Free;
  Session.Abandon;//kill session, was used for several LoadUser calls, don't use for other requests
end;
Context.SendHTML('---'#13#10);