mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-13 09:49:22 +02:00
Wrap socket Read + Write calls in try except to convert exceptions into a SockErr booleanproperty.
This commit is contained in:
ccrause
parent
e0dea1ca30
commit
50e7383718
@ -70,12 +70,19 @@ type
|
||||
fCS: TRTLCriticalSection;
|
||||
FFileName: string;
|
||||
FOwner: TDbgProcess;
|
||||
// Catch exceptions and store as socket errors
|
||||
FSockErr: boolean;
|
||||
procedure FSetRegisterCacheSize(sz: cardinal);
|
||||
procedure FResetStatusEvent;
|
||||
// Blocking
|
||||
function FWaitForData(): boolean; overload;
|
||||
function FWaitForData(timeout_ms: integer): boolean; overload;
|
||||
|
||||
// Wrappers to catch exceptions and set SockErr
|
||||
function SafeReadByte: byte;
|
||||
function SafeWrite(const buffer; count : Longint): Longint;
|
||||
procedure SafeWriteByte(b: Byte);
|
||||
|
||||
function FReadReply(out retval: string): boolean;
|
||||
function FSendCommand(const cmd: string): boolean;
|
||||
// Send command and wait for acknowledge
|
||||
@ -122,6 +129,7 @@ type
|
||||
property State: integer read FState;
|
||||
property RegisterCacheSize: cardinal write FSetRegisterCacheSize;
|
||||
property lastStatusEvent: TStatusEvent read FStatusEvent;
|
||||
property SockErr: boolean read FSockErr;
|
||||
end;
|
||||
|
||||
var
|
||||
@ -177,6 +185,7 @@ var
|
||||
{$endif}
|
||||
begin
|
||||
Result:=False;
|
||||
if SockErr then exit;
|
||||
{$if defined(unix)}
|
||||
FDS := Default(TFDSet);
|
||||
fpFD_Zero(FDS);
|
||||
@ -203,6 +212,7 @@ var
|
||||
{$endif}
|
||||
begin
|
||||
Result:=False;
|
||||
if SockErr then exit;
|
||||
//{$if defined(unix) or defined(windows)}
|
||||
TimeV.tv_usec := timeout_ms * 1000; // 1 msec
|
||||
TimeV.tv_sec := 0;
|
||||
@ -222,32 +232,55 @@ begin
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
function TRspConnection.SafeReadByte: byte;
|
||||
begin
|
||||
try
|
||||
Result := ReadByte;
|
||||
except
|
||||
FSockErr := true;
|
||||
Result := 0;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TRspConnection.SafeWrite(const buffer; count: Longint): Longint;
|
||||
begin
|
||||
try
|
||||
Result := Write(buffer, count);
|
||||
except
|
||||
FSockErr := true;
|
||||
Result := 0;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TRspConnection.SafeWriteByte(b: Byte);
|
||||
begin
|
||||
try
|
||||
WriteByte(b);
|
||||
except
|
||||
FSockErr := true;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TRspConnection.FSendCommand(const cmd: string): boolean;
|
||||
var
|
||||
checksum: byte;
|
||||
i, totalSent: integer;
|
||||
s: string;
|
||||
begin
|
||||
Result := false;
|
||||
if SockErr then exit;
|
||||
checksum := 0;
|
||||
for i := 1 to length(cmd) do
|
||||
checksum := byte(checksum + ord(cmd[i]));
|
||||
|
||||
s := '$'+cmd+'#'+IntToHex(checksum, 2);
|
||||
totalSent := Write(s[1], length(s));
|
||||
|
||||
// Debugging
|
||||
//system.WriteLn(s);
|
||||
totalSent := SafeWrite(s[1], length(s));
|
||||
|
||||
result := (totalSent = length(s));
|
||||
if not result then
|
||||
begin
|
||||
//WriteLn('* FSendRspCommand error');
|
||||
DebugLn(DBG_WARNINGS, ['Warning: TRspConnection.FSendRspCommand error.'])
|
||||
end
|
||||
else
|
||||
begin
|
||||
DebugLn(DBG_RSP, ['RSP -> ', cmd]);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TRspConnection.FSendCommandOK(const cmd: string): boolean;
|
||||
@ -256,6 +289,7 @@ var
|
||||
retryCount: integer;
|
||||
begin
|
||||
result := false;
|
||||
if SockErr then exit;
|
||||
retryCount := 0;
|
||||
|
||||
repeat
|
||||
@ -263,7 +297,7 @@ begin
|
||||
begin
|
||||
// now check if target returned error, resend ('-') or ACK ('+')
|
||||
// No support for ‘QStartNoAckMode’, i.e. always expect a -/+
|
||||
c := char(ReadByte);
|
||||
c := char(SafeReadByte);
|
||||
result := c = '+';
|
||||
if not result then
|
||||
inc(retryCount);
|
||||
@ -271,7 +305,7 @@ begin
|
||||
else
|
||||
inc(retryCount);
|
||||
// Abort this command if no ACK after 5 attempts
|
||||
until result or (retryCount > 5);
|
||||
until result or (retryCount > 5) or SockErr;
|
||||
end;
|
||||
|
||||
function TRspConnection.FReadReply(out retval: string): boolean;
|
||||
@ -282,30 +316,29 @@ var
|
||||
i: integer;
|
||||
cksum, calcSum: byte;
|
||||
begin
|
||||
Result := false;
|
||||
if SockErr then exit;
|
||||
i := 0;
|
||||
s := '';
|
||||
//IOTimeout := 10; // sometimes an empty response needs to be swallowed to
|
||||
repeat
|
||||
c := chr(ReadByte);
|
||||
c := chr(SafeReadByte);
|
||||
inc(i);
|
||||
s := s + c;
|
||||
until (c = '$') or (i = failcountmax); // exit loop after start or count expired
|
||||
until (c = '$') or (i = failcountmax) or SockErr; // exit loop after start or count expired
|
||||
|
||||
if c <> '$' then
|
||||
begin
|
||||
//WriteLn('* Timeout waiting for RSP reply');
|
||||
DebugLn(DBG_WARNINGS, ['Warning: Timeout waiting for RSP reply']);
|
||||
result := false;
|
||||
retval := '';
|
||||
exit;
|
||||
end
|
||||
else if i > 1 then
|
||||
begin
|
||||
//WriteLn('* Discarding data before start of message: ', s);
|
||||
DebugLn(DBG_WARNINGS, ['Warning: Discarding unexpected data before start of new message', s]);
|
||||
end;
|
||||
DebugLn(DBG_WARNINGS, ['Warning: Discarding unexpected data before start of new message', s])
|
||||
else if SockErr then
|
||||
DebugLn(DBG_WARNINGS, ['Warning: socket error.']);
|
||||
|
||||
c := chr(ReadByte);
|
||||
c := chr(SafeReadByte);
|
||||
s := '';
|
||||
calcSum := 0;
|
||||
while c <> '#' do
|
||||
@ -314,12 +347,11 @@ begin
|
||||
|
||||
if c=#$7D then // escape marker, unescape data
|
||||
begin
|
||||
c := char(ReadByte);
|
||||
c := char(SafeReadByte);
|
||||
|
||||
// Something weird happened
|
||||
if c = '#' then
|
||||
begin
|
||||
//WriteLn('* Received end of packet marker in escaped sequence: ', c);
|
||||
DebugLn(DBG_WARNINGS, ['Warning: Received end of packet marker in escaped sequence: ', c]);
|
||||
break;
|
||||
end;
|
||||
@ -330,22 +362,20 @@ begin
|
||||
end;
|
||||
|
||||
s := s + c;
|
||||
c := char(ReadByte);
|
||||
c := char(SafeReadByte);
|
||||
end;
|
||||
|
||||
cksum := StrToInt('$' + char(ReadByte) + char(ReadByte));
|
||||
cksum := StrToInt('$' + char(SafeReadByte) + char(SafeReadByte));
|
||||
|
||||
// Ignore checksum for now
|
||||
WriteByte(byte('+'));
|
||||
result := true;
|
||||
SafeWriteByte(byte('+'));
|
||||
result := not SockErr;
|
||||
retval := s;
|
||||
if not (calcSum = cksum) then
|
||||
begin
|
||||
//WriteLn('* Reply packet with invalid checksum: ', s);
|
||||
DebugLn(DBG_WARNINGS, ['Warning: Reply packet with invalid checksum: ', s]);
|
||||
end;
|
||||
|
||||
//WriteLn('RSP <- ', retval);
|
||||
DebugLn(DBG_RSP, ['RSP <- ', retval]);
|
||||
end;
|
||||
|
||||
@ -355,6 +385,7 @@ var
|
||||
retryCount: integer;
|
||||
begin
|
||||
reply := '';
|
||||
if SockErr then exit;
|
||||
retryCount := 0;
|
||||
|
||||
if FSendCommandOK(cmd) then
|
||||
@ -365,9 +396,9 @@ begin
|
||||
if not result then
|
||||
begin
|
||||
inc(retryCount);
|
||||
WriteByte(ord('-'));
|
||||
SafeWriteByte(ord('-'));
|
||||
end;
|
||||
until result or (retryCount > 5);
|
||||
until result or (retryCount > 5) or SockErr;
|
||||
end;
|
||||
|
||||
if retryCount > 5 then
|
||||
@ -430,7 +461,7 @@ procedure TRspConnection.Break();
|
||||
begin
|
||||
EnterCriticalSection(fCS);
|
||||
try
|
||||
WriteByte(3); // Ctrl-C
|
||||
SafeWriteByte(3); // Ctrl-C
|
||||
finally
|
||||
LeaveCriticalSection(fCS);
|
||||
end;
|
||||
@ -444,14 +475,14 @@ begin
|
||||
try
|
||||
result := FSendCommand('k');
|
||||
// Swallow the last ack if send
|
||||
result := FWaitForData(1000);
|
||||
result := not(SockErr) and FWaitForData(1000);
|
||||
finally
|
||||
LeaveCriticalSection(fCS);
|
||||
end;
|
||||
|
||||
if result then
|
||||
begin
|
||||
c := char(ReadByte);
|
||||
c := char(SafeReadByte);
|
||||
Result := c = '+';
|
||||
end;
|
||||
end;
|
||||
@ -466,7 +497,7 @@ begin
|
||||
finally
|
||||
LeaveCriticalSection(fCS);
|
||||
end;
|
||||
result := pos('OK', reply) = 1;
|
||||
result := not(SockErr) and (pos('OK', reply) = 1);
|
||||
end;
|
||||
|
||||
constructor TRspConnection.Create(AFileName: string; AOwner: TDbgProcess);
|
||||
@ -481,6 +512,7 @@ begin
|
||||
InitCriticalSection(fCS);
|
||||
FFileName := AFileName;
|
||||
FOwner := AOwner;
|
||||
FSockErr := false;
|
||||
end;
|
||||
|
||||
destructor TRspConnection.Destroy;
|
||||
@ -609,7 +641,7 @@ begin
|
||||
finally
|
||||
LeaveCriticalSection(fCS);
|
||||
end;
|
||||
result := reply = '';
|
||||
result := not(SockErr) and (reply = '');
|
||||
if not result then
|
||||
DebugLn(DBG_WARNINGS, ['Warning: vMustReplyEmpty command returned unexpected result: ', reply]);
|
||||
end;
|
||||
@ -630,7 +662,7 @@ begin
|
||||
|
||||
EnterCriticalSection(fCS);
|
||||
try
|
||||
result := FSendCmdWaitForReply(cmd, reply);
|
||||
result := FSendCmdWaitForReply(cmd, reply) and not(SockErr);
|
||||
finally
|
||||
LeaveCriticalSection(fCS);
|
||||
end;
|
||||
@ -654,7 +686,7 @@ begin
|
||||
|
||||
EnterCriticalSection(fCS);
|
||||
try
|
||||
result := FSendCmdWaitForReply(cmd, reply);
|
||||
result := FSendCmdWaitForReply(cmd, reply) and not(SockErr);
|
||||
finally
|
||||
LeaveCriticalSection(fCS);
|
||||
end;
|
||||
@ -667,7 +699,7 @@ begin
|
||||
DebugLn(DBG_VERBOSE, ['TRspConnection.Continue() called']);
|
||||
EnterCriticalSection(fCS);
|
||||
try
|
||||
result := FSendCommandOK('c');
|
||||
result := FSendCommandOK('c') and not(SockErr);
|
||||
finally
|
||||
LeaveCriticalSection(fCS);
|
||||
end;
|
||||
@ -679,7 +711,7 @@ function TRspConnection.SingleStep(): boolean;
|
||||
begin
|
||||
EnterCriticalSection(fCS);
|
||||
try
|
||||
result := FSendCommandOK('s');
|
||||
result := FSendCommandOK('s') and not(SockErr);
|
||||
finally
|
||||
LeaveCriticalSection(fCS);
|
||||
end;
|
||||
@ -695,7 +727,7 @@ begin
|
||||
cmd := 'p'+IntToHex(ind, 2);
|
||||
EnterCriticalSection(fCS);
|
||||
try
|
||||
result := FSendCmdWaitForReply(cmd, reply);
|
||||
result := FSendCmdWaitForReply(cmd, reply) and not(SockErr);
|
||||
finally
|
||||
LeaveCriticalSection(fCS);
|
||||
end;
|
||||
@ -740,9 +772,9 @@ begin
|
||||
finally
|
||||
LeaveCriticalSection(fCS);
|
||||
end;
|
||||
Result := Result and not(SockErr);
|
||||
if Result then
|
||||
begin
|
||||
//WriteLn('Read registers reply: ', reply);
|
||||
for i := 0 to sz-1 do
|
||||
b[i] := StrToInt('$'+reply[2*i+1]+reply[2*i+2]);
|
||||
result := true;
|
||||
@ -778,7 +810,7 @@ begin
|
||||
// Normal receive error, or an error number of the form Exx
|
||||
EnterCriticalSection(fCS);
|
||||
try
|
||||
result := FSendCmdWaitForReply(cmd, reply) and (reply = 'OK');
|
||||
result := FSendCmdWaitForReply(cmd, reply) and (reply = 'OK') and not(SockErr);
|
||||
finally
|
||||
LeaveCriticalSection(fCS);
|
||||
end;
|
||||
@ -798,7 +830,7 @@ begin
|
||||
cmd := 'm'+IntToHex(AAddress, 2)+',' + IntToHex(ASize, 2);
|
||||
EnterCriticalSection(fCS);
|
||||
try
|
||||
result := FSendCmdWaitForReply(cmd, reply) and (length(reply) = ASize*2);
|
||||
result := FSendCmdWaitForReply(cmd, reply) and (length(reply) = ASize*2) and not(SockErr);
|
||||
finally
|
||||
LeaveCriticalSection(fCS);
|
||||
end;
|
||||
@ -839,7 +871,7 @@ begin
|
||||
|
||||
EnterCriticalSection(fCS);
|
||||
try
|
||||
result := FSendCmdWaitForReply(cmd, reply) and (reply = 'OK');
|
||||
result := FSendCmdWaitForReply(cmd, reply) and (reply = 'OK') and not(SockErr);
|
||||
finally
|
||||
LeaveCriticalSection(fCS);
|
||||
end;
|
||||
@ -852,7 +884,7 @@ var
|
||||
cmdstr, reply: string;
|
||||
begin
|
||||
cmdstr := 'qRcmd,' + FHexEncodeStr(s);
|
||||
result := FSendCmdWaitForReply(cmdstr, reply);
|
||||
result := FSendCmdWaitForReply(cmdstr, reply) and not(SockErr);
|
||||
|
||||
// Check if reply is not hex encoded, else decode reply
|
||||
if Result and not((reply = '') or (reply = 'OK') or ((length(reply) = 3) and (reply[1] = 'E'))) then
|
||||
@ -877,7 +909,7 @@ begin
|
||||
reply := '';
|
||||
EnterCriticalSection(fCS);
|
||||
try
|
||||
if not FSendCmdWaitForReply('vMustReplyEmpty', reply) or (reply <> '') then
|
||||
if not FSendCmdWaitForReply('vMustReplyEmpty', reply) or (reply <> '') or SockErr then
|
||||
begin
|
||||
DebugLn(DBG_WARNINGS, ['Warning: vMustReplyEmpty command returned unexpected result: ', reply]);
|
||||
exit;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user