path: root/popimapunit.pas

unit popimapunit;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, mystringlistunit, process;

type

  tMarkenValiditaet = (mvKeine,mvGueltig,mvUngueltig);
  tBefehlAusfuehrenErgebnis = (baeOk,baeError,baeTimeOut);
  tMailProtocol = (mpPop, mpImap);
  tSpamLevel = (slSpam,slHam,slUnbekannt);

  tPopImapClient = class;

  tNachricht = class(tMyStringList)
  private
    _marke: tMarkenValiditaet;
    _spam:  tSpamLevel;
    procedure pruefeMarke;
    procedure pruefeSpam;
    function rMarke: tMarkenValiditaet;
    function rSpam: tSpamLevel;
  public
    id,groesze:                longint;
    sdbName,gueltigerAdressat: string;
    constructor create;
    destructor destroy; override;
    procedure kopiereVon(n: tNachricht);
    function istGleich(n: tNachricht): boolean;
    property marke: tMarkenValiditaet
      read rMarke;
    property spam: tSpamLevel
      read rSpam;
  end;

  tPopImapThread = class(tThread)
  private
    _beendet:                   boolean;
    _sshUser,_host,_user,_pass: string;
    _port:                      longint;
    _mailProtocol:              tMailProtocol;
    _besitzer:                  tPopImapClient;
    _nachrichten:               array of tNachricht;
    _lIds:                      array of longint;
    procedure datenRausGeben;
    procedure datenReinNehmen;
    procedure auszenWeltBenachrichtigung;
    procedure auszenWeltKontakt(var pr: tProcess);

    function doLogin(pr: tProcess): tBefehlAusfuehrenErgebnis;
    function doLogout(pr: tProcess): tBefehlAusfuehrenErgebnis;
    function doNOOP(pr: tProcess): tBefehlAusfuehrenErgebnis;
  public
    beenden,esGibtArbeit: boolean;
    property beendet: boolean
      read _beendet;
    constructor create(besitzer: tPopImapClient);
    destructor destroy; override;
    procedure execute; override;
  end;

  tPopImapClient = class
  private
    _thread:      tPopImapThread;
    _sdbName:     string;
    _nachrichten: array of tNachricht;
    _lIds:        array of longint;
  public
    sshUser,host,user,pass,gueltigerAdressat: string;
    port:                                     longint;
    mailProtocol:                             tMailProtocol;
    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;
    function spam(n: longint): tSpamLevel;
    procedure threadAnhalten;
    procedure aufThreadWarten;
    procedure loesche(n: longint);
    procedure loeschen;
  end;

function readString(p: tProcess): string;
procedure writeString(p: tProcess; s: string);
function popBefehlAusfuehren(var pr: tProcess; bef: string; timeOut: extended): tBefehlAusfuehrenErgebnis; overload; inline;
function popBefehlAusfuehren(var pr: tProcess; bef: string; timeOut: extended; out ausg: string): tBefehlAusfuehrenErgebnis; overload; inline;
function popBefehlAusfuehren(var pr: tProcess; bef,ende: string; timeOut: extended; out ausg: string): tBefehlAusfuehrenErgebnis; overload;
function imapBefehlAusfuehren(var pr: tProcess; bef: string; timeOut: extended): tBefehlAusfuehrenErgebnis; overload; inline;
function imapBefehlAusfuehren(var pr: tProcess; bef: string; timeOut: extended; out ausg: string): tBefehlAusfuehrenErgebnis; overload; inline;

procedure _app(var f: text); inline;

implementation

uses lowlevelunit, systemunit;

const
  extraLen = 1024;
  willkommensnachricht: array[tMailProtocol] of string = ('+OK', '* OK');

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 p.running and (i<=length(s)) do
    i:=i+p.input.write(s[i],length(s)-i+1);
end;

function popBefehlAusfuehren(var pr: tProcess; bef: string; timeOut: extended): tBefehlAusfuehrenErgebnis;
var
  dummy: string;
