////////////////////////////////////////////////////////////////////////////////////////////////////
// //
// hlcanerrdump utility to display SocketCAN error messages, by Zeljko Avramovic (c) 2021 //
// //
// Dual license: //
// 1. FPC modified LGPL (chosen for compatibility with FreePascal and Lazarus) //
// 2. BSD3 (chosen for compatibility with everything else) //
// //
// Virtual CAN adapter vcan0 is hard coded and you can bring it up like this: //
// sudo modprobe vcan //
// sudo ip link add dev vcan0 type vcan //
// sudo ip link set vcan0 mtu 72 # needed for CAN FD //
// sudo ip link set vcan0 up //
// //
// To simulate error messages use hlcanerrsim utility like this: //
// ./hlcanerrsim LostArbitrationBit=09 TX BusOff Data7=AA Data6=BB //
// //
// That should show in hlcanerrdump utility as: //
// 0x04A [8] 16 00 80 00 00 00 BB AA ERR=LostArbitrationBit09,BusOff,Prot(Type(TX),Loc(Unspec)) //
// //
// Alternatively, you could use candump from can-utils to check error messages like this: //
// candump -s -c -c -x -a any,0~0,#FFFFFFFF //
// //
////////////////////////////////////////////////////////////////////////////////////////////////////
program hlcanerrdump; // dump CAN error messages
{$mode delphi} {$H+}
uses
classes, sysutils, strutils, sockets, baseunix, can, can.hl, can.raw, can.error, crt;
procedure perror(const S : string);
begin
WriteLn(S, ', SocketError = ', SocketError);
end;
var
i, BytesNo: integer;
CanHandle: TCanHandle;
CanAddress: TCanSockAddress;
CanInterface: TCanIFreq;
CanFrame: TCanFrame;
CanMask: TCanErrMask;
CanFilter: TCanFilter;
SockOpt: cint;
ErrFlagStr: string;
Errors: TStringList;
begin
try
try
WriteLn('CAN Sockets Error Messages Dump. Waiting for errors...');
Errors := TStringList.Create;
CanHandle := CanSocket(SOCK_RAW, CAN_RAW);
if CanHandle < 0 then
begin
perror('Socket');
Exit;
end;
CanInterface.Name := 'vcan0';
if CanIOCtl(CanHandle, SIOCGIFINDEX, CanInterface) < 0 then
begin
perror('IOctl');
Exit;
end;
CanAddress.Clear;
CanAddress.CanFamily := AF_CAN;
CanAddress.CanIfIndex := CanInterface.IfIndex;
if CanBind(CanHandle, CanAddress) < 0 then
begin
perror('Bind');
Exit;
end;
CanFilter.ID.InverseFilter := true; // no normal CAN frames
CanFilter.Mask.Full := 0; // inverting nothing gives us everything
// CanFilter.Mask.Error.LostArbitration := true; // you might want to exclude arbitration errors
CanSetSockOpt(CanHandle, SOL_CAN_RAW, CAN_RAW_FILTER, CanFilter, SizeOf(CanFilter));
CanMask.ERR := true; // only error frames
CanSetSockOpt(CanHandle, SOL_CAN_RAW, CAN_RAW_ERR_FILTER, CanMask, SizeOf(CanMask));
SockOpt := CanFcntl(CanHandle, F_GETFL); // get socket options
if SockOpt < 0 then
begin
perror('CanFcntl: Error = ' + CanGetErrNo.ToString);
Exit;
end;
if CanFcntl(CanHandle, F_SETFL, SockOpt or O_NONBLOCK) < 0 then // set nonblock socket (to be able to exit after key press)
begin
perror('NonBlock: Error = ' + CanGetErrNo.ToString);
Exit;
end;
repeat
BytesNo := CanRead(CanHandle, CanFrame);
if BytesNo = SizeOf(CanFrame) then
begin
Write(Format(IfThen(CanFrame.ID.EFF, '0x%08.8X [%d] ', ' 0x%03.3X [%d] '), [CanFrame.ID.Value, CanFrame.DLC])); // extended or standard frame
for i := 0 to CanFrame.DLC - 1 do
Write(Format('%02.2X ', [CanFrame.Data[i]]));
Errors.Clear;
if CanFrame.ID.Mask.Error.TxTimeout then Errors.Add('TxTimeout');
if CanFrame.ID.Mask.Error.LostArbitration then Errors.Add('LostArbitrationBit' + Format('%.*d', [2, CanFrame.DataError.LostArbitration.BitNumber]));
if CanFrame.ID.Mask.Error.NoAck then Errors.Add('NoAck');
if CanFrame.ID.Mask.Error.BusOff then Errors.Add('BusOff');
if CanFrame.ID.Mask.Error.BusError then Errors.Add('BusError');
if CanFrame.ID.Mask.Error.Restarted then Errors.Add('Restarted');
if CanFrame.ID.Mask.Error.Controller then
begin
ErrFlagStr := '';
if CanFrame.DataError.Controller.OverflowRX then ErrFlagStr := ErrFlagStr + 'OverflowRX,';
if CanFrame.DataError.Controller.OverflowTX then ErrFlagStr := ErrFlagStr + 'OverflowTX,';
if CanFrame.DataError.Controller.WarningRX then ErrFlagStr := ErrFlagStr + 'WarningRX,';
if CanFrame.DataError.Controller.WarningTX then ErrFlagStr := ErrFlagStr + 'WarningTX,';
if CanFrame.DataError.Controller.PassiveRX then ErrFlagStr := ErrFlagStr + 'PassiveRX,';
if CanFrame.DataError.Controller.PassiveTX then ErrFlagStr := ErrFlagStr + 'PassiveTX,';
if CanFrame.DataError.Controller.Active then ErrFlagStr := ErrFlagStr + 'Active';
if ErrFlagStr.EndsWith(',') then SetLength(ErrFlagStr, ErrFlagStr.Length - 1);
Errors.Add('Ctrl(' + ErrFlagStr + ')');
end;
if CanFrame.ID.Mask.Error.Protocol then
begin
ErrFlagStr := 'Type(';
if CanFrame.DataError.Protocol.Category.SingleBit then ErrFlagStr := ErrFlagStr + 'SingleBit,';
if CanFrame.DataError.Protocol.Category.FrameFormat then ErrFlagStr := ErrFlagStr + 'FrameFormat,';
if CanFrame.DataError.Protocol.Category.BitStuffing then ErrFlagStr := ErrFlagStr + 'BitStuffing,';
if CanFrame.DataError.Protocol.Category.Bit0 then ErrFlagStr := ErrFlagStr + 'Bit0,';
if CanFrame.DataError.Protocol.Category.Bit1 then ErrFlagStr := ErrFlagStr + 'Bit1,';
if CanFrame.DataError.Protocol.Category.BusOverload then ErrFlagStr := ErrFlagStr + 'BusOverload,';
if CanFrame.DataError.Protocol.Category.ActiveAnnouncement then ErrFlagStr := ErrFlagStr + 'ActiveAnnouncement,';
if CanFrame.DataError.Protocol.Category.TX then ErrFlagStr := ErrFlagStr + 'TX';
if ErrFlagStr.EndsWith(',') then SetLength(ErrFlagStr, ErrFlagStr.Length - 1);
ErrFlagStr := ErrFlagStr + '),Loc(';
case CanFrame.DataError.Protocol.Location of
CAN_ERR_PROT_LOC_UNSPEC: ErrFlagStr := ErrFlagStr + 'Unspec'; // zero
CAN_ERR_PROT_LOC_SOF: ErrFlagStr := ErrFlagStr + 'SOF'; // start of frame
CAN_ERR_PROT_LOC_ID28_21: ErrFlagStr := ErrFlagStr + 'ID28_21'; // ID bits 28 - 21 (SFF: 10 - 3)
CAN_ERR_PROT_LOC_ID20_18: ErrFlagStr := ErrFlagStr + 'ID20_18'; // ID bits 20 - 18 (SFF: 2 - 0 )
CAN_ERR_PROT_LOC_SRTR: ErrFlagStr := ErrFlagStr + 'SRTR'; // substitute RTR (SFF: RTR)
CAN_ERR_PROT_LOC_IDE: ErrFlagStr := ErrFlagStr + 'IDE'; // identifier extension
CAN_ERR_PROT_LOC_ID17_13: ErrFlagStr := ErrFlagStr + 'ID17_13'; // ID bits 17-13
CAN_ERR_PROT_LOC_ID12_05: ErrFlagStr := ErrFlagStr + 'ID12_05'; // ID bits 12-5
CAN_ERR_PROT_LOC_ID04_00: ErrFlagStr := ErrFlagStr + 'ID04_00'; // ID bits 4-0
CAN_ERR_PROT_LOC_RTR: ErrFlagStr := ErrFlagStr + 'RTR'; // RTR
CAN_ERR_PROT_LOC_RES1: ErrFlagStr := ErrFlagStr + 'RES1'; // reserved bit 1
CAN_ERR_PROT_LOC_RES0: ErrFlagStr := ErrFlagStr + 'RES0'; // reserved bit 0
CAN_ERR_PROT_LOC_DLC: ErrFlagStr := ErrFlagStr + 'DLC'; // data length code
CAN_ERR_PROT_LOC_DATA: ErrFlagStr := ErrFlagStr + 'DATA'; // data section
CAN_ERR_PROT_LOC_CRC_SEQ: ErrFlagStr := ErrFlagStr + 'CRC_SEQ'; // CRC sequence
CAN_ERR_PROT_LOC_CRC_DEL: ErrFlagStr := ErrFlagStr + 'CRC_DEL'; // CRC delimiter
CAN_ERR_PROT_LOC_ACK: ErrFlagStr := ErrFlagStr + 'ACK'; // ACK slot
CAN_ERR_PROT_LOC_ACK_DEL: ErrFlagStr := ErrFlagStr + 'ACK_DEL'; // ACK delimiter
CAN_ERR_PROT_LOC_EOF: ErrFlagStr := ErrFlagStr + 'EOF'; // end of frame
CAN_ERR_PROT_LOC_INTERM: ErrFlagStr := ErrFlagStr + 'INTERM'; // intermission
otherwise
ErrFlagStr := ErrFlagStr + 'Unknown'; // protocol location not recognized
end;
Errors.Add('Prot(' + ErrFlagStr + '))');
end;
if CanFrame.ID.Mask.Error.Transceiver then
begin
ErrFlagStr := '';
case CanFrame.DataError.Transceiver of
CAN_ERR_TRX_UNSPEC: ErrFlagStr := ErrFlagStr + 'Unspec'; // $00, 0000 0000
CAN_ERR_TRX_CANH_NO_WIRE: ErrFlagStr := ErrFlagStr + 'CanHiNoWire'; // $04, 0000 0100
CAN_ERR_TRX_CANH_SHORT_TO_BAT: ErrFlagStr := ErrFlagStr + 'CanHiShortToBAT'; // $05, 0000 0101
CAN_ERR_TRX_CANH_SHORT_TO_VCC: ErrFlagStr := ErrFlagStr + 'CanHiShortToVCC'; // $06, 0000 0110
CAN_ERR_TRX_CANH_SHORT_TO_GND: ErrFlagStr := ErrFlagStr + 'CanHiShortToGND'; // $07, 0000 0111
CAN_ERR_TRX_CANL_NO_WIRE: ErrFlagStr := ErrFlagStr + 'CanLoNoWire'; // $40, 0100 0000
CAN_ERR_TRX_CANL_SHORT_TO_BAT: ErrFlagStr := ErrFlagStr + 'CanLoShortToBAT'; // $50, 0101 0000
CAN_ERR_TRX_CANL_SHORT_TO_VCC: ErrFlagStr := ErrFlagStr + 'CanLoShortToVCC'; // $60, 0110 0000
CAN_ERR_TRX_CANL_SHORT_TO_GND: ErrFlagStr := ErrFlagStr + 'CanLoShortToGND'; // $70, 0111 0000
CAN_ERR_TRX_CANL_SHORT_TO_CANH: ErrFlagStr := ErrFlagStr + 'CanLoShortToCanHi'; // $80, 1000 0000
otherwise
ErrFlagStr := ErrFlagStr + 'Unknown'; // transceiver error not recognized
end;
Errors.Add('Trans(' + ErrFlagStr + ')');
end;
if Errors.Count > 0 then
Write(' ERR=');
for i := 0 to Errors.Count - 1 do
begin
Write(Errors.Strings[i]);
if i <> (Errors.Count - 1) then
Write(',');
end;
WriteLn('');
end;
Sleep(5);
until KeyPressed;
if CanClose(CanHandle) < 0 then
begin
perror('Close');
Exit;
end;
except
on e: Exception do
WriteLn(e.Message);
end;
finally
Errors.Free;
end;
end.