|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - downloadIndex: B T
Length: 7710 (0x1e1e)
Types: TextFile
Names: »B«
└─⟦180fe333a⟧ Bits:30000405 8mm tape, Rational 1000, SW CATALOG, 10_20_0
└─⟦180fe333a⟧ Bits:30000537 8mm tape, Rational 1000, SW Catalog 10_20_0
└─⟦5cb1d1d7f⟧ »DATA«
└─⟦3b1ee7bd8⟧
└─⟦this⟧
separate (Tar)
package body Tar_Header is
subtype Byte_String is System.Byte_String;
function "=" (X, Y : Byte_String) return Boolean renames System."=";
function "=" (X, Y : System.Byte) return Boolean renames System."=";
function "-" (X, Y : System.Byte) return System.Byte renames System."-";
Short_Bytes : constant Positive := 6;
Long_Bytes : constant Positive := 11;
Zero : constant Natural := Character'Pos ('0');
Nine : constant Natural := Character'Pos ('9');
Space : constant Byte_String := To_Byte_String (" ");
Space_Nul : constant Byte_String := To_Byte_String (" " & Ascii.Nul);
Null_Name : Name_Type;
Default_Header : Header;
Checksum_Bytes : constant Positive := 6;
Checksum_Radix : constant Positive := 8;
type Checksum_Type is new Natural;
Checksum_Preset : constant Checksum_Type :=
Checksum_Type ((Checksum_Bytes + Space_Nul'Length) *
Character'Pos (' '));
procedure Put (Data : Natural;
Into : out System.Byte_String;
Radix : Natural := 8) is
D : Natural := Data;
begin
for I in reverse Into'Range loop
Into (I) := System.Byte (Zero + (D mod Radix));
D := D / Radix;
end loop;
end Put;
procedure Get (Data : out Natural;
From : System.Byte_String;
Radix : Natural := 8) is
D : Natural := 0;
begin
for I in From'Range loop
D := D * Radix;
if Natural (From (I)) in Zero .. Nine then
D := D + (Natural (From (I)) - Zero);
end if;
end loop;
Data := D;
end Get;
procedure Put (Data : Name_Type; Into : out System.Byte_String) is
D : constant String := Bounded_String.Image (Data);
L : constant Natural := D'Length;
begin
Into (Into'First .. Into'First + L - 1) := To_Byte_String (D);
for I in Into'First + L .. Into'Last loop
Into (I) := 0;
end loop;
end Put;
procedure Get (Data : out Name_Type; From : System.Byte_String) is
D : Name_Type;
begin
for I in From'Range loop
if From (I) = 0 then
Bounded_String.Copy (D, To_String (From (1 .. I - 1)));
Data := D;
return;
end if;
end loop;
Bounded_String.Copy (D, To_String (From));
Data := D;
end Get;
function Default return Header is
begin
return Default_Header;
end Default;
procedure Put (Data : Header; Into : out System.Byte_String) is
Cursor : Natural := Into'First;
Checksum_Index : Natural;
Checksum : Checksum_Type := Checksum_Preset;
procedure Put (S : Byte_String) is
begin
for I in S'Range loop
Into (Cursor) := S (I);
Checksum := Checksum + Checksum_Type (S (I));
Cursor := Cursor + 1;
end loop;
end Put;
procedure Put (N : Name_Type) is
S : Byte_String (1 .. Namsiz);
begin
Put (N, S);
Put (S);
end Put;
procedure Put (N : Short) is
S : Byte_String (1 .. Short_Bytes);
begin
Put (Natural (N), S);
Put (S);
end Put;
procedure Put (N : Long) is
S : Byte_String (1 .. Long_Bytes);
begin
Put (Natural (N), S);
Put (S);
end Put;
procedure Put (N : Checksum_Type) is
S : Byte_String (1 .. Checksum_Bytes);
begin
Put (Natural (N), S, Checksum_Radix);
Put (S);
end Put;
procedure Put (C : Character) is
S : Byte_String (1 .. 1);
begin
S (1) := Character'Pos (C);
Put (S);
end Put;
begin
Put (Data.Name);
Put (Data.Mode);
Put (Space_Nul);
Put (Data.Uid);
Put (Space_Nul);
Put (Data.Gid);
Put (Space_Nul);
Put (Data.Size);
Put (Space);
Put (Data.Mtime);
Put (Space);
Checksum_Index := Cursor;
Cursor := Cursor + Checksum_Bytes + Space_Nul'Length;
Put (Data.Linkflag);
Put (Data.Linkname);
declare
Padding : constant Byte_String (Cursor .. Into'Last) :=
(others => 0);
begin
Put (Padding);
end;
Cursor := Checksum_Index;
Put (Checksum);
Put (Space_Nul);
end Put;
procedure Get (Data : out Header; From : System.Byte_String) is
Cursor : Natural := From'First;
Checksum_Index : Natural;
Checksum : Checksum_Type := Checksum_Preset;
Calculated : Checksum_Type;
Received : Checksum_Type;
Space : Byte_String (1 .. 1);
Space_Nul : Byte_String (1 .. 2);
procedure Get (S : out Byte_String) is
begin
for I in S'Range loop
S (I) := From (Cursor);
Checksum := Checksum + Checksum_Type (From (Cursor));
Cursor := Cursor + 1;
end loop;
end Get;
procedure Get (N : out Name_Type) is
S : Byte_String (1 .. Namsiz);
begin
Get (S);
Get (N, S);
end Get;
procedure Get (N : out Short) is
S : Byte_String (1 .. Short_Bytes);
begin
Get (S);
Get (Natural (N), S);
end Get;
procedure Get (N : out Long) is
S : Byte_String (1 .. Long_Bytes);
begin
Get (S);
Get (Natural (N), S);
end Get;
procedure Get (N : out Checksum_Type) is
S : Byte_String (1 .. Checksum_Bytes);
begin
Get (S);
Get (Natural (N), S, Checksum_Radix);
end Get;
procedure Get (C : out Character) is
S : Byte_String (1 .. 1);
begin
Get (S);
C := Character'Val (S (1));
end Get;
begin
Get (Data.Name);
Get (Data.Mode);
Get (Space_Nul);
Get (Data.Uid);
Get (Space_Nul);
Get (Data.Gid);
Get (Space_Nul);
Get (Data.Size);
Get (Space);
Get (Data.Mtime);
Get (Space);
Checksum_Index := Cursor;
Cursor := Cursor + Checksum_Bytes + Space_Nul'Length;
Get (Data.Linkflag);
Get (Data.Linkname);
declare
Padding : Byte_String (Cursor .. From'Last);
begin
Get (Padding);
end;
Calculated := Checksum;
Cursor := Checksum_Index;
Get (Received);
Get (Space_Nul);
if Received /= Calculated then
Log.Put_Line ("Archive file header is damaged (bad checksum).",
Profile.Error_Msg);
Log.Put_Line ("received" & Checksum_Type'Image (Received) &
", calculated" & Checksum_Type'Image (Calculated));
end if;
exception
when others =>
Log.Put_Line ("Archive file header cannot be read.",
Profile.Exception_Msg);
raise;
end Get;
begin
Bounded_String.Copy (Null_Name, "");
Default_Header := (Name => Null_Name,
Mode => 8#444#,
Uid => 8#1#,
Gid => 8#1#,
Size => 0,
Mtime => 8#1#,
Linkflag => '0',
Linkname => Null_Name);
end Tar_Header;