begin
  result:=popBefehlAusfuehren(pr,bef,timeOut,dummy);
end;

function popBefehlAusfuehren(var pr: tProcess; bef: string; timeOut: extended; out ausg: string): tBefehlAusfuehrenErgebnis;
begin
  result:=popBefehlAusfuehren(pr,bef,'+OK',timeOut,ausg);
end;

function popBefehlAusfuehren(var pr: tProcess; bef,ende: string; timeOut: extended; out ausg: string): tBefehlAusfuehrenErgebnis;
var
  zeit: extended;
begin
  writeString(pr,bef+#10);
  {$IFDEF DEBUG}
  writeln(stderr, '>> ' + bef);
  {$ENDIF}

  zeit:=now+timeOut/24/60/60;
  ausg:='';
  while (zeit>now) and (pos(ende,ausg)=0) and (pos('-ERR',ausg)=0) do
    ausg:=ausg+readString(pr);

  if pos(ende,ausg)>0 then begin
    result:=baeOk;
    {$IFDEF DEBUG}
    writeln(stderr, '<< ' + copy(ausg, 1, 80));
    {$ENDIF}
    exit;
  end;

  if pos('-ERR',ausg)>0 then begin
    writeln(stderr,bef+' fehlgeschlagen (Antwort: '''+ausg+''')!');
    result:=baeError;
    exit;
  end;

  writeln(stderr,bef+' fehlgeschlagen (timeout erreicht)!');
  pr.free;
  pr:=nil;
  result:=baeTimeOut;
end;

function imapBefehlAusfuehren(var pr: tProcess; bef: string; timeOut: extended): tBefehlAusfuehrenErgebnis;
var
  dummy: string;
begin
  result:=imapBefehlAusfuehren(pr,bef,timeOut,dummy);
end;

function imapBefehlAusfuehren(var pr: tProcess; bef: string; timeOut: extended; out ausg: string): tBefehlAusfuehrenErgebnis;
var
  zeit: extended;
  i:    longint;
  id:   string;
const
  chars = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789';
begin
  {$IFDEF DEBUG}
  writeln(stderr, '>> ' + bef);
  {$ENDIF}
  id:='';
  for i:=0 to 15 do
    id:=id + chars[random(length(chars))];
  writeString(pr,id+' '+bef+#10);

  zeit:=now+timeOut/24/60/60;
  ausg:='';
  while (zeit>now) and (pos(id+' OK',ausg)=0) and (pos(id+' NO',ausg)=0) do
    ausg:=ausg+readString(pr);

  if pos(id+' OK',ausg)>0 then begin
    result:=baeOk;
    delete(ausg, pos(id+' OK',ausg), length(ausg));
    {$IFDEF DEBUG}
    writeln(stderr, '<< ' + copy(ausg, 1, 80));
    {$ENDIF}
    exit;
  end;

  if pos(id+' NO',ausg)>0 then begin
    writeln(stderr,bef+' fehlgeschlagen (Antwort: '''+ausg+''')!');
    result:=baeError;
    exit;
  end;

  writeln(stderr,bef+' fehlgeschlagen (timeout erreicht)!');
  pr.free;
  pr:=nil;
  result:=baeTimeOut;
end;

// tNachricht ******************************************************************

constructor tNachricht.create;
begin
  inherited create;
  id:=-1;
  groesze:=-1;
  _marke:=mvKeine;
  fillchar(gueltigerAdressat,sizeOf(gueltigerAdressat),#0);
  gueltigerAdressat:='';
  fillchar(sdbName,sizeOf(sdbName),#0);
  sdbName:='';
end;

destructor tNachricht.destroy;
begin
  gueltigerAdressat:='';
  sdbName:='';
  inherited destroy;
end;

procedure tNachricht.pruefeMarke;
var
  pr: tProcess;
  f:  textFile;
begin
  if grepFirst('^[Xx]-[Hh]ash[Cc]ash:\s')='' then begin
    _marke:=mvKeine;
    exit;
  end;

  if _marke<>mvKeine then
    exit;

  if sdbName='' then
    raise exception.create('sdbName noch nicht gesetzt!');

  pr:=tProcess.create(nil);
  pr.executable:='hashcash';
  pr.parameters.add('-c'); // Prüfen
  pr.parameters.add('-X'); // Header-Format
  pr.parameters.add('-b'); // Bits
  pr.parameters.add('20');
  pr.parameters.add('-d'); // mit Datenbank
  pr.parameters.add('-f'); // an folgendem Ort:
  pr.parameters.add(sdbName);
  pr.parameters.add('-E'); // mit Regex
  pr.parameters.add('-r'); // gültige Rezipienten
  pr.parameters.add(gueltigerAdressat);

  pr.options:=[poUsePipes];
  pr.execute;

  writeString(pr,text);
  pr.closeInput;
  while pr.running or (pr.output.numBytesAvailable>0) do
    readString(pr);
  pr.closeOutput;

  case pr.exitStatus of
    0:
      _marke:=mvGueltig;
    else
      _marke:=mvUngueltig;
  end;

  pr.free;
  assignFile(f,'/tmp/email-log');
  if fileExists('/tmp/email-log') then
    _app(f)
  else
    rewrite(f);
  writeln(f,dateTimeToStr(now));
  writeln(f,grepFirst('^[Xx]-[Hh]ash[Cc]ash:\s'));
  writeln(f,_marke);
  closeFile(f);
end;

procedure tNachricht.pruefeSpam;
var
  s: string;
begin
  s:=grepFirst('^[Xx]-Spam-Status:\s');
  if s='' then begin
    _spam:=slUnbekannt;
    exit;
  end;

  if _spam<>slUnbekannt then
    exit;
  erstesArgument(s,':');
  if erstesArgument(s,',')='No' then
    _spam:=slHam
  else
    _spam:=slSpam;
end;

function tNachricht.rMarke: tMarkenValiditaet;
begin
  pruefeMarke;
  result:=_marke;
end;

function tNachricht.rSpam: tSpamLevel;
begin
  pruefeSpam;
  result:=_spam;
end;

procedure tNachricht.kopiereVon(n: tNachricht);
begin
  text:=n.text;
  id:=n.id;
  groesze:=n.groesze;
  _marke:=n.marke;
  gueltigerAdressat:=n.gueltigerAdressat;
  sdbName:=n.sdbName;
end;

function tNachricht.istGleich(n: tNachricht): boolean;
begin
  result:=(text=n.text) and (id=n.id) and (groesze=n.groesze);
end;

// tPopImapThread **************************************************************

constructor tPopImapThread.create(besitzer: tPopImapClient);
begin
  inherited create(true);
  _besitzer:=besitzer;
  beenden:=false;
  esGibtArbeit:=false;
  _beendet:=false;
  _sshUser:='';
  _user:='';
  _pass:='';
  _host:='';
  setLength(_nachrichten,0);
  fillchar(_lIds,sizeOf(_lIds),#0);
  setLength(_lIds,0);
  suspended:=false;
end;

destructor tPopImapThread.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);
  setLength(_lIds,0);
  inherited destroy;
end;

procedure tPopImapThread.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 not _nachrichten[i].istGleich(_besitzer._nachrichten[i]);
  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]:=tNachricht.create;
      _besitzer._nachrichten[i].kopiereVon(_nachrichten[i]);
    end;
  end;
end;

procedure tPopImapThread.auszenWeltBenachrichtigung;
begin
  if assigned(_besitzer.neueNachrichten) then
    _besitzer.neueNachrichten(_besitzer);
end;

procedure tPopImapThread.datenReinNehmen;
begin
  if beenden then
    exit;
  _sshUser:=_besitzer.sshUser;
  _user:=_besitzer.user;
  _pass:=_besitzer.pass;
  _host:=_besitzer.host;
  _port:=_besitzer.port;
  _mailProtocol:=_besitzer.mailProtocol;
  setLength(_lIds,length(_besitzer._lIds));
  if length(_lIds)>0 then
    move(_besitzer._lIds[0],_lIds[0],sizeOf(_lIds[0])*length(_lIds));
  setLength(_besitzer._lIds,0);
end;

procedure tPopImapThread.auszenWeltKontakt(var pr: tProcess);
var
  i,j,k: longint;
  s:     string;
begin
  synchronize(@datenReinNehmen);

  if assigned(pr) then begin
    case _mailProtocol of
      mpPop:
        for i:=0 to length(_lIds)-1 do begin
          case popBefehlAusfuehren(pr,'DELE '+intToStr(_lIds[i]),_besitzer.timeOut) of
            baeTimeOut: exit;
            baeError: begin
              if beenden then exit;
              continue;
            end;
          end{of case};
          if beenden then
            exit;
        end;
      mpImap: begin
        s:='';
        for i:=0 to length(_lIds)-1 do
          s:=s+intToStr(_lIds[i])+',';
        delete(s,length(s),1);
        if length(_lIds)>0 then begin
          if imapBefehlAusfuehren(pr,'STORE '+s+' +FLAGS \Deleted',_besitzer.timeOut)<>baeOk then
            exit;
          if beenden then
            exit;
          if imapBefehlAusfuehren(pr,'EXPUNGE',_besitzer.timeOut)<>baeOk then
            exit;
        end;
      end;
    end{of case};

    for i:=0 to length(_lIds)-1 do begin
      for j:=length(_nachrichten)-1 downto 0 do
        if _nachrichten[j].id=_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 '+intToStr(_lIds[i])+' fehlgeschlagen - ich habe die Nachricht nicht bei mir gefunden!');
          exit;
        end;
    end;

    setLength(_lIds,0);
    esGibtArbeit:=false;
  end;

  synchronize(@datenRausGeben);
end;

function tPopImapThread.doLogin(pr: tProcess): tBefehlAusfuehrenErgebnis;
begin
  case _mailProtocol of
    mpPop: begin
      result:=popBefehlAusfuehren(pr,'USER '+_user,_besitzer.timeOut);
      if result<>baeOk then
        exit;
      if beenden then begin
        result:=baeTimeOut;
        exit;
      end;
      result:=popBefehlAusfuehren(pr,'PASS '+_pass,_besitzer.timeOut);
    end;
    mpImap:
      result:=imapBefehlAusfuehren(pr,'LOGIN ' + _user + ' ' + _pass,_besitzer.timeOut);
  end{of case};
end;

function tPopImapThread.doLogout(pr: tProcess): tBefehlAusfuehrenErgebnis;
begin
  case _mailProtocol of
    mpPop:
      result:=popBefehlAusfuehren(pr,'QUIT',_besitzer.timeOut);
    mpImap:
      result:=imapBefehlAusfuehren(pr,'LOGOUT',_besitzer.timeOut);
  end;
end;

function tPopImapThread.doNOOP(pr: tProcess): tBefehlAusfuehrenErgebnis;
begin
  case _mailProtocol of
    mpPop:
      result:=popBefehlAusfuehren(pr,'NOOP',_besitzer.timeOut);
    mpImap:
      result:=imapBefehlAusfuehren(pr,'NOOP',_besitzer.timeOut);
  end;
end;

procedure tPopImapThread.execute;
var
  pr:                 tProcess;
  buf,s:              string;
  zeit:               extended;
  i,j,len,id,groesze: longint;
begin
  pr:=nil;
  for i:=0 to length(_nachrichten)-1 do
    _nachrichten[i].free;
  setLength(_nachrichten,0);
  while not beenden do begin
    auszenWeltKontakt(pr);
    if (_user<>'') and (_host<>'') and (_pass<>'') and (_port<>0) then begin
      if (_mailProtocol = mpPop) and assigned(pr) then begin
        if doLogout(pr)=baeOk then
          pr.waitOnExit;

        pr.free;
        pr:=nil;
      end;

      if beenden then
        break;

      if not assigned(pr) then begin
        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(willkommensnachricht[_mailProtocol], buf)=0) do
          buf:=buf+readString(pr);

        if pos(willkommensnachricht[_mailProtocol], buf)=0 then begin
          pr.free;
          pr:=nil;
          writeln(stderr,'Keine Willkommensnachricht!');
          continue;
        end;
        if beenden then
          break;
        if doLogin(pr)<>baeOk then
          continue;
      end;

      if beenden then
        break;

      case _mailProtocol of
        mpPop: begin
          if popBefehlAusfuehren(pr,'LIST',#13#10'.'#13#10,_besitzer.timeOut,buf)<>baeOk then
            continue;
          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);
            id:=strToInt(erstesArgument(s));
            groesze:=strToInt(s);
            if (len<length(_nachrichten)) and
               assigned(_nachrichten[len]) and
               (_nachrichten[len].groesze=groesze) and
               (_nachrichten[len].id=id) 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]:=tNachricht.create;
            _nachrichten[len].id:=id;
            _nachrichten[len].groesze:=groesze;
            _nachrichten[len].gueltigerAdressat:=_besitzer.gueltigerAdressat;
            _nachrichten[len].sdbName:=_besitzer._sdbName;
            inc(len);
          end;
        end;
        mpImap: begin
          if imapBefehlAusfuehren(pr,'SELECT INBOX',_besitzer.timeOut)<>baeOk then
            continue;
          if beenden then
            break;
          if imapBefehlAusfuehren(pr,'SEARCH ALL',_besitzer.timeOut,buf)<>baeOk then
            continue;
          if beenden then
            break;
          erstesArgument(buf, '* SEARCH');
          len:=0;
          while (not beenden) and (buf<>'') do begin
            s:=erstesArgument(buf);
            id:=strToInt(s);
            if (len<length(_nachrichten)) and
               assigned(_nachrichten[len]) and
               (_nachrichten[len].id=id) 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]:=tNachricht.create;
            _nachrichten[len].id:=id;
            _nachrichten[len].gueltigerAdressat:=_besitzer.gueltigerAdressat;
            _nachrichten[len].sdbName:=_besitzer._sdbName;
            inc(len);
          end;
        end;
      end{of case};

      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=0 then begin
          if beenden then
            exit;
          case _mailProtocol of
            mpPop: begin
              if popBefehlAusfuehren(pr,'TOP '+intToStr(_nachrichten[i].id)+' 0',#13#10'.'#13#10,_besitzer.timeOut,buf)<>baeOk then
                break;
              if beenden then
                break;
              buf:=erstesArgument(buf,#13#10'.'#13#10);
              erstesArgument(buf,'.');
              _nachrichten[i].text:=buf;
            end;
            mpImap: begin
              if imapBefehlAusfuehren(pr,'FETCH '+intToStr(_nachrichten[i].id)+' (BODY[HEADER] BODY[TEXT]<0.128>)',_besitzer.timeOut,buf)<>baeOk then
                break;
              if beenden then
                break;
              if not startetMit('* '+intToStr(_nachrichten[i].id)+' FETCH (BODY[HEADER] {',buf,false) then begin
                writeln(stderr, 'syntax-Fehler: Antwort begann nicht mit "* '+intToStr(_nachrichten[i].id)+' FETCH (BODY[HEADER] {"');
                break;
              end;
              s:=erstesArgument(buf,'}',false);
              try
                _nachrichten[i].groesze:=strToInt(s);
              except
                writeln(stderr, 'syntax-Fehler: "'+s+'" (1. Größe) ist kein Integer');
                break;
              end;
              if not startetMit(#13#10,buf,false) then begin
                writeln(stderr, 'syntax-Fehler: Zwischen-"#13#10" fehlt');
                break;
              end;
              _nachrichten[i].text:=copy(buf,1,_nachrichten[i].groesze);
              delete(buf,1,_nachrichten[i].groesze);
              if not startetMit(' BODY[TEXT]<0> {',buf,false) then begin
                writeln(stderr, 'syntax-Fehler: Zwischen-" BODY[TEXT]<0> {" fehlt');
                break;
              end;
              s:=erstesArgument(buf,'}',false);
              try
                j:=strToInt(s);
              except
                writeln(stderr, 'syntax-Fehler: "'+s+'" (2. Größe) ist kein Integer');
                break;
              end;
              if not startetMit(#13#10,buf,false) then begin
                writeln(stderr, 'syntax-Fehler: 2. Zwischen-"#13#10" fehlt');
                break;
              end;
              _nachrichten[i].text:=_nachrichten[i].text + #10 + copy(buf,1,j);
              delete(buf,1,j);
              _nachrichten[i].groesze:=_nachrichten[i].groesze + j;
              if not startetMit(')',buf) then begin
                writeln(stderr, 'syntax-Fehler: End-")" fehlt');
                break;
              end;
              if (buf<>'') and not startetMit('* '+intToStr(_nachrichten[i].id)+' FETCH ',buf) then begin
                writeln(stderr, 'syntax Fehler: zu lange Antwort: "'+buf+'" übrig');
                break;
              end;
            end;
          end{of case};
          for j:=_nachrichten[i].count-1 downto 1 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])+trimLeft(_nachrichten[i][j]);
              _nachrichten[i].delete(j);
            end;
          _nachrichten[i].pruefeMarke;
        end;

      if beenden or not assigned(pr) then
        continue;

      auszenWeltKontakt(pr);
      synchronize(@auszenWeltBenachrichtigung);

      if beenden or not assigned(pr) or esGibtArbeit then
        continue;

      zeit:=now;
      for i:=0 to 5*byte(_mailProtocol = mpPop) do begin
        zeit:=now+1/24/60/6;
        if doNOOP(pr)<>baeOk then
          break;

        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
    if doLogout(pr)=baeOk then
      pr.waitOnExit;

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

// tPopImapClient **************************************************************

constructor tPopImapClient.create;
begin
  inherited create;
  sshUser:='';
  user:='';
  pass:='';
  host:='';
  _sdbName:=mkTemp('/tmp/Emails-hashcash.sdb.XXXXXX');
  gueltigerAdressat:='';
  port:=0;
  mailProtocol:=mpPop;
  timeOut:=10;
  setLength(_nachrichten,0);
  neueNachrichten:=nil;
  fillchar(_lIds,sizeOf(_lIds),#0);
  setLength(_lIds,0);
  _thread:=tPopImapThread.create(self);
end;

destructor tPopImapClient.destroy;
var
  i: longint;
begin
  _thread.free;
  for i:=0 to length(_nachrichten)-1 do
    _nachrichten[i].free;
  setLength(_nachrichten,0);
  setLength(_lIds,0);
  if fileExists(_sdbName) then
    deleteFile(_sdbName);
  inherited destroy;
end;

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

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

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

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

function tPopImapClient.marke(n: longint): tMarkenValiditaet;
begin
  result:=_nachrichten[n].marke;
end;

function tPopImapClient.spam(n: longint): tSpamLevel;
begin
  result:=_nachrichten[n].spam;
end;

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

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

procedure tPopImapClient.loesche(n: longint);
var
  i: longint;
begin
  setLength(_lIds,length(_lIds)+1);
  _lIds[length(_lIds)-1]:=_nachrichten[n].id;
  _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 tPopImapClient.loeschen;
var
  i: longint;
begin
  setLength(_lIds,length(_lIds)+length(_nachrichten));
  for i:=0 to length(_nachrichten)-1 do begin
    _lIds[length(_lIds)-1-i]:=_nachrichten[i].id;
    _nachrichten[i].free;
  end;
  setLength(_nachrichten,0);
  _thread.esGibtArbeit:=true;
  if assigned(neueNachrichten) then
    neueNachrichten(self);
end;

procedure _app(var f: text); inline;
begin
  append(f);
end;

end.