uses linux,stdio,strings;

const
  FTW_NS =100;	(* Something stat(2) failed on		*)
  FTW_DNR=200;	(* Something opendir(3) failed on	*)
  FTW_F  =300;	(* A normal file			*)
  FTW_D  =400;	(* A directory				*)
  MAXNAMLEN=4000;


(* Handy shorthand. *)
function EQ(a,b:pchar):boolean;
begin
  EQ:=(strcomp(a, b) = 0);
end;

type
  func=function(name:pchar; var status:tstat; _type:integer):integer;


function ftw(directory:pchar; funcptr:func; depth:integer):integer;
var
  dp:pdir;
  p,fullpath:pchar;
  i:integer;
  e:pdirent;
  sb:tstat;
  seekpoint:longint;
begin
  (* If can't stat, tell the user so. *)
  if not fstat(directory, Sb) then
  begin
    ftw:=funcptr(directory, Sb, FTW_NS);
    exit;
  end;
  
  (* If it's not a directory, call the user's function. *)
  if ((Sb.mode and STAT_IFMT) <> STAT_IFDIR) then
  (* Saying "FTW_F" here is lying, what if this is a symlink? *)
  begin
    ftw:=funcptr(directory, Sb, FTW_F);
    exit;
  end;

  (* Open directory; and if we can't tell the user so. *)
  Dp := opendir(directory);
  if dp = nil then
  begin
    ftw:=funcptr(directory, Sb, FTW_DNR);
    exit;
  end;

  (* See if user wants to go further. *)
  i := funcptr(directory, Sb, FTW_D);

  if i <> 0 then
  begin
    closedir(Dp);
    ftw:=i;
    exit;
  end;

  (* Get ready to hold the full paths. *)
  i := strlen(directory);
  fullpath := stralloc(i + 1 + MAXNAMLEN + 1);
  if fullpath = nil then
  begin
    closedir(Dp);
    ftw:=-1;
    exit;
  end;
  strcopy(fullpath, directory);
  p := @fullpath[i];
  if (i<>0) and (p[-1] <> '/') then
  begin
    p^:='/';
    inc(p);
  end;

  (* Read all entries in the directory.. *)
  E := readdir(Dp);
  while E <> nil do
  begin
    if not EQ(E^.name, '.') and not EQ(E^.name, '..') then
    begin
      if depth <= 1 then 
      begin
        (* Going too deep; checkpoint and close this directory. *)
        seekpoint := telldir(Dp);
        closedir(Dp);
        Dp := nil;
      end;

      (* Process the file. *)
      strcopy(p, E^.name);
      i := ftw(fullpath, funcptr, depth - 1);
      if i<>0 then
      begin
        (* User's finished; clean up. *)
        strdispose(fullpath);
        if Dp<>nil then
	  closedir(Dp);
	ftw:=i;
	exit;
      end;

      (* Reopen the directory if necessary. *)
      if Dp = nil then
      begin
        Dp := opendir(directory);
	if Dp = nil then
	begin
	  (* WTF? *)
	   strdispose(fullpath);
	   ftw:=-1;
	   exit;
	end;
	seekdir(Dp, seekpoint);
      end;
    end;	
    E := readdir(Dp);
  end;

  (* Clean up. *)
  strdispose(fullpath);
  closedir(Dp);
  ftw:=0;
end;


function list(name:pchar; var status:tstat; _type:integer):integer;
begin
  (* Если вызов stat завершился неудачей, просто вернуться *)
  if (_type = FTW_NS) then
  begin
    list:=0;
    exit;
  end;

  (*
   * Иначе, вывести имя объекта,
   * права доступа к нему и постфикс "*",
   * если объект является каталогом или символьной ссылкой.
   *)
  if (_type = FTW_F) then
    printf ('%-30s'#9'0%3o'#$a, [name, status.mode and octal(0777)])
  else
    printf ('%-30s*'#9'0%3o'#$a, [name, status.mode and octal(0777)]);

  list:=0;
end;

var
  path:array [0..255] of char;
  l:func;
begin
  if paramcount=0 then
    ftw ('.', @list, 1)
  else
  begin
    strpcopy(path,paramstr(1));
    ftw (path, @list, 1);
  end;
  halt(0);
end.
