program project1;
uses SysUtils, BaseUnix, TermIO;
function normalize(S:string):string; // expands any symlink at the end of S
var T:string;
n:integer;
begin
T:=fpReadLink(S); // try to follow a symlink (returns '' if fails)
if T='' then result:=S else // if T is empty, there was no symbolic link present
begin
n:=0;
while pos('../', T)=1 do // strip off as many leading "../" from T as possible
begin
delete(T,1,3);
inc(n) // keep count of number of steps
end;
inc(n); // +1 to account for removing (old) filename at end of S
while n<>0 do // strip off (old) filename and directories from end of S
begin
setlength(S, length(S)-1); // trim one character at a time
if S[length(S)]='/' then dec(n) // count down for each "/" removed
end; // when the loop exits it leaves a trailing "/"
T:=S+T; // concatenate the two trimmed strings
repeat
n:=pos('//', T); // fixup for any double "//" where S and T are joined
if n<>0 then delete(T, n, 1) // (in the present application this should never happen)
until n=0;
result:=T // return an absolute path
end
end;
type
TSerialStruct = packed record
typ: cint;
line: cint;
port: cuint;
irq: cint;
flags: cint;
xmit_fifo_size: cint;
custom_divisor: cint;
baud_base: cint;
close_delay: cushort;
io_type: cchar;
reserved_char: pcchar;
hub6: cint;
closing_wait: cushort; // time to wait before closing
closing_wait2: cushort; // no longer used...
iomem_base: pcchar;
iomem_reg_shift: cushort;
port_high: clong; // cookie passed into ioremap
overrun: array [1..64] of byte
end;
var DeviceName, DriverPath, S:string;
SR:TSearchRec;
T:text;
I:integer;
FD:longint;
SS:TSerialStruct;
ck:string;
begin
if FindFirst('/dev/tty*', faAnyFile , SR)=0 then
repeat
DeviceName:=SR.Name;
if (DeviceName<>'.') and (DeviceName<>'..') then
if FileExists('/sys/class/tty/'+DeviceName+'/device/driver') or // this suffices with FPC prior to 3.20
DirectoryExists('/sys/class/tty/'+DeviceName+'/device/driver') then // from FPC 3.20 onwards we need this instead
begin
S:='/sys';
S:=normalize(S+'/class'); // need all this palaver just so we can
S:=normalize(S+'/tty'); // check that DriverPath does not begin
S:=normalize(S+'/'+DeviceName); // with "/sys/bus/serial-base", as this
S:=normalize(S+'/device'); // would indicate a real ttySxx under
S:=normalize(S+'/driver'); // kernel 6.8+
DriverPath:=S;
if (pos('/sys/bus/serial-base/', DriverPath)<>1)
and (ExtractFileName(DriverPath)<>'serial8250') then writeln(DeviceName, ' is a removable device') else
begin
S:='/sys/class/tty/'+DeviceName+'/type'; // MUCH easier to find the "type" file here!
try // access may be blocked with pre-6.8 kernels
ck:='(/type)';
I:=-1;
assign(T, S);
reset(T);
if not eof(T) then readln(T, I)
finally
close(T)
end;
// I:=-1; // uncomment to force use of TIOCGSERIAL ioctl check
if I<0 then // we arrive here if we could not read the "type" file
begin
ck:='(ioctl)';
FD:=fpOpen('/dev/'+DeviceName, O_RDWR or O_NONBLOCK or O_NOCTTY);
if FD>0 then
try
if fpIOCtl(FD, TIOCGSERIAL, @SS)<>-1 then I:=SS.typ
finally
fpclose(FD)
end
end;
if I>0 then // 0 -> unknown: no hardware present
begin // -1 -> unable to perform either checks
case I of 0:S:='unknown';
1:S:='8250 UART';
2:S:='16450 UART';
3:S:='16550 UART';
4:S:='16550A UART'
else S:='other ('+IntToStr(I)+')'
end; {of case}
writeln(DeviceName, ' is type ', S, ' ', DriverPath, ' ', ck)
end
end
end
until FindNext(SR) <> 0;
FindClose(SR)
end.
Recent
