{* HFSPATH *}
$standard_level 'ext_modcal'$
$list off$
Program Sample ( input, output );

Type

     status_type = record
                    case boolean of
                       true  : (all:    integer);
                       false : (info:   shortint;
                                subsys: shortint );
                    end;

     buffer_info_type = record
                        buff_offset  : integer;
                        name_len     : integer;
                        end;

     buffer_type = record
                    case boolean of
                      true : (buff_str  : string[200000]);
                      false: (buff_len  : integer;
                              buffer    : packed array[1..200000]
                                          of char);
                    end;


     buffer_rec_ptr_type    = ^ $extnaddr$ buffer_type;

     item_status_array_type = array [ 1..5 ] of status_type;

     max_pathname_type      = packed array [ 1..1024 ] of char;

     name_type              = packed array [ 1..16 ] of char;

     ufid_type              = packed array [ 1..20 ] of char;

     pathname_type= record
                    case boolean of
                       true : (path_str :  string [1024]);
                       false: (length   :  integer;
                               pathname :  packed array [1..1024]
                                           of char);
                    end;

     path_identifier_type = $alignment 4$
                            record
                            ufid       : ufid_type;
                            link_id:      bit32;
                            parent_ufid:  ufid_type;
                            end;


     return_array1_type = array [1..1000] of path_identifier_type;

     return_array2_type = array [1..1000] of buffer_info_type;



Const
     blanks                 = max_pathname_type [1024 of ' '];

     init_item_status_array = item_status_array_type
                               [ 5 of status_type [all :0]];

     init_return_array1   = return_array1_type
                            [ 1000 of path_identifier_type
                            [ufid       : '                    ',
                             link_id    : 0,
                             parent_ufid: '                    ']];

     null_chr               = chr(0);



Var
   access           : integer;
   answer           : char;
   aif_area         : integer;
   buff_name        : pathname_type;
                      {name returned into return buffer}
   buff_offset      : integer;
   buffer           : buffer_type;
   buffer_ptr       : buffer_rec_ptr_type;
   buffer_file_num  : integer;
   buffer_file_name : packed array[1..30] of char;
   continue         : boolean;

   fg_itemnum_array : packed array[1..5] of integer;
   fg_item_array    : packed array[1..5] of globalanyptr;
   fg_item_stat_array:item_status_array_type;
   file_owner       : packed array[1..36] of char;

   file_cnt         : integer;
   filetype         : integer;
   hp_status        : status_type;

   itemnum_array    : packed array [1..5] of integer;
   item_array       : packed array [1..5] of globalanyptr;
   item_status_array: item_status_array_type;
   name_len         : integer;
   num_array_entries: integer;
   overall_status   : status_type;
   recursion        : integer;
   return_array1    : return_array1_type;
   return_array2    : return_array2_type;
   search_key       : max_pathname_type;
   search_path      : pathname_type;       { search path  }
   skip_sw_errs     : boolean;
   sw_overall_status: status_type;
   temp_path        : pathname_type;
   user_id          : integer;


procedure GETPRIVMODE;   intrinsic;
procedure QUIT;          intrinsic;
procedure HPFOPEN;       intrinsic;

$sysintr 'aifintr.pub.sys'$
procedure AIFACCESSOFF;  intrinsic;
procedure AIFACCESSON;   intrinsic;
procedure AIFSYSWIDEGET; intrinsic;
procedure AIFFILEGGET; intrinsic;


{------------   Print error --------------------------------------}

procedure ERROR_IN_CALL ( status          : status_type;
                          name            : name_type;
                        item_status_array : item_status_array_type);

var i: integer;
begin
   writeln ('  ');
   writeln ('Error in ', name);
   writeln ('Overall status info = ', status.info, ' subsys= ',
            status.subsys);
   for i := 1 to status.info do
      writeln('Index: ',i,' info= ',item_status_array[i].info,
              ' subsys = ',item_status_array[i].subsys);
end;


begin

{-----------------------------------------------------------------}
{                  Get and validate AIF User ID                   }
{-----------------------------------------------------------------}
   GETPRIVMODE;
   writeln('Enter a valid user id:');
   readln (user_id);
   AIFACCESSON ( overall_status, user_id );
   if overall_status.all <> 0 then
   begin
      writeln ('AIFACCESSON error. Overall status info = ',
               overall_status.info,
               ' subsys = ',overall_status.subsys);
      QUIT(997);
   end;


{----------------------------------------------------------------}
{                  Set up search key pathname                    }
{----------------------------------------------------------------}
   search_path.path_str := '/@';
   itemnum_array[1]     := 5036;          { pathname item }
   item_array[1]        := addr(search_path);

{-----------------------------------------------------------------}
{                  Set up file type search criteria               }
{-----------------------------------------------------------------}
   filetype             := 9;             { Directory object }
   itemnum_array[2]     := 5039;          { filetype item }
   item_array[2]        := addr(filetype);

{-----------------------------------------------------------------}
{  Set up directory recursion level to look at first level        }
{-----------------------------------------------------------------}
   recursion            := 0;            { Only search first level }
   itemnum_array[3]     := 5049;          { Recursion level }
   item_array[3]        := addr(recursion);

