|
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 - downloadIndex: ┃ B T ┃
Length: 15049 (0x3ac9)
Types: TextFile
Names: »B«
└─⟦407de186f⟧ Bits:30000749 8mm tape, Rational 1000, RCFSUN
└─ ⟦e5cd75ab4⟧ »DATA«
└─⟦this⟧
with Ftp;
with Log;
with Cmvc;
with Profile;
with Ftp_Defs;
with Directory;
with Debug_Tools;
with Polymorphic_Io;
with Directory_Tools;
with String_Utilities;
with Library_Interface;
with Switch_Implementation;
with Remote_Command_Interface;
package body Library_Extensions is
package Naming renames Directory.Naming;
package Su renames String_Utilities;
package Dt renames Directory_Tools;
package Object renames Dt.Object;
Alsys_Family : constant String := "PUBLIC";
Target_Key_Id : constant String := "SParc_Unix_Alsys"; --[improve]
procedure Set_Status (Status : in out Simple_Status.Condition;
Error_Type : String := "Remote_Operation_Error";
Message : String;
Severity : Simple_Status.Condition_Class :=
Simple_Status.Problem) is
begin
Simple_Status.Create_Condition (Status => Status,
Error_Type => Error_Type,
Message => Message,
Severity => Severity);
end Set_Status;
procedure Unhandled_Exception
(Status : in out Simple_Status.Condition; Routine : String) is
begin
Set_Status (Status => Status,
Error_Type => "Unhandled Exception",
Message => Debug_Tools.Get_Exception_Name &
" caught in " & Routine & ".");
end Unhandled_Exception;
procedure Set_Context (Old_Context : in out Naming.Context;
View : String;
Status : in out Simple_Status.Condition) is
Error_Status : Directory.Error_Status;
New_Context : Naming.Context;
Dir_Object : Directory.Object;
Name_Status : Naming.Name_Status;
begin
Naming.Resolve (Name => View,
The_Object => Dir_Object,
Status => Name_Status);
if not Naming."=" (Name_Status, Naming.Successful) then
Set_Status (Status => Status,
Message => "Unable to resolve" & View &
". " & "Name Status = " &
Naming.Name_Status'Image (Name_Status));
return;
end if;
-- Get the current naming context for Promote_Unit.
Naming.Get_Context (The_Context => New_Context,
The_Unit => Dir_Object,
Status => Error_Status);
if not Directory."=" (Error_Status, Directory.Successful) then
Set_Status (Status => Status,
Message => "Unable to get default context for " &
View & ". Error Status = " &
Directory.Error_Status'Image
(Error_Status));
return;
end if;
-- Get the job's default naming context.
Old_Context := Naming.Default_Context;
-- We must restore this context (after any errors) before we return.
-- Change the job's default context to the unit's current context.
Naming.Set_Default_Context (The_Context => New_Context,
Status => Error_Status);
if not Directory."=" (Error_Status, Directory.Successful) then
Set_Status (Status => Status,
Message => "Unable to default context to " &
View & ". Error Status = " &
Directory.Error_Status'Image
(Error_Status));
return;
end if;
end Set_Context;
procedure Reset_Context (Old_Context : Directory.Naming.Context) is
Error_Status : Directory.Error_Status;
begin
-- Restore the job's original naming context.
Naming.Set_Default_Context (The_Context => Old_Context,
Status => Error_Status);
end Reset_Context;
procedure Create_Remote_Directory
(Remote_Directory : String;
Remote_Connection : Remote_Command_Interface.Context;
Status : in out Simple_Status.Condition) is
Create_Dir_Command : constant String := "mkdir " & Remote_Directory;
begin
Log.Put_Line (Message =>
"Creating remote directory = " & Remote_Directory,
Kind => Profile.Debug_Msg);
Remote_Command_Interface.Execute_Command
(Command_Line => Create_Dir_Command,
Remote_Connection => Remote_Connection,
Status => Status);
if Simple_Status.Error (Status) then
Log.Put_Line (Message => Simple_Status.Message (Status),
Kind => Profile.Negative_Msg);
Set_Status (Status => Status,
Message => "Unable to create the remote directory, " &
Remote_Directory & ".");
return;
end if;
exception
when others =>
Unhandled_Exception (Status, "Create_Remote_Directory");
end Create_Remote_Directory;
procedure Rename_Remote_File (Remote_Directory : String;
Remote_Machine : String;
From_Simple_Name : String;
To_Simple_Name : String;
Status : in out Simple_Status.Condition) is
Remote_Connection : Remote_Command_Interface.Context;
Local_Status : Simple_Status.Condition;
Rename_Command : constant String :=
"cp " & Remote_Directory & "/" & From_Simple_Name &
" " & Remote_Directory & "/" & To_Simple_Name;
Remove_Temp_File_Command : constant String :=
"rm " & Remote_Directory & "/" & From_Simple_Name;
begin
Remote_Command_Interface.Acquire
(Remote_Connection => Remote_Connection,
Remote_Machine => Remote_Machine,
Target_Key => Target_Key_Id,
Status => Status);
if Simple_Status.Error (Status) then
Log.Put_Line (Message => Simple_Status.Message (Status),
Kind => Profile.Negative_Msg);
Set_Status (Status => Status,
Message => "Unable to acquire connection to " &
Remote_Machine);
return;
end if;
Remote_Command_Interface.Execute_Command
(Command_Line => Rename_Command,
Remote_Connection => Remote_Connection,
Status => Status);
if Simple_Status.Error (Status) then
Log.Put_Line (Message => Simple_Status.Message (Status),
Kind => Profile.Negative_Msg);
Set_Status (Status => Status,
Message => "Unable to rename the file from " &
From_Simple_Name &
" to " & To_Simple_Name);
end if;
Remote_Command_Interface.Execute_Command
(Command_Line => Remove_Temp_File_Command,
Remote_Connection => Remote_Connection,
Status => Status);
if Simple_Status.Error (Status) then
Log.Put_Line (Message => Simple_Status.Message (Status),
Kind => Profile.Negative_Msg);
Set_Status (Status => Status,
Message => "Unable to rename file " & To_Simple_Name);
end if;
Remote_Command_Interface.Release
(Remote_Connection => Remote_Connection, Status => Local_Status);
exception
when others =>
Unhandled_Exception (Status, "Rename_Remote_File");
begin
Remote_Command_Interface.Release
(Remote_Connection => Remote_Connection,
Status => Local_Status);
exception
when others =>
null;
end;
end Rename_Remote_File;
procedure Create_Program_Library
(Remote_Directory : String;
Remote_Program_Library : String;
Remote_Connection : Remote_Command_Interface.Context;
Status : in out Simple_Status.Condition) is
Local_Status : Simple_Status.Condition;
Build_Adalib_Command : constant String :=
"ada lib_manager\(family=" & Alsys_Family & "\).new " &
Remote_Directory & "/adalib " & "annotate=rcf_adalib";
begin
Log.Put_Line (Message => "Creating remote program library = " &
Remote_Program_Library,
Kind => Profile.Debug_Msg);
Log.Put_Line (Message =>
"Executing remote command: " & Build_Adalib_Command,
Kind => Profile.Note_Msg);
Remote_Command_Interface.Execute_Command
(Command_Line => Build_Adalib_Command,
Remote_Connection => Remote_Connection,
Status => Status);
if Simple_Status.Error (Status) then
Log.Put_Line (Message => Simple_Status.Message (Status),
Kind => Profile.Negative_Msg);
Set_Status (Status => Status,
Message => "Unable to create the remote adalib in, " &
Remote_Directory & ".");
Log.Put_Line (Message =>
"Creation of the Remote Ada Library Failed",
Kind => Profile.Error_Msg);
Log.Put_Line (Message => "Possible causes of this failure include:",
Kind => Profile.Negative_Msg);
Log.Put_Line
(Message =>
" - Invalid Username & Password from Session Switches or ",
Kind => Profile.Negative_Msg);
Log.Put_Line (Message => " remote passwords file",
Kind => Profile.Negative_Msg);
Log.Put_Line
(Message =>
" - Remote machine is not accessable via the network",
Kind => Profile.Negative_Msg);
Log.Put_Line (Message => " - Invalid permissions on the target",
Kind => Profile.Negative_Msg);
Log.Put_Line
(Message =>
"After resolving this problem use Rcf.Build_Remote_Library",
Kind => Profile.Negative_Msg);
Log.Put_Line (Message => "to create the Ada library on the target.",
Kind => Profile.Negative_Msg);
Log.Put_Line (Message => "", Kind => Profile.Negative_Msg);
Remote_Command_Interface.Release
(Remote_Connection => Remote_Connection, Status => Local_Status);
return;
end if;
Remote_Command_Interface.Release
(Remote_Connection => Remote_Connection, Status => Local_Status);
exception
when others =>
Unhandled_Exception (Status, "Create_Program_Library");
begin
Remote_Command_Interface.Release
(Remote_Connection => Remote_Connection,
Status => Local_Status);
exception
when others =>
null;
end;
end Create_Program_Library;
procedure Directory_Exists
(Remote_Directory : String;
Remote_Connection : Remote_Command_Interface.Context;
Status : in out Simple_Status.Condition;
Exists : out Boolean) is
begin
Exists := False;
Remote_Command_Interface.File_Exists
(The_File => Remote_Directory,
Remote_Connection => Remote_Connection,
Status => Status,
Exists => Exists);
exception
when others =>
Unhandled_Exception (Status, "directory_Exists");
end Directory_Exists;
procedure Make_Path_Preprocess
(Host_Path_Name : String;
Remote_Machine : String;
Remote_Directory : String;
Remote_Program_Library : String;
Status : in out Simple_Status.Condition) is separate;
procedure Make_Path_Postprocess
(Host_Path_Name : String;
Remote_Machine : String;
Remote_Directory : String;
Remote_Program_Library : String;
Status : in out Simple_Status.Condition) is separate;
procedure Destroy_View_Preprocess
(Host_Path_Name : String;
Status : in out Simple_Status.Condition) is separate;
procedure Destroy_View_Postprocess
(Host_Path_Name : String;
Status : in out Simple_Status.Condition) is separate;
procedure Import_Preprocess
(Views_To_Import : Directory.Naming.Iterator;
Into_View : String;
Status : in out Simple_Status.Condition) is separate;
procedure Import_Postprocess
(Views_To_Import : Directory.Naming.Iterator;
Into_View : String;
Status : in out Simple_Status.Condition) is separate;
procedure Remove_Import_Preprocess
(View_To_Remove : Directory.Object;
From_View : String;
Status : in out Simple_Status.Condition) is separate;
procedure Remove_Import_Postprocess
(View_To_Remove : Directory.Object;
From_View : String;
Status : in out Simple_Status.Condition) is separate;
procedure Release_Preprocess
(From_Working_View : String;
Released_View : String;
Remote_Machine : String;
Remote_Directory : String;
Remote_Program_Library : String;
Status : in out Simple_Status.Condition) is separate;
procedure Release_Postprocess
(View_To_Remove : String;
Released_View : String;
Remote_Machine : String;
Remote_Directory : String;
Remote_Program_Library : String;
Status : in out Simple_Status.Condition) is separate;
procedure Link_Preprocess
(Main_Unit : String;
Executable_Name : String;
Status : in out Simple_Status.Condition) is separate;
procedure Link_Postprocess
(Main_Unit : String;
Executable_Name : String;
Status : in out Simple_Status.Condition) is separate;
end Library_Extensions;