[fpc-devel]ttyname

Alejandro Nestor Vargas anv at xnetcuyo.com.ar
Thu Dec 28 00:25:11 CET 2000


Some days ago I reported a problem with ttyname function (it does not work
for /dev/pts/*). I made a modification to the function. If you consider it
is correct you could put it in further versions of linux (or unix) unit.
Here is the code:

function TTYName(Handle:Longint):string;
{
  Return the name of the current tty described by handle f.
  returns empty string in case of an error.
}
var
  mydev,
  myino     : longint;
  st        : stat;

  function mysearch(n:string): boolean;
  {searches recursively for the device in the directory given by n,
    returns true if found and sets the name of the device in ttyname}
  var dirstream : pdir;
      d         : pdirent;
      name      : string;
      st        : stat;
  begin

  dirstream:=opendir(n);

  if (linuxerror<>0) then exit;

  d:=Readdir(dirstream);
  while (d<>nil)
  do begin

     name:=n+'/'+strpas(@(d^.name));
     fstat(name,st);

     if linuxerror=0
     then begin
          if ((st.mode and $E000)=$4000)  { if it is a directory }
          and (strpas(@(d^.name))<>'.')   {but not ., .. and fd subdirs}
          and (strpas(@(d^.name))<>'..')
          and (strpas(@(d^.name))<>'fd')
          then begin                      {we found a directory, search
inside it}
               if mysearch(name)
               then begin                 {the device is here}
                    closedir(dirstream);  {then don't continue searching}
                    mysearch:=true;
                    exit;
                    end;
               end
          else if (d^.ino=myino) and (st.dev=mydev)
               then begin
                    closedir(dirstream);
                    ttyname:=name;
                    mysearch:=true;
                    exit;
                    end;
          end;
     d:=Readdir(dirstream);
     end;
  closedir(dirstream);
  mysearch:=false;
  end;

begin
  TTYName:='';
  fstat(handle,st);
  if (errno<>0) and isatty (handle)
  then exit;

  mydev:=st.dev;
  myino:=st.ino;

  mysearch('/dev');
end;






More information about the fpc-devel mailing list