path: root/popunit.pas

unit popunit;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, mystringlistunit, process;

type

  tMarkenValiditaet = (mvKeine,mvGueltig,mvUngueltig);

  tPopClient = class;

  tPopThread = class(tThread)
  private
    _beendet:                   boolean;
    _sshUser,_host,_user,_pass: string;
    _port:                      longint;
    _besitzer:                  tPopClient;
    _nachrichten:               array of tStringList;
    _lIds:                      tStringList;
    procedure datenRausGeben;
    procedure datenReinNehmen;
    procedure auszenWeltKontakt(var pr: tProcess);
  public
    beenden,esGibtArbeit: boolean;
    property beendet: boolean
      read _beendet;
    constructor create(besitzer: tPopClient);
    destructor destroy; override;
    procedure execute; override;
  end;

  tPopClient = class
  private
    _thread:      tPopThread;
    _nachrichten: array of tMyStringList;
    _lIds:        tMyStringList;
  public
    sshUser,host,user,pass: string;
    port:                   longint;
    timeout:                extended;
    neueNachrichten:        tNotifyEvent;
    constructor create;
    destructor destroy; override;
    function nAnz: longint;
    function betreff(n: longint): string;
    function von(n: longint): string;
    function zeit(n: longint): string;
    function marke(n: longint): tMarkenValiditaet;
    procedure threadAnhalten;
    procedure aufThreadWarten;
    procedure loesche(n: longint);
    procedure loeschen;
  end;

implementation

uses lowlevelunit;

const
  extraLen = 1024;

function readString(p: tProcess): string;
var
  len: longint;
begin
  setlength(result,p.output.numBytesAvailable);
  if length(result)>0 then begin
    len:=p.output.read(result[1],length(result));
    setlength(result,len);
  end
  else
    sleep(10);
end;

procedure writeString(p: tProcess; s: string);
var
  i: longint;
begin
  i:=1;
  while i<=length(s) do
    i:=i+p.input.write(s[i],length(s)-i+1);
end;

// tPopThread ******************************************************************

constructor tPopThread.create(besitzer: tPopClient);
begin
  inherited create(true);
  _besitzer:=besitzer;
  beenden:=false;
  esGibtArbeit:=false;
  _beendet:=false;
  _sshUser:='';
  _user:='';
  _pass:='';
  _host:='';
  setlength(_nachrichten,0);
  _lIds:=tStringList.create;
  suspended:=false;
end;

destructor tPopThread.destroy;
var
  i: longint;
begin
  beenden:=true;
  while not beendet do
    sleep(10);
  for i:=0 to length(_nachrichten)-1 do
    _nachrichten[i].free;
  setlength(_nachrichten,0);
  _lIds.free;
  inherited destroy;
end;

procedure tPopThread.datenRausGeben;
var
  neu: boolean;
  i:   longint;
begin
  if beenden then
    exit;
  neu:=length(_besitzer._nachrichten)<>length(_nachrichten);
  if not neu then
    for i:=0 to length(_nachrichten)-1 do
      neu:=neu or (_nachrichten[i].text<>_besitzer._nachrichten[i].text);
  if neu then begin
    for i:=0 to length(_besitzer._nachrichten)-1 do
      _besitzer._nachrichten[i].free;
    setlength(_besitzer._nachrichten,length(_nachrichten));
    for i:=0 to length(_besitzer._nachrichten)-1 do begin
      _besitzer._nachrichten[i]:=tMyStringList.create;
      _besitzer._nachrichten[i].text:=_nachrichten[i].text;
    end;
  end;
  if assigned(_besitzer.neueNachrichten) then
    _besitzer.neueNachrichten(_besitzer);
end;

procedure tPopThread.datenReinNehmen;
begin
  if beenden then
    exit;
  _sshUser:=_besitzer.sshUser;
  _user:=_besitzer.user;
  _pass:=_besitzer.pass;
  _host:=_besitzer.host;
  _port:=_besitzer.port;
  _lIds.text:=_besitzer._lIds.text;
  _besitzer._lIds.clear;
