|
|
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: 4792 (0x12b8)
Types: TextFile
Names: »B«
└─⟦149519bd4⟧ Bits:30000546 8mm tape, Rational 1000, !projects 93-07-13
└─⟦124ff5788⟧ »DATA«
└─⟦this⟧
└─⟦f64eaa120⟧ Bits:30000752 8mm tape, Rational 1000, !projects 93 02 16
└─⟦6f12a12be⟧ »DATA«
└─⟦this⟧
WITH Transport_Interchange;
WITH Transport_Stream;
PACKAGE BODY Rpc_Client IS
Supported_Versions : CONSTANT Rpc.Version_Range := (3, 5);
PROCEDURE Exchange_Versions (Stream : Transport_Stream.Stream_Id) IS
Server_Versions : Rpc.Version_Range;
BEGIN
Rpc.Put (Stream, Supported_Versions);
Transport_Stream.Flush_Transmit_Buffer (Stream);
Rpc.Get (Stream, Server_Versions);
IF NOT Rpc.Overlaps (Server_Versions, Supported_Versions) THEN
Transport_Stream.Disconnect (Stream);
RAISE Rpc.No_Such_Version;
END IF;
END Exchange_Versions;
PROCEDURE Start_Request (The_Stream : Transport_Stream.Stream_Id;
Is_New : Boolean;
Proc : Rpc.Procedure_Number;
Program : Rpc.Program_Number;
Version : Rpc.Version_Number;
Username : String;
Password : String) IS
BEGIN
IF Is_New THEN
Exchange_Versions (The_Stream);
END IF;
Rpc.Put_Message (The_Stream,
(Rpc.Call_Message, 0, Program, Version, Proc));
Transport_Interchange.Put_String (The_Stream, Username);
Transport_Interchange.Put_String (The_Stream, Password);
END Start_Request;
PROCEDURE Start_Request (Stream : OUT Transport_Stream.Stream_Id;
Proc : Rpc.Procedure_Number;
Network : Transport_Defs.Network_Name;
Host : Transport_Defs.Host_Id;
Socket : Transport_Defs.Socket_Id;
Program : Rpc.Program_Number;
Version : Rpc.Version_Number;
Username : String;
Password : String) IS
The_Stream : Transport_Stream.Stream_Id;
Is_New : Boolean;
BEGIN
Transport_Stream.Allocate (The_Stream, Is_New, Network, Host, Socket);
Start_Request (The_Stream, Is_New, Proc, Program,
Version, Username, Password);
Stream := The_Stream;
END Start_Request;
PROCEDURE Start_Request_Generic
(Stream : OUT Transport_Stream.Stream_Id;
Proc : Rpc.Procedure_Number;
Network : Transport_Defs.Network_Name := Default_Network;
Host : Transport_Defs.Host_Id := Default_Host;
Socket : Transport_Defs.Socket_Id := Default_Socket;
Program : Rpc.Program_Number := Default_Program;
Version : Rpc.Version_Number := Default_Version) IS
BEGIN
Start_Request (Stream, Proc, Network, Host, Socket, Program, Version,
Username => "",
Password => "");
END Start_Request_Generic;
PROCEDURE Begin_Request_Generic (Stream : OUT Transport_Stream.Stream_Id;
Proc : Rpc.Procedure_Number) IS
The_Stream : Transport_Stream.Stream_Id;
Is_New : Boolean;
BEGIN
Transport_Stream.Allocate (The_Stream, Pool, Is_New);
Start_Request (The_Stream, Is_New, Proc, Program, Version,
Username => "",
Password => "");
Stream := The_Stream;
END Begin_Request_Generic;
PROCEDURE End_Request_With_Exception
(Stream : Transport_Stream.Stream_Id) IS
Response : Rpc.Message_Header;
Excep : Rpc.Exception_Number;
BEGIN
Transport_Stream.Flush_Transmit_Buffer (Stream);
Response := Rpc.Get_Message (Stream);
IF Rpc."/=" (Response.Kind, Rpc.Return_Message) THEN
Transport_Stream.Disconnect (Stream);
RAISE Rpc.Protocol_Error;
END IF;
EXCEPTION
WHEN Rpc.Server_Defined_Error =>
Rpc.Get (Stream, Excep);
End_Response (Stream);
Raise_Exception (Excep);
RAISE; -- in case Raise_Exception didn't.
WHEN OTHERS =>
End_Response (Stream);
RAISE;
END End_Request_With_Exception;
PROCEDURE Raise_Unknown_Exception (Excep : Rpc.Exception_Number) IS
BEGIN
RAISE Rpc.Server_Defined_Error; -- JMK 10/24/86 redundant, but why not.
END Raise_Unknown_Exception;
PROCEDURE End_Request_Guts IS
NEW End_Request_With_Exception
(Raise_Exception => Raise_Unknown_Exception);
PROCEDURE End_Request (Stream : Transport_Stream.Stream_Id) IS
BEGIN
End_Request_Guts (Stream);
END End_Request;
PROCEDURE End_Response (Stream : Transport_Stream.Stream_Id) IS
BEGIN
Transport_Stream.Deallocate (Stream);
END End_Response;
END Rpc_Client;