Уникальный индентификатор файла.

[Сквозняк]

Рано обрадовался, fpReadLink вместо гарантированного точного пути выдаёт зоопарк вариантов данных, а fprealpath в baseunix нету.

Что-то не клеится

Код: Выделить всё

Type
realpath = function(const path:pchar;resolved_path:pchar):pchar;cdecl; external 'c';

begin

end.

Добавлено спустя 4 минуты 43 секунды:

попробуй перед запуском лазаруса ставить английскую раскладку.

Это ему как слону дробинка. Причём на одно нажатие клавиши выдаёт 2 символа только окно редактора кода. Пробелов тоже по 2 штуки, а нажатие на энтер увеличивает количество строк только на 1.

Добавлено спустя 10 минут 21 секунду:

Как вы такого сумели добиться?Почему у меня не двоятся? v1.8.0

Он вначале вообще не работал - собран на слишком новом глибц и линковщике, ldd показывало что у лазаруса бинарь не динамический файл. Это при динамически слинкованном ГТК2 После того как пересобрал на своём линуксе (федора 17) fpc-3.0.4 (этот научился линковщику и глибцу старых версий) и lazarus 1.8.0, лазарус стал запускаться и даже компилять рабочие бинарники, но подсказки по ctrl и ctrl+alt работают хреново и буквы в этом окне чудят. Наверно эта версия лазаруса не предназначена для старых глибца и линковщика. Собрать то бинари она для них может. В принципе лазаруса 1.6.4 ещё на долго хватит.

Добавлено спустя 13 часов 51 минуту 59 секунд:

Код: Выделить всё

//uses baseunix;

var
PPCV: pchar;

function realpath(name:pchar;resolved:pchar):pchar;cdecl;external 'c';

function realpath2(SSTRINGG: ansistring):ansistring;
begin
realpath2:=realpath(pchar(SSTRINGG),PPCV);
end;


begin
//writeln(fpReadLink('./zzz3/z2/имя_симлинка2'));

writeln(realpath2('zzz3/z2/имя_симлинка2'));
end.

Ну и нацеплял зависимостей, даже libpng15 в коллекцию получил, СИ всех ею награждают, кто с либц слинкуется. С локальной pchar переменной функция realpath2 не работает, но это мелочи, по сравнению с подарком от либца.

[Сквозняк]

В сишной функции realpath нашли уязвимость, и по сложившейся традиции, растрындели о ней в интернете поскольку патчи безопасности завозят не везде, а поиск реального пути сложная задача, в которой могут всплыть и другие проблемы, пришлось взяться за альтернативный вариант - лазарусную функцию ReadAllLinks. Может раньше в линуксе она и хорошо работала, но теперь показаывает то полный путь, то локальный, с './' или без него. Выдрал из лазарусных исходников код, подправил и подсушил чтобы меньше весило.

Код: Выделить всё

{$GOTO ON}
{$MODE OBJFPC}
{$R+}

UNIT filerealpath;


interface
function Readrealpath(Filename: ansistring; ExceptionOnError: boolean;
   var EFOpenError_: ansistring; dirprog: ansistring): ansistring;
//Filename          - имя файла вместе с локальным или глобальным путём
//ExceptionOnError  - true если надо проверять на ошибки и false если не надо
//EFOpenError_      - возвращает '' если ошибок не обнаружено или строку с текстом, если обнаружено
//dirprog           - текущий каталог. Вычислять его при прыжках по каталогам 10000 раз в минуту, криво.
implementation

uses
baseunix,SysUtils;

var
PathDelim_: char='/';


function NacaloPuti(const Filename: ansistring):boolean;
begin
Result:=false;
if length(Filename)>0 then if Filename[1]=PathDelim_ then Result:=true;
{$ifdef windows}
Result:=false;
if ExtractFileDrive(Filename)<>'' then Result:=true;  //реализация не протестирована
{$endif  windows}
end;


function ResolveDots(const AFilename: ansistring): ansistring;
//trim double path delims and expand special dirs like .. and .
//on Windows change also '/' to '\' except for filenames starting with '\\?\'
var SrcPos, DestPos, l, DirStart: LongInt;
  c: char;
  MacroPos: LongInt;
