From 44fb734adb505a12298db20853012b357c9661c0 Mon Sep 17 00:00:00 2001 From: Erich Eckner Date: Fri, 5 Apr 2019 14:16:58 +0200 Subject: popimapunit.pas: nun wirklich mit imap --- popimapunit.pas | 451 ++++++++++++++++++++++++++++++++++++++------------------ 1 file changed, 308 insertions(+), 143 deletions(-) diff --git a/popimapunit.pas b/popimapunit.pas index 0625c3e..5461792 100644 --- a/popimapunit.pas +++ b/popimapunit.pas @@ -11,8 +11,9 @@ type tMarkenValiditaet = (mvKeine,mvGueltig,mvUngueltig); tBefehlAusfuehrenErgebnis = (baeOk,baeError,baeTimeOut); + tMailProtocol = (mpPop, mpImap); - tPopClient = class; + tPopImapClient = class; tNachricht = class(tMyStringList) private @@ -30,36 +31,42 @@ type read rMarke; end; - tPopThread = class(tThread) + tPopImapThread = class(tThread) private _beendet: boolean; _sshUser,_host,_user,_pass: string; _port: longint; - _besitzer: tPopClient; + _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: tPopClient); + constructor create(besitzer: tPopImapClient); destructor destroy; override; procedure execute; override; end; - tPopClient = class + tPopImapClient = class private - _thread: tPopThread; + _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; @@ -77,9 +84,11 @@ type 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; +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; @@ -89,6 +98,7 @@ uses lowlevelunit, systemunit; const extraLen = 1024; + willkommensnachricht: array[tMailProtocol] of string = ('+OK', '* OK'); function readString(p: tProcess): string; var @@ -112,19 +122,19 @@ begin i:=i+p.input.write(s[i],length(s)-i+1); end; -function befehlAusfuehren(var pr: tProcess; bef: string; timeOut: extended): tBefehlAusfuehrenErgebnis; +function popBefehlAusfuehren(var pr: tProcess; bef: string; timeOut: extended): tBefehlAusfuehrenErgebnis; var dummy: string; begin - result:=befehlAusfuehren(pr,bef,timeOut,dummy); + result:=popBefehlAusfuehren(pr,bef,timeOut,dummy); end; -function befehlAusfuehren(var pr: tProcess; bef: string; timeOut: extended; out ausg: string): tBefehlAusfuehrenErgebnis; +function popBefehlAusfuehren(var pr: tProcess; bef: string; timeOut: extended; out ausg: string): tBefehlAusfuehrenErgebnis; begin - result:=befehlAusfuehren(pr,bef,'+OK',timeOut,ausg); + result:=popBefehlAusfuehren(pr,bef,'+OK',timeOut,ausg); end; -function befehlAusfuehren(var pr: tProcess; bef,ende: string; timeOut: extended; out ausg: string): tBefehlAusfuehrenErgebnis; +function popBefehlAusfuehren(var pr: tProcess; bef,ende: string; timeOut: extended; out ausg: string): tBefehlAusfuehrenErgebnis; var zeit: extended; begin @@ -152,6 +162,49 @@ begin 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; @@ -251,9 +304,9 @@ begin result:=(text=n.text) and (id=n.id) and (groesze=n.groesze); end; -// tPopThread ****************************************************************** +// tPopImapThread ************************************************************** -constructor tPopThread.create(besitzer: tPopClient); +constructor tPopImapThread.create(besitzer: tPopImapClient); begin inherited create(true); _besitzer:=besitzer; @@ -270,7 +323,7 @@ begin suspended:=false; end; -destructor tPopThread.destroy; +destructor tPopImapThread.destroy; var i: longint; begin @@ -284,7 +337,7 @@ begin inherited destroy; end; -procedure tPopThread.datenRausGeben; +procedure tPopImapThread.datenRausGeben; var neu: boolean; i: longint; @@ -306,13 +359,13 @@ begin end; end; -procedure tPopThread.auszenWeltBenachrichtigung; +procedure tPopImapThread.auszenWeltBenachrichtigung; begin if assigned(_besitzer.neueNachrichten) then _besitzer.neueNachrichten(_besitzer); end; -procedure tPopThread.datenReinNehmen; +procedure tPopImapThread.datenReinNehmen; begin if beenden then exit; @@ -321,46 +374,64 @@ begin _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 tPopThread.auszenWeltKontakt(var pr: tProcess); +procedure tPopImapThread.auszenWeltKontakt(var pr: tProcess); var i,j,k: longint; + s: string; 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; + 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{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; + 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; + end{of case}; setLength(_lIds,0); esGibtArbeit:=false; @@ -369,7 +440,45 @@ begin synchronize(@datenRausGeben) end; -procedure tPopThread.execute; +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; @@ -383,93 +492,120 @@ begin 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 + if (_mailProtocol = mpPop) and assigned(pr) then begin + if doLogout(pr)=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 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; - 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 (lenbaeOk 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; - if len>=length(_nachrichten) then begin - setLength(_nachrichten,len+extraLen); - for i:=len to length(_nachrichten)-1 do - _nachrichten[i]:=nil; + 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; - _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{of case}; + for i:=len to length(_nachrichten)-1 do _nachrichten[i].free; setLength(_nachrichten,len); @@ -479,16 +615,44 @@ begin 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; + 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]); @@ -509,7 +673,7 @@ begin zeit:=now; for i:=0 to 5 do begin zeit:=now+1/24/60/6; - if befehlAusfuehren(pr,'NOOP',10)<>baeOk then + if doNOOP(pr)<>baeOk then break; while (not beenden) and (zeit>now) and (not esGibtArbeit) do @@ -522,7 +686,7 @@ begin sleep(10); end; if assigned(pr) then begin - if befehlAusfuehren(pr,'QUIT',_besitzer.timeOut)=baeOk then + if doLogout(pr)=baeOk then pr.waitOnExit; pr.free; @@ -531,9 +695,9 @@ begin _beendet:=true; end; -// tPopClient ****************************************************************** +// tPopImapClient ************************************************************** -constructor tPopClient.create; +constructor tPopImapClient.create; begin inherited create; sshUser:=''; @@ -543,15 +707,16 @@ begin _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:=tPopThread.create(self); + _thread:=tPopImapThread.create(self); end; -destructor tPopClient.destroy; +destructor tPopImapClient.destroy; var i: longint; begin @@ -565,46 +730,46 @@ begin inherited destroy; end; -function tPopClient.nAnz: longint; +function tPopImapClient.nAnz: longint; begin result:=length(_nachrichten); end; -function tPopClient.betreff(n: longint): string; +function tPopImapClient.betreff(n: longint): string; begin result:=_nachrichten[n].grepFirst('^Subject:\s'); erstesArgument(result,':'); end; -function tPopClient.von(n: longint): string; +function tPopImapClient.von(n: longint): string; begin result:=_nachrichten[n].grepFirst('^From:\s'); erstesArgument(result,':'); end; -function tPopClient.zeit(n: longint): string; +function tPopImapClient.zeit(n: longint): string; begin result:=_nachrichten[n].grepFirst('^Date:\s'); erstesArgument(result,':'); end; -function tPopClient.marke(n: longint): tMarkenValiditaet; +function tPopImapClient.marke(n: longint): tMarkenValiditaet; begin result:=_nachrichten[n].marke; end; -procedure tPopClient.threadAnhalten; +procedure tPopImapClient.threadAnhalten; begin _thread.beenden:=true; end; -procedure tPopClient.aufThreadWarten; +procedure tPopImapClient.aufThreadWarten; begin while not _thread.beendet do sleep(10); end; -procedure tPopClient.loesche(n: longint); +procedure tPopImapClient.loesche(n: longint); var i: longint; begin @@ -619,7 +784,7 @@ begin neueNachrichten(self); end; -procedure tPopClient.loeschen; +procedure tPopImapClient.loeschen; var i: longint; begin -- cgit v1.2.3-54-g00ecf