|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 12288 (0x3000)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body File_Names, seg_050972
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with C_Strings;
use C_Strings;
with Unix;
use Unix;
with Unix_Dirs;
use Unix_Dirs;
with Unix_Status_Buffer;
use Unix_Status_Buffer;
with Strlen;
package body File_Names is
type Find_File_Rec is
record
Pattern : A_String;
Dirp : Directory_Fd_Access;
Dir_Name : A_String;
end record;
function Init_Find_File (Pattern : A_String) return Find_File_Info is
Info : Find_File_Info := new Find_File_Rec;
Slash : Natural;
begin
begin
Slash := Last ('/', Pattern);
Info.Dir_Name := Change (Pattern, Slash, Pattern.Len, "");
Info.Pattern := Change (Pattern, 1, Slash, "");
exception
when Not_Found =>
Info.Dir_Name := To_A (".");
Info.Pattern := Pattern;
end;
Info.Dirp := Opendir (Info.Dir_Name.S);
return Info;
end Init_Find_File;
function Find_File (Info : Find_File_Info) return A_String is
Dp : Directory_Access;
Result : A_String;
Status : Status_Code;
begin
if Info.Dirp = null then
raise No_More_Files;
end if;
loop
Dp := Readdir (Info.Dirp);
if Dp = null then
Status := Closedir (Info.Dirp);
raise No_More_Files;
end if;
Result := To_A (Dp.Name (1 .. Namelen (Dp)));
if Matches (Result, Info.Pattern) then
return Info.Dir_Name & '/' & Result;
end if;
end loop;
end Find_File;
function Matches (Name : A_String; Pattern : A_String) return Boolean is
-- implemented ONLY FOR "*" and "?" wild cards
Max_Stars : constant Integer := 10;
type Star_Backtrack_Rec is
record
Pattern_Ptr : Natural;
Name_Ptr : Natural;
end record;
Stars : array (1 .. Max_Stars) of Star_Backtrack_Rec;
Num_Stars : Integer := 0;
P_Ptr : Integer := 1;
N_Ptr : Integer := 1;
C : Character;
Matches : Boolean;
begin
loop
Matches := False;
case Pattern.S (P_Ptr) is
when '\' =>
if P_Ptr = Pattern.Len then
raise Pattern_Error;
end if;
P_Ptr := P_Ptr + 1;
Matches := Pattern.S (P_Ptr) = Name.S (N_Ptr);
when '?' =>
Matches := True;
when '*' =>
if P_Ptr = Pattern.Len then
return True;
end if;
Num_Stars := Num_Stars + 1;
Stars (Num_Stars).Pattern_Ptr := P_Ptr + 1;
Stars (Num_Stars).Name_Ptr := N_Ptr;
Matches := True;
N_Ptr := N_Ptr - 1; -- matches "nothing" to start
when others =>
Matches := Pattern.S (P_Ptr) = Name.S (N_Ptr);
end case;
if Matches then
P_Ptr := P_Ptr + 1;
N_Ptr := N_Ptr + 1;
if N_Ptr > Name.Len then
for I in P_Ptr .. Pattern.Len loop
if Pattern.S (I) /= '*' then
Matches := False;
end if;
end loop;
return Matches;
end if;
Matches := P_Ptr <= Pattern.Len;
end if;
if not Matches then
loop
if Num_Stars <= 0 then
return False;
end if;
N_Ptr := Stars (Num_Stars).Name_Ptr + 1;
P_Ptr := Stars (Num_Stars).Pattern_Ptr;
Stars (Num_Stars).Name_Ptr := N_Ptr;
exit when N_Ptr <= Name.Len;
Num_Stars := Num_Stars - 1;
end loop;
end if;
end loop;
end Matches;
function Exists (Name : A_String) return Boolean is
C_Name : C_String_Buf;
begin
return Sys_Access (To_C (Name, C_Name'Address), F_Ok) /= Error;
end Exists;
function Canonical_Dir_Name (Lib : A_String) return A_String is
-- borrowed from VHQ code. This neeeds to be rewritten
-- to clean it up and to account for environment variables
-- and things like "~user".
Dummy, At_End : Boolean;
Full_Path : C_String_Buf;
Given_Path, Filler, This_Dir, Current_Result : A_String;
procedure Bite_Off_Dir (Inpath : in out A_String;
This_Dir : out A_String;
At_End : out Boolean) is
-- Truncates inpath beginning from its last slash. The truncated
-- portion is returned in this_dir. No action is taken if inpath="".
Len, Index : Integer;
begin -- Bite_off_dir
if Inpath.Len = 0 then
raise Error_In_File;
else
Index := Inpath.Len;
while Index > 1 and then Inpath.S (Index) /= '/' loop
Index := Index - 1;
end loop;
This_Dir := To_A (Inpath.S (Index .. Inpath.Len));
Inpath := To_A (Inpath.S (1 .. Index - 1));
At_End := (Index = 1);
end if;
end Bite_Off_Dir;
begin
Given_Path := Lib;
if Lib.S (1) /= '/' then -- Build full path
Unix.Getcwd (Full_Path);
This_Dir := To_A (Full_Path (1 .. Strlen (Full_Path'Address)));
Given_Path := This_Dir & "/" & Lib;
Error_Name := Given_Path; -- Used when referencing
end if; -- dirs before /
Bite_Off_Dir (Given_Path, This_Dir, At_End);
if not At_End then -- Go back another directory
Current_Result := Canonical_Dir_Name (Given_Path);
if This_Dir.S = "/." then -- Ignore this directory
null;
elsif This_Dir.S = "/.." then -- Remove last directory added
Bite_Off_Dir (Current_Result, Filler, Dummy);
else -- Append this directory to path
Current_Result := Current_Result & This_Dir;
end if;
return (Current_Result);
else
return (This_Dir);
end if;
end Canonical_Dir_Name;
function Size (Name : A_String) return Integer is
Stat_Buf : Status_Buffer;
C_Name : C_String_Buf;
begin
if Stat (To_C (Name, C_Name'Address), To_Stat (Stat_Buf'Address)) =
0 then
return Stat_Buf.Size;
else
return 0;
end if;
end Size;
procedure Symlink (Remote_Name : String; Local_Name : String) is
begin
if Unix.Symlink (Remote_Name, Local_Name) /= 0 then
raise Error_In_File;
end if;
end Symlink;
procedure Link (Remote_Name : String; Local_Name : String) is
begin
if Unix.Link (Remote_Name, Local_Name) /= 0 then
raise Error_In_File;
end if;
end Link;
procedure Unlink (File : String) is
begin
if Unix.Unlink (File) /= 0 then
raise Error_In_File;
end if;
end Unlink;
function Has_Permission
(Name : String; Rights : Permission) return Boolean is
Stat_Buf : Status_Buffer;
C_Name : C_String_Buf;
begin
if Stat (To_C (Name, C_Name'Address), To_Stat (Stat_Buf'Address)) =
0 then
return (To_Permission (Stat_Buf.Mode) and Rights) = Rights;
else
return False;
end if;
end Has_Permission;
function Show_Permission (Rights : Permission) return String is
Letter : String (1 .. 3) := "rwx";
Perm_Str : String (1 .. 9) := "---------";
Cnt : Natural := 0;
Char : Character := 't';
begin
for Right in reverse World_Execute_R .. Owner_Read_R loop
if Rights (Right) then
Perm_Str (Cnt + 1) := Letter (Cnt mod 3 + 1);
end if;
Cnt := Cnt + 1;
end loop;
Cnt := 9;
for Right in Keep_In_Memory_R .. Execute_As_User_R loop
if Rights (Right) then
if Perm_Str (Cnt) = 'x' then
Perm_Str (Cnt) := Char;
else
Perm_Str (Cnt) := To_Upper (Char);
end if;
end if;
Cnt := Cnt - 3;
Char := 's';
end loop;
return Perm_Str;
end Show_Permission;
function Get_Permission (Name : String) return Permission is
Stat_Buf : Status_Buffer;
begin
if Stat (Name, To_Stat (Stat_Buf'Address)) = 0 then
return To_Permission (Stat_Buf.Mode);
else
raise Error_In_File;
end if;
end Get_Permission;
function Show_Protection (Name : String) return String is
Stat_Buf : Status_Buffer;
Is_Dir : Character := '-';
begin
if Stat (Name, To_Stat (Stat_Buf'Address)) = 0 then
if Is_Directory (Stat_Buf) then
Is_Dir := 'd';
end if;
return Is_Dir & Show_Permission (To_Permission (Stat_Buf.Mode));
else
return "file " & Name & " not found";
end if;
end Show_Protection;
procedure Set_Permission (Name : String; Rights : Permission) is
begin
if Unix.Chmod (Name, To_Permission_Int (Rights)) /= 0 then
raise Error_In_File;
end if;
end Set_Permission;
end File_Names;
nblk1=b
nid=0
hdr6=16
[0x00] rec0=26 rec1=00 rec2=01 rec3=018
[0x01] rec0=1c rec1=00 rec2=02 rec3=01e
[0x02] rec0=1a rec1=00 rec2=03 rec3=038
[0x03] rec0=18 rec1=00 rec2=04 rec3=076
[0x04] rec0=1a rec1=00 rec2=05 rec3=00a
[0x05] rec0=17 rec1=00 rec2=06 rec3=032
[0x06] rec0=18 rec1=00 rec2=07 rec3=088
[0x07] rec0=24 rec1=00 rec2=08 rec3=012
[0x08] rec0=1e rec1=00 rec2=09 rec3=00c
[0x09] rec0=20 rec1=00 rec2=0a rec3=066
[0x0a] rec0=07 rec1=00 rec2=0b rec3=000
tail 0x21757ff16878e78e06046 0x42a00088462060003