begin
  Result:=AFilename;
  {$ifdef windows}
  //Special case: everything is literal after this, even dots (this does not apply to '//?/')
  if (Pos('\\?\', AFilename) = 1) then Exit;
  {$endif}

  l:=length(AFilename);
  SrcPos:=1;
  DestPos:=1;


  // trim double path delimiters and special dirs . and ..
  while (SrcPos<=l) do begin
    c:=AFilename[SrcPos];
    {$ifdef windows}
    //change / to \. The WinApi accepts both, but it leads to strange effects in other places
    if (c in AllowDirectorySeparators) then c := PathDelim;
    {$endif}
    // check for double path delims
    if (c=PathDelim_) then begin
      inc(SrcPos);
      {$IFDEF Windows}
      if (DestPos>2)
      {$ELSE}
      if (DestPos>1)
      {$ENDIF}
      and (Result[DestPos-1]=PathDelim_) then begin
        // skip second PathDelim
        continue;
      end;
      Result[DestPos]:=c;
      inc(DestPos);
      continue;
    end;
    // check for special dirs . and ..
    if (c='.') then begin
      if (SrcPos<l) then begin
        if (AFilename[SrcPos+1]=PathDelim_)
        and ((DestPos=1) or (AFilename[SrcPos-1]=PathDelim_)) then begin
          // special dir ./
          // -> skip
          inc(SrcPos,2);
          continue;
        end else if (AFilename[SrcPos+1]='.')
        and (SrcPos+1=l) or (AFilename[SrcPos+2]=PathDelim_) then
        begin
          // special dir ..
          //  1. ..      -> copy
          //  2. /..     -> skip .., keep /
          //  3. C:..    -> copy
          //  4. C:\..   -> skip .., keep C:\
          //  5. \\..    -> skip .., keep \\
          //  6. xxx../..   -> copy
          //  7. xxxdir/..  -> trim dir and skip ..
          //  8. xxxdir/..  -> trim dir and skip ..
          if DestPos=1 then begin
            //  1. ..      -> copy
          end else if (DestPos=2) and (Result[1]=PathDelim_) then begin
            //  2. /..     -> skip .., keep /
            inc(SrcPos,2);
            continue;
          {$IFDEF Windows}
          end else if (DestPos=3) and (Result[2]=':')
          and (Result[1] in ['a'..'z','A'..'Z']) then begin
            //  3. C:..    -> copy
          end else if (DestPos=4) and (Result[2]=':') and (Result[3]=PathDelim_)
          and (Result[1] in ['a'..'z','A'..'Z']) then begin
            //  4. C:\..   -> skip .., keep C:\
            inc(SrcPos,2);
            continue;
          end else if (DestPos=3) and (Result[1]=PathDelim_)
          and (Result[2]=PathDelim_) then begin
            //  5. \\..    -> skip .., keep \\
            inc(SrcPos,2);
            continue;
          {$ENDIF}
          end else if (DestPos>1) and (Result[DestPos-1]=PathDelim_) then begin
            if (DestPos>3)
            and (Result[DestPos-2]='.') and (Result[DestPos-3]='.')
            and ((DestPos=4) or (Result[DestPos-4]=PathDelim_)) then begin
              //  6. ../..   -> copy
            end else begin
              //  7. xxxdir/..  -> trim dir and skip ..
              DirStart:=DestPos-2;
              while (DirStart>1) and (Result[DirStart-1]<>PathDelim_) do
                dec(DirStart);
              MacroPos:=DirStart;
              while MacroPos<DestPos do begin
                if (Result[MacroPos]='$')
                and (Result[MacroPos+1] in ['(','a'..'z','A'..'Z']) then begin
                  // 8. directory contains a macro -> keep
                  break;
                end;
                inc(MacroPos);
              end;
              if MacroPos=DestPos then begin
                DestPos:=DirStart;
                inc(SrcPos,2);
                continue;
              end;
            end;
          end;
        end;
      end else begin
        // special dir . at end of filename
        if DestPos=1 then begin
          Result:='.';
          exit;
        end else begin
          // skip
          break;
        end;
      end;
    end;
    // copy directory
    repeat
      Result[DestPos]:=c;
      inc(DestPos);
      inc(SrcPos);
      if (SrcPos>l) then break;
      c:=AFilename[SrcPos];
      {$ifdef windows}
      //change / to \. The WinApi accepts both, but it leads to strange effects in other places
      if (c in AllowDirectorySeparators) then c := PathDelim_;
      {$endif}
      if c=PathDelim_ then break;
    until false;
  end;
  // trim result
  if DestPos<=length(AFilename) then
    SetLength(Result,DestPos-1);
end;


function ReadAllLinks_(const Filename: ansistring;
  ExceptionOnError: boolean;var EFOpenError_: ansistring): ansistring;
var
  LinkFilename: ansistring;
  AText: ansistring;
  Depth: longint;
label
  100;
begin
  Result:=Filename;
  EFOpenError_:='';
  Depth:=0;
  while Depth<12 do begin
    inc(Depth);
    LinkFilename:=FpReadLink(Result);
    if LinkFilename='' then begin
      AText:='"'+Filename+'"';
      case fpGetErrno() of
      ESysEAcces:
        AText:='read access denied for '+AText;
      ESysENoEnt:
        AText:='a directory component in '+AText
                            +' does not exist or is a dangling symlink';
      ESysENotDir:
        AText:='a directory component in '+AText+' is not a directory';
      ESysENoMem:
        AText:='insufficient memory';
      ESysELoop:
        AText:=AText+' has a circular symbolic link';
      else
        // not a symbolic link, just a regular file
        goto 100;// exit;
      end;
      if (not ExceptionOnError) then begin
        Result:='';
        goto 100; //exit;
      end;
      //raise EFOpenError.Create(AText); //отключено, т.к. сейчас не надо, а зависимости тяжёлые
      EFOpenError_:=EFOpenError_+AText; //замена
    end else begin
      if not NacaloPuti(LinkFilename) then
        Result:=ResolveDots(ExtractFilePath(Result)+LinkFilename)
      else
        Result:=LinkFilename;
    end;
  end;
  // probably an endless loop
  if ExceptionOnError then
    //raise EFOpenError.Create('too many links, maybe an endless loop.') //отключено, т.к. сейчас не надо, а зависимости тяжёлые
    EFOpenError_:=EFOpenError_+' too many links, maybe an endless loop.' //замена
  else
    Result:='';
100:
if EFOpenError_<>'' then begin
                        // writeln('function ReadAllLinks ERROR: ',EFOpenError_);
                        //обработчик ошибки
                         end;
end;


function Readrealpath(Filename: ansistring; ExceptionOnError: boolean;
   var EFOpenError_: ansistring; dirprog: ansistring): ansistring;
var
XX5,ZZ5:ansistring;
begin
XX5:=ExtractFilePath(Filename);
if XX5<>''then Chdir(XX5);
GetDir(0,ZZ5);
Chdir(dirprog);
Filename:=ZZ5+PathDelim_+ExtractFileName(Filename);
Readrealpath:=ReadAllLinks_(Filename,ExceptionOnError,EFOpenError_);
end;


begin
{$ifdef windows}
PathDelim_: char='\';
{$endif windows}
{$ifdef dos}
PathDelim_: char='\';
{$endif dos}
end.


Вроде работает хорошо, но есть два вопроса:

1.Есть ли способ просканировать путь из каталога файла без изменения текущего каталога - "Chdir(XX5); GetDir(0,ZZ5);"?

2.Если прикладывать этот исходник вместе с программами, то нужно ему в шапку какую-то лицензию вписать. А какая лицензия у функций ResolveDots и ReadAllLinks сейчас? Функции реализованы в инклудах файла lazfileutils.pas в котором никаких лицензий в шапке не указано. Не хотелось чтобы там вдруг когда-то нарисовалась добрая лицензия GPL 2+ - она же не даст делать программам никакие другие лицензии и т.д.

[olegy123]

В сишной функции realpath нашли уязвимость

Нашли, исправят. Но не заменят, иначе переписывать нужно уйму программ.

[Сквозняк]

В сишной функции realpath нашли уязвимость

Нашли, исправят.

Исправят только на тех версиях, на которых посчитают нужным. Лучше подсказал бы кто, какая версия может быть на производном от лазарусного коде. Хорошо бы если лгпл с исключением для статической линковки:)

Добавлено спустя 17 часов 47 минут 22 секунды:
Переписать лазарусную функцию оказалось проще чем решить все проблемы с ней.

Код: Выделить всё

uses baseunix;

function realpath3(FILENAME,CURDIR:ansistring;var ERROR8:boolean): ansistring;
var
FILENAME5,FILEPATH5,FILEPATH2_5,DIR5,EEE5,RRR5: ansistring;
label
1,100;
begin
//CURDIR -ТЕКУЩИЙ КАТАЛОГ
ERROR8:=false;
FILEPATH5:=ExtractFilePath(FILENAME);
{$I-}
Chdir(FILEPATH5);
if IOresult<>0 then goto 1;
GetDir(0,DIR5);
Chdir(CURDIR);
{$I+}
RRR5:='';
EEE5:=ExtractFileName(FILENAME);
if EEE5<>'' then RRR5:='/';
FILENAME5:=DIR5+RRR5+EEE5;
realpath3:=FpReadLink(FILENAME5);
if realpath3='' then begin
   case fpGetErrno() of
   ESYSENOTDIR,ESYSENAMETOOLONG,ESYSENOENT,
   ESYSEACCES,ESYSELOOP,ESYSEIO,ESYSEFAULT,ESYSENOMEM: goto 1;
   end;
   realpath3:=FILENAME5; 
                     end;
FILEPATH2_5:=ExtractFilePath(realpath3);
{$I-}
Chdir(FILEPATH5);
Chdir(FILEPATH2_5);
{$I+}
if IOresult<>0 then goto 1;
GetDir(0,DIR5);
Chdir(CURDIR);
RRR5:='';
EEE5:=ExtractFileName(realpath3);
if EEE5<>'' then RRR5:='/';
realpath3:=DIR5+RRR5+EEE5;
goto 100;
1:
ERROR8:=true;
realpath3:='';
Chdir(CURDIR);
{$I+}
100:
end;