1 files changed, 643 insertions, 0 deletions
diff --git a/popimapunit.pas b/popimapunit.pas
new file mode 100644
index 0000000..0625c3e
--- /dev/null
+++ b/popimapunit.pas
@@ -0,0 +1,643 @@
+unit popimapunit;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, mystringlistunit, process;
+
+type
+
+  tMarkenValiditaet = (mvKeine,mvGueltig,mvUngueltig);
+  tBefehlAusfuehrenErgebnis = (baeOk,baeError,baeTimeOut);
+
+  tPopClient = class;
+
+  tNachricht = class(tMyStringList)
+  private
+    _marke: tMarkenValiditaet;
+    procedure pruefeMarke;
+    function rMarke: tMarkenValiditaet;
+  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;
+  end;
+
+  tPopThread = class(tThread)
+  private
+    _beendet:                   boolean;
+    _sshUser,_host,_user,_pass: string;
+    _port:                      longint;
+    _besitzer:                  tPopClient;
+    _nachrichten:               array of tNachricht;
+    _lIds:                      array of longint;
+    procedure datenRausGeben;
+    procedure datenReinNehmen;
+    procedure auszenWeltBenachrichtigung;
+    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;
+    _sdbName:     string;
+    _nachrichten: array of tNachricht;
+    _lIds:        array of longint;
+  public
+    sshUser,host,user,pass,gueltigerAdressat: 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;
+
+function readString(p: tProcess): string;
+procedure writeString(p: tProcess; s: string);
+function befehlAusfuehren(var pr: tProcess; bef: string; timeOut: extended): tBefehlAusfuehrenErgebnis; overload; inline;
+function befehlAusfuehren(var pr: tProcess; bef: string; timeOut: extended; out ausg: string): tBefehlAusfuehrenErgebnis; overload; inline;
+function befehlAusfuehren(var pr: tProcess; bef,ende: string; timeOut: extended; out ausg: string): tBefehlAusfuehrenErgebnis; overload;
+
+procedure _app(var f: text); inline;
+
+implementation
+
+uses lowlevelunit, systemunit;
+
+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 p.running and (i<=length(s)) do
+    i:=i+p.input.write(s[i],length(s)-i+1);
+end;
+
+function befehlAusfuehren(var pr: tProcess; bef: string; timeOut: extended): tBefehlAusfuehrenErgebnis;
+var
+  dummy: string;
+begin
+  result:=befehlAusfuehren(pr,bef,timeOut,dummy);
+end;
+
+function befehlAusfuehren(var pr: tProcess; bef: string; timeOut: extended; out ausg: string): tBefehlAusfuehrenErgebnis;
+begin
+  result:=befehlAusfuehren(pr,bef,'+OK',timeOut,ausg);
+end;
+
+function befehlAusfuehren(var pr: tProcess; bef,ende: string; timeOut: extended; out ausg: string): tBefehlAusfuehrenErgebnis;
+var
+  zeit: extended;
+begin
+  writeString(pr,bef+#10);
+
+  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;
+    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;
+
+// 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;
+
+function tNachricht.rMarke: tMarkenValiditaet;
+begin
+  pruefeMarke;
+  result:=_marke;
+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;
+
+// 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);
+  fillchar(_lIds,sizeOf(_lIds),#0);
+  setLength(_lIds,0);
+  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);
+  setLength(_lIds,0);
+  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 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 tPopThread.auszenWeltBenachrichtigung;
+begin
+  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;
+  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 tPopThread.auszenWeltKontakt(var pr: tProcess);
+var
+  i,j,k: longint;
+begin
+  synchronize(@datenReinNehmen);
+
+  if assigned(pr) then begin
+    for i:=0 to length(_lIds)-1 do begin
+      case befehlAusfuehren(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;
+
+      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;
+
+procedure tPopThread.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 assigned(pr) then begin
+        if befehlAusfuehren(pr,'QUIT',_besitzer.timeOut)=baeOk then
+          pr.waitOnExit;
+
+        pr.free;
+        pr:=nil;
+
+        if beenden then
+          break;
+      end;
+
+      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;
+
+      if befehlAusfuehren(pr,'USER '+_user,_besitzer.timeOut)<>baeOk then
+        continue;
+
+      if beenden then
+        break;
+
+      if befehlAusfuehren(pr,'PASS '+_pass,_besitzer.timeOut)<>baeOk then
+        continue;
+
+      if beenden then
+        break;
+
+      if befehlAusfuehren(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;
+      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 befehlAusfuehren(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;
+          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 do begin
+        zeit:=now+1/24/60/6;
+        if befehlAusfuehren(pr,'NOOP',10)<>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 befehlAusfuehren(pr,'QUIT',_besitzer.timeOut)=baeOk then
+      pr.waitOnExit;
+
+    pr.free;
+    pr:=nil;
+  end;
+  _beendet:=true;
+end;
+
+// tPopClient ******************************************************************
+
+constructor tPopClient.create;
+begin
+  inherited create;
+  sshUser:='';
+  user:='';
+  pass:='';
+  host:='';
+  _sdbName:=mkTemp('/tmp/Emails-hashcash.sdb.XXXXXX');
+  gueltigerAdressat:='';
+  port:=0;
+  timeOut:=10;
+  setLength(_nachrichten,0);
+  neueNachrichten:=nil;
+  fillchar(_lIds,sizeOf(_lIds),#0);
+  setLength(_lIds,0);
+  _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);
+  setLength(_lIds,0);
+  if fileExists(_sdbName) then
+    deleteFile(_sdbName);
+  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;
+begin
+  result:=_nachrichten[n].marke;
+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
+  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 tPopClient.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.
+