unit popimapunit; {$mode objfpc}{$H+} interface uses Classes, SysUtils, mystringlistunit, process; type tMarkenValiditaet = (mvKeine,mvGueltig,mvUngueltig); tBefehlAusfuehrenErgebnis = (baeOk,baeError,baeTimeOut); tMailProtocol = (mpPop, mpImap); tPopImapClient = 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; 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; 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); 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; 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 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)); 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; 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; // 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: begin 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; 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; 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}; 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) 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) 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])',_besitzer.timeOut,buf)<>baeOk then break; if beenden then break; if not startetMit('* '+intToStr(_nachrichten[i].id)+' FETCH (BODY[HEADER] {',buf,false) then break; _nachrichten[i].groesze:=strToInt(erstesArgument(buf,'}',false)); if not startetMit(#13#10,buf,false) then break; _nachrichten[i].text:=copy(buf,1,_nachrichten[i].groesze); delete(buf,1,_nachrichten[i].groesze); if not startetMit(' BODY[TEXT] {',buf,false) then break; j:=strToInt(erstesArgument(buf,'}',false)); if not startetMit(#13#10,buf,false) then break; _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 break; if buf<>'' then break; 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 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; 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.