end;

procedure tPopThread.auszenWeltKontakt(var pr: tProcess);
var
  i,j,k: longint;
  zeit:  extended;
  buf:   string;
begin
  synchronize(@datenReinNehmen);

  _lIds.CustomSort(@numerischerVergleich);

  if assigned(pr) then begin
    for i:=_lIds.count-1 downto 0 do begin
      writeString(pr,'DELE '+_lIds[i]+#10);
      writeln(stderr,'DELE '+_lIds[i]);

      zeit:=now+_besitzer.timeout/24/60/60;
      buf:='';
      while (zeit>now) and (pos('+OK',buf)=0) do
        buf:=buf+readString(pr);

      if pos('+OK',buf)=0 then begin
        pr.free;
        pr:=nil;
        writeln(stderr,'DELE '+_lIds[i]+' fehlgeschlagen!');
        exit;
      end;

      if beenden then
        exit;

      for j:=length(_nachrichten)-1 downto 0 do
        if _nachrichten[j][0]=_lIds[i] then begin
          _nachrichten[j].free;
          for k:=j+1 to length(_nachrichten)-1 do
            _nachrichten[k-1]:=_nachrichten[k];
          setlength(_nachrichten,length(_nachrichten)-1);
          break;
        end
        else if j=0 then begin
          pr.free;
          pr:=nil;
          writeln(stderr,'DELE '+_lIds[i]+' fehlgeschlagen - ich habe die Nachricht nicht bei mir gefunden!');
          exit;
        end;
    end;

    _lIds.clear;
    esGibtArbeit:=false;
  end;

  synchronize(@datenRausGeben)
end;

procedure tPopThread.execute;
var
  pr:      tProcess;
  buf,s,t: string;
  zeit:    extended;
  i,j,len: longint;
begin
  pr:=nil;
  while not beenden do begin
    auszenWeltKontakt(pr);
    if (_user<>'') and (_host<>'') and (_pass<>'') and (_port<>0) then begin
      if assigned(pr) then begin
        writeString(pr,'QUIT'#10);

        zeit:=now+_besitzer.timeout/24/60/60;
        buf:='';
        while (zeit>now) and (pos('+OK',buf)=0) do
          buf:=buf+readString(pr);

        if pos('+OK',buf)=0 then begin
          pr.free;
          pr:=nil;
          writeln(stderr,'QUIT fehlgeschlagen!');
        end;

        pr.free;
        pr:=nil;

        if beenden then
          break;
      end;

      for i:=0 to length(_nachrichten)-1 do
        _nachrichten[i].free;
      setlength(_nachrichten,0);

      pr:=tProcess.create(nil);
      if _sshUser<>'' then begin
        pr.executable:='ssh';
        pr.parameters.add(_sshUser+'@'+_host);
        pr.parameters.add('openssl s_client -connect 127.0.0.1:'+inttostr(_port)+' -quiet');
      end
      else begin
        pr.executable:='openssl';
        pr.parameters.add('s_client');
        pr.parameters.add('-connect');
        pr.parameters.add(_host+':'+inttostr(_port));
        pr.parameters.add('-quiet');
      end;
      pr.options:=[poUsePipes];
      pr.execute;
      zeit:=now+_besitzer.timeout/24/60/60;
      buf:='';
      while (zeit>now) and (pos('+OK',buf)=0) do
        buf:=buf+readString(pr);

      if pos('+OK',buf)=0 then begin
        pr.free;
        pr:=nil;
        writeln(stderr,'Keine Willkommensnachricht!');
        continue;
      end;

      if beenden then
        break;

      writeString(pr,'USER '+_user+#10);
      zeit:=now+_besitzer.timeout/24/60/60;
      buf:='';
      while (zeit>now) and (pos('+OK',buf)=0) do
        buf:=buf+readString(pr);

      if pos('+OK',buf)=0 then begin
        pr.free;
        pr:=nil;
        writeln(stderr,'USER fehlgeschlagen!');
        continue;
      end;

      if beenden then
        break;

      writeString(pr,'PASS '+_pass+#10);
      zeit:=now+_besitzer.timeout/24/60/60;
      buf:='';
      while (zeit>now) and (pos('+OK',buf)=0) do
        buf:=buf+readString(pr);

      if pos('+OK',buf)=0 then begin
        pr.free;
        pr:=nil;
        writeln(stderr,'PASS fehlgeschlagen!');
        continue;
      end;

      if beenden then
        break;

      writeString(pr,'LIST'#10);
      zeit:=now+_besitzer.timeout/24/60/60;
      buf:='';
      while (zeit>now) and (pos(#13#10'.'#13#10,buf)=0) do
        buf:=buf+readString(pr);

      if pos(#13#10'.'#13#10,buf)=0 then begin
        pr.free;
        pr:=nil;
        writeln(stderr,'LIST fehlgeschlagen!');
        continue;
      end;

      if beenden then
        break;

      buf:=erstesArgument(buf,#13#10'.'#13#10);
      erstesArgument(buf,'.');

      len:=0;

      while (not beenden) and (buf<>'') do begin
        s:=erstesArgument(buf,#13#10);
        t:=erstesArgument(s);
        if (len<length(_nachrichten)) and
           assigned(_nachrichten[len]) and
           (_nachrichten[len][0]=t) and
           (_nachrichten[len][1]=s) then begin // Nachricht bereits vorhanden
          inc(len);
          continue;
        end;
        if len>=length(_nachrichten) then begin
          setlength(_nachrichten,len+extraLen);
          for i:=len to length(_nachrichten)-1 do
            _nachrichten[i]:=nil;
        end;
        _nachrichten[len]:=tStringList.create;
        _nachrichten[len].Text:=t;
        _nachrichten[len].add(s);
        inc(len);
      end;
      for i:=len to length(_nachrichten)-1 do
        _nachrichten[i].free;
      setlength(_nachrichten,len);

      if beenden then
        break;

      for i:=0 to length(_nachrichten)-1 do
        if _nachrichten[i].count=2 then begin
          writeString(pr,'TOP '+_nachrichten[i][0]+' 0'#10);

          zeit:=now+_besitzer.timeout/24/60/60;
          buf:='';
          while (zeit>now) and (pos(#13#10'.'#13#10,buf)=0) do
            buf:=buf+readString(pr);

          if pos(#13#10'.'#13#10,buf)=0 then begin
            pr.free;
            pr:=nil;
            writeln(stderr,'TOP '+_nachrichten[i][0]+' fehlgeschlagen!');
            break;
          end;

          if beenden then
            break;

          buf:=erstesArgument(buf,#13#10'.'#13#10);
          erstesArgument(buf,'.');

          _nachrichten[i].text:=_nachrichten[i].text + buf;
          for j:=_nachrichten[i].count-1 downto 3 do
            if (length(_nachrichten[i][j])>0) and (_nachrichten[i][j][1] in [' ',#9]) then begin
              _nachrichten[i][j-1]:=trimRight(_nachrichten[i][j-1])+' '+trim(_nachrichten[i][j]);
              _nachrichten[i].delete(j);
            end;
        end;

      if beenden or not assigned(pr) then
        continue;

      auszenWeltKontakt(pr);

      if beenden or not assigned(pr) or esGibtArbeit then begin
        writeln(beenden,' ',assigned(pr),' ',esGibtArbeit);
        continue;
      end;

      zeit:=now;
      for i:=0 to 5 do begin
        writeString(pr,'NOOP'#10);
        zeit:=zeit+1/24/60/6;
        buf:='';
        while (zeit>now) and (pos('+OK',buf)=0) do
          buf:=buf+readString(pr);

        if pos('+OK',buf)=0 then begin
          pr.free;
          pr:=nil;
          writeln(stderr,'NOOP fehlgeschlagen!');
          break;
        end;

        while (not beenden) and (zeit>now) and (not esGibtArbeit) do
          sleep(100);

        if beenden or esGibtArbeit then break;
      end;
    end
    else
      sleep(10);
  end;
  if assigned(pr) then begin
    writeString(pr,'QUIT'#10);

    zeit:=now+_besitzer.timeout/24/60/60;
    buf:='';
    while (zeit>now) and (pos('+OK',buf)=0) do
      buf:=buf+readString(pr);
    if pos('+OK',buf)=0 then
      writeln(stderr,'QUIT fehlgeschlagen!');

    pr.free;
    pr:=nil;
  end;
  _beendet:=true;
end;

// tPopClient ******************************************************************

constructor tPopClient.create;
begin
  inherited create;
  sshUser:='';
  user:='';
  pass:='';
  host:='';
  port:=0;
  timeout:=10;
  setlength(_nachrichten,0);
  neueNachrichten:=nil;
  _lids:=tMyStringList.create;
  _thread:=tPopThread.create(self);
end;

destructor tPopClient.destroy;
var
  i: longint;
begin
  _thread.free;
  for i:=0 to length(_nachrichten)-1 do
    _nachrichten[i].free;
  setlength(_nachrichten,0);
  _lids.free;
  inherited destroy;
end;

function tPopClient.nAnz: longint;
begin
  result:=length(_nachrichten);
end;

function tPopClient.betreff(n: longint): string;
begin
  result:=_nachrichten[n].grepFirst('^Subject:\s');
  erstesArgument(result,':');
end;

function tPopClient.von(n: longint): string;
begin
  result:=_nachrichten[n].grepFirst('^From:\s');
  erstesArgument(result,':');
end;

function tPopClient.zeit(n: longint): string;
begin
  result:=_nachrichten[n].grepFirst('^Date:\s');
  erstesArgument(result,':');
end;

function tPopClient.marke(n: longint): tMarkenValiditaet;
var
  s,erg: string;
  bits:  longint;
  pr:    tProcess;
begin
  s:=_nachrichten[n].grepFirst('^[Xx]-[Hh]ash[Cc]ash:\s');
  if s='' then begin
    result:=mvKeine;
    exit;
  end;
  erstesArgument(s,':');

  pr:=tProcess.create(nil);
  pr.executable:='sha1sum';
  pr.parameters.add('-');
  pr.options:=[poUsePipes];
  pr.execute;

  writeString(pr,s);
  pr.closeInput;
  erg:='';
  while pr.running or (pr.output.numBytesAvailable>0) do
    erg:=erg+readString(pr);
  pr.closeOutput;

  pr.free;

  erstesArgument(s,':');
  bits:=strtoint(erstesArgument(s,':'));
  if bits<20 then begin
    result:=mvKeine;
    exit;
  end;
  erg:=leftStr(erg,(bits+3) div 4);
  result:=mvUngueltig;
  while length(erg)>1 do begin
    if erg[1]<>'0' then
      exit;
    delete(erg,1,1);
  end;
  if (strtoint('$'+erg) shr ((4-bits) mod 4)) <> 0 then
    exit;
  result:=mvGueltig;
end;

procedure tPopClient.threadAnhalten;
begin
  _thread.beenden:=true;
end;

procedure tPopClient.aufThreadWarten;
begin
  while not _thread.beendet do
    sleep(10);
end;

procedure tPopClient.loesche(n: longint);
var
  i: longint;
begin
  _lIds.add(_nachrichten[n][0]);
  _nachrichten[n].free;
  for i:=n+1 to length(_nachrichten)-1 do
    _nachrichten[i-1]:=_nachrichten[i];
  setlength(_nachrichten,length(_nachrichten)-1);
  _thread.esGibtArbeit:=true;
  if assigned(neueNachrichten) then
    neueNachrichten(self);
end;

procedure tPopClient.loeschen;
var
  i: longint;
begin
  for i:=0 to length(_nachrichten)-1 do begin
    _lIds.add(_nachrichten[i][0]);
    _nachrichten[i].free;
  end;
  setlength(_nachrichten,0);
  _thread.esGibtArbeit:=true;
  if assigned(neueNachrichten) then
    neueNachrichten(self);
end;

end.