{-----------------------------------------------------------------}
{  Check if user wants to ignore non-fatal errors.  Non-fatal     }
{  errors are those which may prevent a file or directory from    }
{  being opened (e.g. bad ufid, security violation), but they     }
{  won't prevent the rest of the directory from being traversed.  }
{-----------------------------------------------------------------}
   prompt ('Ignore non-fatal errors (Y/N)? ');
   readln (answer);
   if (answer = 'Y') or (answer = 'y') then
   begin
      skip_sw_errs      := True;
      itemnum_array[4]  := 5050;          { Skip non-fatal errs }
      item_array[4]     := addr(skip_sw_errs);
      itemnum_array[5]  := 0;
   end
   else
      itemnum_array[4]     := 0;

   aif_area             := 5000;          { File information }


{-----------------------------------------------------------------}
{ Open a long mapped file to use as return buffer.                }
{ Get ptr to file.                                                }
{-----------------------------------------------------------------}
   buffer_file_name := '%TEST%';
   access           := 4;    { Read/write }
   HPFOPEN ( buffer_file_num, hp_status, 2, buffer_file_name, 11,
             access, 21, buffer_ptr );
   if hp_status.all <> 0 then
   begin
      writeln('Error during HPFOPEN.  Status.info = ',
              hp_status.info,
              ' subsys= ',hp_status.subsys);
      QUIT(998);
   end;


{-----------------------------------------------------------------}
{ Repeat the call to AIFSYSWIDEGET until we have retrieved all    }
{ files that meet the search criteria.                            }
{-----------------------------------------------------------------}
   search_key        := blanks;
   repeat

   {---------------------------------------------------------------}
   {        Initialize and set up return arrays and buffer         }
   {---------------------------------------------------------------}

   setstrlen(buffer_ptr^.buff_str, 200000); {Set len in 1st 4 bytes}
   num_array_entries := 1000;             { Arrays are 1000 entries}
   item_status_array := init_item_status_array;
   return_array1     := init_return_array1;
   sw_overall_status.all := 0;


   AIFSYSWIDEGET (
             sw_overall_status,
             aif_area,          { aif_area = 5000 }
             return_array1,     { Can return up to 1000 path ids}
             return_array2,
             num_array_entries, {user specified max of 1000 entries}
             itemnum_array,
             item_array,
             item_status_array,
             search_key,        { defined as max_pathname_type }
             user_id,
             buffer_ptr );      { long pointer to a user buffer }



  {----------------------------------------------------------------}
  { Process error from the AIFSYSWIDEGET call.   If the user did   }
  { not choose to ignore errors, then we can handle it now.  If    }
  { the search key is not equal to blanks, then the error          }
  { was detected on the file returned in search_key, but the       }
  { error won't prevent us from continuing the directory traversal.}
  {----------------------------------------------------------------}
   if sw_overall_status.all <> 0 then
   begin
      ERROR_IN_CALL(sw_overall_status, 'AIFSYSWIDEGET',
         item_status_array);
      continue := false;

  { We only want to continue for some errors, so check the error }
  { in the item status array for the pathname item.              }
      if (search_key[1] <> ' ') then
      begin
         continue := true;
         case item_status_array[1].info of
    -70:writeln('Directory opened exclusively. Cannot traverse.');
    -72:writeln('User lacks TD permission on directory component.');
    -75:writeln('User lacks RD permission on directory component.');
    -83:writeln('Security violation when traversing directory.');
    -89:writeln('Error when trying to get flab.  Ufid may be bad!');
         otherwise
            continue := false;
         end;  {case}
      end;

      if continue then
        begin
           temp_path.path_str := '';
           STRMOVE(1024, search_key, 1, temp_path.path_str, 1);
           temp_path.path_str := STRRTRIM(temp_path.path_str);
           writeln('Error occured on file ',temp_path.path_str);
      writeln('Will print files in buffer and continue traversal.');
           writeln('  ');
        end
        else    {  Stop traversal and bail out.  }
           QUIT(999);
   end;    { Endif sw_overall_status.all <> 0 }

  {----------------------------------------------------------------}
  {             Extract pathnames from buffer                      }
  {----------------------------------------------------------------}
   file_cnt := 1;
   writeln('  ');
   if num_array_entries > 0 then
      writeln('------------------start of buffer-----------------');

   while file_cnt <= num_array_entries do
   begin

      { Extract return array 2 data }
      name_len    := return_array2[file_cnt].name_len;
      buff_offset := return_array2[file_cnt].buff_offset;
      buff_name.pathname   := blanks;

      buff_name.path_str   := '';      { Initialize string }

      strmove( name_len, buffer_ptr^.buff_str, ((buff_offset-4)+1),
         buff_name.path_str, 1);
      writeln(' Pathname is ',buff_name.path_str);

     { Call AIFFILEGGET to get the file owner for each file in
       buff_name }
      fg_itemnum_array[1] := 5041;         { File owner }
      fg_item_array[1]    := addr(file_owner);
      fg_item_stat_array  := init_item_status_array;
      fg_itemnum_array[2] := 0;            { end the item list }

      AIFFILEGGET ( overall_status,
                    fg_itemnum_array,
                    fg_item_array,
                    fg_item_stat_array,
                    {ufid},
                    {filename},
                    {tempfile},
                    user_id,
                    {pathid},
                    buff_name );
      if overall_status.all = 0 then
         writeln(' File owner is ',file_owner)
      else
         ERROR_IN_CALL ( overall_status, 'AIFFILEGGET',
            fg_item_stat_array);
      writeln;
      file_cnt := file_cnt + 1;

   end;    { end do while file_cnt <= num_array_entries }

   if num_array_entries > 0 then
      writeln('-------------------end of buffer-----------------');
   until (search_key[1]=' ');

end.    { end program  }