|
|
|
The following sets of programs illustrate the principles for converting a PTOP
application to use NetIPC and RPM.
The sample application is a simple name server, where you run a client program
that creates a server on the node that contains a data file. The client
program sends names to the server. The server looks up the names in the data
file and returns associated information to the client.
The client and server are first presented as PTOP master and slave programs.
Then they are converted to use NetIPC and RPM.
The major points of the conversion are:
- The POPEN call made by the client is replaced by the NetIPC and
RPM calls as detailed in the earlier section "Creating Remote Processes."
At the beginning of the server, the corresponding NetIPC and RPM calls
are inserted.
- The client's PWRITE of the name to the server is replaced by an
IPCSEND. The server's GET and ACCEPT are
replaced by an IPCRECV (actually, one or more IPCRECVs
in the RECV procedure).
- The server can ACCEPT or REJECT the client's
PREAD for the name information, depending on whether the name
is found in the data file. So, in the converted application, the server
sends an accept or reject indication to the client. The ACCEPT
is replaced by an IPCSEND of the name information.
- The accepted PREAD in the client becomes an IPCRECV
for the name information.
- The client's PCLOSE is replaced by an RPMKILL and
IPCSHUTDOWN.
PCLIENT: Sample PTOP Master Program
$standard_level 'HP3000', uslinit$ program pclient( input, output );
{-------------------------------------------------------------------}
{ }
{ PCLIENT: Sample PTOP Master Program }
{ }
{-------------------------------------------------------------------}
{ }
{ PURPOSE: }
{ The PCLIENT and PSERVER programs illustrate the use of the PTOP }
{ service to implement a simple name server application. The user }
{ runs PCLIENT on his local node, and PCLIENT creates PSERVER on }
{ the node which contains the data. The user inputs names to }
{ to PCLIENT, PCLIENT sends the names to PSERVER, PSERVER }
{ looks up the names in its name file, and sends the associated info}
{ for the names back to PCLIENT. }
{ }
{-------------------------------------------------------------------}
{ }
{ INTERACTION: }
{ PTOP is a master-slave protocol. The master PCLIENT sends }
{ requests (PREAD and PWRITE) to the slave PSERVER. The slave }
{ GETs the request from the master and either ACCEPTs them or }
{ REJECTs them. The GET indicates the function requested by the }
{ master, and the ACCEPT transfers the actual data, from the master }
{ for a PWRITE and to the master for a PREAD. REJECT can be used }
{ to reject the master request (used here if the name cannot be }
{ found in the data file. }
{ PCLIENT PSERVER }
{ }
{ get remote node name }
{ POPEN PSERVER on remote node ------> GET }
{ <------- ACCEPT (POPEN) }
{ get name }
{ PWRITE name ---------name----------> GET }
{ < --------------------- ACCEPT name }
{ PREAD info -----------------------> GET }
{ look up name, found info }
{ <---------info--------- ACCEPT info }
{ print info }
{ get name }
{ PWRITE name ---------name----------> GET }
{ < -----------------------ACCEPT }
{ PREAD info -----------------------> GET }
{ look up name, not found }
{ < -----------------------REJECT }
{ print error }
{ . . . }
{ PCLOSE -----------------------> GET }
{ (terminate) }
{-------------------------------------------------------------------}
label 1; {for error exit }
const maxnodelength = 51; {all lengths in bytes}
maxproglength = 24;
namelength = 20;
infolength = 60;
ccg = 0; {condition codes }
ccl = 1;
cce = 2;
type shortint = -32768..32767;
msgtype = packed array[1..30] of char;
var location: packed array [1..maxnodelength] of char;
progname: packed array [1..maxproglength] of char;
name: packed array [1..namelength ] of char;
info: packed array [1..infolength ] of char;
dsnum: shortint;
length: shortint;
function POPEN: shortint; intrinsic; {PTOP master intrinsics}
procedure PWRITE; intrinsic;
function PREAD: shortint; intrinsic;
procedure PCLOSE; intrinsic;
function PCHECK: shortint; intrinsic;
procedure ERROR( msg: msgtype; errnum: shortint );
{----------------------------------------------------------------}
{ ERROR prints out an error message and associated PTOP error }
{ number, and then goes to the error exit to terminate the }
{ program. The PTOP slave will be terminated automatically. }
{----------------------------------------------------------------}
begin
writeln( 'Client: ', msg, 'PTOP error = ', errnum:3 );
goto 1;
end;
begin
prompt('Client: Enter the remote node name: ');
readln( location );
{-------------------------------------------------------------}
{ Create PSERVER slave on remote node (location). This }
{ requires a previous REMOTE HELLO for the remote node. }
{-------------------------------------------------------------}
progname := 'PSERVER ';
dsnum := POPEN( location, progname );
if ccode <> cce then
ERROR( 'POPEN on server failed', PCHECK(0) );
{------------------------------------------------------------}
{ Each pass of this loop gets a name, PWRITEs it to PSERVER, }
{ PREADs the info, and prints the info. If PSERVER cannot }
{ find the name, it will REJECT the PREAD. }
{------------------------------------------------------------}
repeat
prompt('Client: Enter name (or EOT to exit):');
readln( name );
if name <> 'EOT' then
begin
PWRITE( dsnum, name, -namelength );
if ccode <> cce then
ERROR( 'PWRITE to server failed.', PCHECK(dsnum) );
length := PREAD( dsnum, info, -infolength );
if ccode = cce then {ACCEPT}
writeln('Client data is: ', info )
else if ccode = ccg then {REJECT}
writeln('Client data could not be found.')
else {ccode = ccl}
ERROR( 'PREAD from server failed.', PCHECK(dsnum) );
end;
until name = 'EOT';
{-------------------------------------------------------------}
{ All names have been processed. Terminate the PSERVER. }
{-------------------------------------------------------------}
PCLOSE( dsnum );
if ccode <> cce then
ERROR( 'PCLOSE on server failed.', PCHECK(dsnum) );
1: {error exit}
end.
PSERVER: Sample PTOP Slave Program
Standard_level 'HP3000', uslinit$
program pserver( input, output }
{-------------------------------------------------------------------}
{ }
{ PURPOSE: }
{ The PCLIENT and PSERVER programs illustrate the use of the PTOP}
{ service for a simple name server application. See the PCLIENT }
{ program for details. }
{ }
{-------------------------------------------------------------------}
label 1; {for error exit }
const namelength = 20; {all lengths in bytes}
infolength = 60;
cce = 2; {condition code }
type shortint = -32768..32767;
msgtype = packed array[1..30] of char;
nametype = packed array[1..namelength] of char;
infotype = packed array[1..infolength] of char;
var name: nametype;
info: infotype;
func: shortint;
found: boolean;
function GET: shortint; intrinsic; {PTOP slave intrinsics}
procedure ACCEPT; intrinsic;
procedure REJECT; intrinsic;
function PCHECK: shortint; intrinsic;
procedure ERROR( msg: msgtype; errnum: shortint );
{----------------------------------------------------------------}
{ ERROR prints an error message and an associated PTOP error }
{ number. It terminates the program by going to the error exit. }
{----------------------------------------------------------------}
begin
writeln( 'Server: ', msg, 'PTOP error = ', errnum:3 );
goto 1;
end; {ERROR}
procedure FIND_NAME ( var reqname: nametype;
var info: infotype;
var found: boolean );
{----------------------------------------------------------------}
{ FIND_NAME sequentially searches the data file for the requested}
{ name. It returns an indication of whether the name was found, }
{ and if it was found, the information field for the name. (In }
{ a real name server, a more efficient look up method would be }
{ used.) }
{----------------------------------------------------------------}
var filename: packed array[1..9] of char;
datafile: text;
name: nametype;
begin
filename := 'DATAFILE ';
reset( datafile, filename );
found := false;
while not found and not eof(datafile) do
begin
readln( datafile, name, info );
if name = reqname then
found := true
end;
end; {FIND_NAME}
begin
{-------------------------------------------------------------}
{ Each pass of this loop GETs one master request and ACCEPTs }
{ or REJECTs the request, based on the type of request. The }
{ loop continues until the master issues its PCLOSE to }
{ terminate the slave. }
{-------------------------------------------------------------}
repeat
func := GET;
case func of
0:{error}
ERROR( 'Bad GET in server', PCHECK(0) );
1:{POPEN}
begin
ACCEPT;
if ccode <> cce then
ERROR( 'ACCEPT for POPEN failed', PCHECK(0) );
end;
2:{PREAD}
begin
{----------------------------------------------------}
{ Look up name from previous PWRITE. If the name }
{ is found, ACCEPT the PREAD with the name info. }
{ If the name is not found, REJECT the PREAD. }
{----------------------------------------------------}
FIND_NAME( name, info, found );
if found then
begin
ACCEPT( , info, -infolength );
if ccode <> cce then
ERROR( 'ACCEPT for PREAD failed', PCHECK(0) );
end
else
begin
REJECT;
if ccode <> cce then
ERROR( 'REJECT for PREAD failed', PCHECK(0) );
end;
end;
3:{PWRITE}
begin
{----------------------------------------------------}
{ ACCEPT the name from the PWRITE. This name will }
{ be used in the case for the following PREAD. }
{----------------------------------------------------}
ACCEPT( , name );
if ccode <> cce then
ERROR( 'ACCEPT for PWRITE failed', PCHECK(0) );
end;
end;
until false;
1:{error exit}
end.
RCLIENT: Sample NetIPC/RPM Master Program
$standard_level 'HP3000', uslinit$ program rclient( input, output );
{---------------------------------------------------------------------}
{ }
{ RCLIENT: Sample NetIPC/RPM Master Program }
{ }
{---------------------------------------------------------------------}
{ }
{ PURPOSE: }
{ The RCLIENT and RSERVER programs illustrate the use of the RPM }
{ and NetIPC services to implement a simple name server application. }
{ The user runs RCLIENT on his local node, and RCLIENT creates }
{ RSERVER on the node which contains the data. The user inputs }
{ names to RCLIENT, RCLIENT sends the names to RSERVER, }
{ RSERVER looks up the names in its name file and sends the associated}
{ info for the names back to RCLIENT. }
{ }
{ The RCLIENT and RSERVER programs are converted from the }
{ PCLIENT and PSERVER programs, which use PTOP to }
{ implement the name server. }
{ The PTOP-to-RPM/NetIPC conversion guidelines in the beginning }
{ of this appendix were used. }
{ }
{---------------------------------------------------------------------}
{ }
{ INTERACTION: }
{ The original PTOP implementation of the name server used a master- }
{ slave relationship between the client and server. The client }
{ sends requests, and the server can accept or reject the requests. }
{ This relationship is preserved in the NetIPC/RPM implementation. }
{ RCLIENT must first create RSERVER and they must set up a virtual }
{ circuit connection between them. RCLIENT creates and names a }
{ call socket. It then calls RPMCREATE to create RSERVER, passing }
{ the client's socket name and node name as RPM strings in the opt }
{ array. When it is created, RSERVER retrieves the client's socket }
{ and node name, creates its own socket, looks up the client's }
{ socket, and establishes a connection between its socket and the }
{ client's socket. At this point, the client and server are ready }
{ to exchange data. }
{ For each input name, RCLIENT sends the name to RSERVER. RSERVER }
{ looks up the name in its data file. If the name is found, RSERVER }
{ sends a one byte "accept" indication back to RCLIENT, followed by }
{ the name information. If the name is not found, RSERVER sends a }
{ "reject" indication to RCLIENT. This simulates the original use }
{ of ACCEPT and REJECT in the PTOP implementation. }
( RCLIENT RSERVER }
{ NSINFO for client node name }
{ IPCCREATE socket 1 }
{ IPCNAME socket 1, clientsock }
{ ADDOPT rpmstring, clientsock }
{ ADDOPT rpmstring, clientnode }
{ get server node name }
{ RPMCREATE RSERVER on server }
{ node ----------------------> RPMGETSTRING clientsock }
{ IPCRECVCN socket 1 RPMGETSTRING clientnode }
{ . IPCCREATE socket 2 }
{ . IPCLOOKUP clientsock, }
{ . clientnode, }
{ . dest }
{ . <-----------------------IPCCONNECT socket 2, dest }
{ . ----------------------> IPCRECV }
{ IPCNAMERASE clientsock IPCSHUTDOWN socket 2 }
{ IPCSHUTDOWN socket 1 IPCRECV name }
{ get name . }
{ IPCSEND name---------name----------> . }
{ IPCRECV ind look up name, found info }
{ . <-----indaccept-------- IPCSEND indaccept }
{ IPCRECV info < -------info-----------IPCSEND info }
{ print info IPCRECV name }
{ get name . }
{ IPCSEND name---------name----------> . }
{ IPCRECV ind look up name, not found }
{ . < -----indreject-------- IPCSEND indreject }
{ print error IPCRECV name }
{ . . . . }
{ RPMKILL -----------------------> . }
{ IPCSHUTDOWN vc (terminate) }
{ (IPCSHUTDOWN vc) }
{ }
{---------------------------------------------------------------------}
label 1;
const maxnodelength = 51; {all lengths in bytes }
maxproglength = 24;
namelength = 20;
infolength = 60;
clocalnodelength= 18; {NSINFO item number }
clocalnode = 19; {NSINFO item number }
callsocket = 3; {IPCCREATE socket type }
tcpprotocol = 4; {IPCCREATE protocol type}
socketnamelength= 8; {created by IPCNAME }
maxoptlength = maxnodelength + socketnamelength + 20;
dependent = 31; {RPMCREATE flags bit }
optrpmstring = 20000;{RPMCREATE opt number }
indaccept = 0; {accept indication }
indreject = 1; {reject indication }
type shortint = -32768..32767;
byte = 0..255;
msgtype = packed array [1..30] of char;
buftype = array [1..80] of char;
var clientnode: packed array [1..maxnodelength] of char;
clientsockname: packed array [1..socketnamelength] of char;
location: packed array [1..maxnodelength] of char;
progname: packed array [1..maxproglength] of char;
name: packed array [1..namelength ] of char;
info: packed array [1..infolength ] of char;
opt: packed array [1..maxoptlength ] of char;
rpmflags: packed array [0..31] of boolean;
progdesc: array [1..8] of shortint;
buf: buftype;
clientnodelength: shortint;
loclength: shortint;
prognamelength: shortint;
socketdesc: integer;
vcdesc: integer;
status: shortint;
result: integer;
envnum: shortint;
i: integer;
procedure NSINFO; intrinsic; {NS intrinsic }
procedure IPCCREATE; intrinsic; {NetIPC intrinsics}
procedure IPCNAME; intrinsic;
procedure IPCNAMERASE; intrinsic;
procedure IPCRECVCN; intrinsic;
procedure IPCSEND; intrinsic;
procedure IPCRECV; intrinsic;
procedure IPCSHUTDOWN; intrinsic;
procedure INITOPT; intrinsic;
procedure ADDOPT; intrinsic;
procedure RPMCREATE; intrinsic; {RPM intrinsics }
procedure RPMKILL; intrinsic;
procedure ERROR ( msg: msgtype; result: integer );
{----------------------------------------------------------------}
{ ERROR prints out an error message and an associated NetIPC or }
{ RPM result code, and then goes to the error exit to terminate }
{ the program. Because the server was created with the dependent}
{ flag, the server will automatically terminate. Any NetIPC }
{ objects (socket, socket name, or virtual circuit) will also be }
{ deleted at termination. }
{----------------------------------------------------------------}
begin
writeln( 'Client: ', msg, 'Result = ', result:3 );
goto 1;
end;
procedure RECV( vcdesc: integer;
var buf: buftype;
length: integer;
var result: integer );
var nextbufchar: integer;
recvlength: integer;
{----------------------------------------------------------------}
{ RECV receives a specified number of bytes from the virtual }
{ circuit (vc) connection. This compensates for the stream mode }
{ operation of NetIPC on the HP 3000, where an IPCRECV can return}
{ less than the requested number of bytes. The loop in RECV }
{ calls IPCRECV to receive the next chunk of data, until the }
{ requested amount of data has been received. Note that buf }
{ must be unpacked to allow it to be indexed in the IPCRECV call.}
{----------------------------------------------------------------}
begin
result := 0;
nextbufchar := 1;
while (length > 0) and (result = 0) do
begin
recvlength := length;
IPCRECV( vcdesc, buf[nextbufchar], recvlength, , , result );
nextbufchar := nextbufchar + recvlength;
length := length - recvlength;
end;
end; {RECV}
begin
{-----------------------}
{ Get client node name. }
{-----------------------}
NSINFO( , , envnum, status,
clocalnodelength, clientnodelength,
clocalnode, clientnode );
if status <> 0 then
ERROR( 'Couldn't get client node name.', status );
{-------------------------------------------------------------}
{ Create and name client's socket. The socket length of 0 in }
{ IPCNAME will cause it to return a random 8-byte socket name.}
{-------------------------------------------------------------}
IPCCREATE( callsocket, tcpprotocol, , , socketdesc, result );
if result <> 0 then
ERROR( 'Couldn't create local socket.', result );
IPCNAME( socketdesc, clientsockname, 0, result );
if result <> 0 then
ERROR( 'Couldn't name client socket.', result );
{-------------------------------------------------------------}
{ Build the opt array for the RPMCREATE call, including RPM }
{ strings for the client's socket name and node name. }
{-------------------------------------------------------------}
INITOPT( opt, 2 );
ADDOPT ( opt, 0, optrpmstring, socketnamelength, clientsockname );
ADDOPT ( opt, 1, optrpmstring, clientnodelength, clientnode );
{-------------------------------------------}
{ Get the server's node name from the user. }
{-------------------------------------------}
prompt('Client: Enter the remote node name: ');
readln( location );
loclength := 0;
while location[loclength+1] <> ' ' do
loclength := loclength + 1;
progname := 'RSERVER';
prognamelength := 7;
{-------------------------------------------------------------}
{ Set the dependent flag for the RPMCREATE. This causes the }
{ the server to terminate if the client terminates, or if the }
{ connection between them fails. }
{-------------------------------------------------------------}
for i := 0 to 31 do
rpmflags[i] := false;
rpmflags[dependent] := true;
{---------------------------------------}
{ Create the server on the remote node. }
{---------------------------------------}
RPMCREATE( progname, prognamelength,
location, loclength,
, , , ,
rpmflags, opt, progdesc, result );
if result <> 0 then
ERROR( 'Couldn't create server', result );
{-------------------------------------------------------------}
{ Once active, the server will create its own socket, look up }
{ the client's socket, and set up a vc connection between its }
{ socket and the client's socket. Wait here for the connect }
{ request from the server. }
{-------------------------------------------------------------}
IPCRECVCN( socketdesc, vcdesc, , , result );
if result <> 0 then
ERROR( 'Connect receive failed', result );
{-------------------------------------------------------------}
{ Now that the vc connection has been set up, the client's }
{ socket name and socket can be deleted. }
{-------------------------------------------------------------}
IPCNAMERASE( clientsockname, socketnamelength, result );
if result <> 0 then
ERROR( 'Couldn't delete socket name.', result );
IPCSHUTDOWN( socketdesc, , , result );
if result <> 0 then
ERROR( 'Couldn't shutdown socket.', result );
{-------------------------------------------------------------}
{ Each pass of this loop gets a name, sends it to the server, }
{ and receives an accept/reject indication from the server. }
{ If the server accepts the name, the client will receive the }
{ name information sent by the server. }
{-------------------------------------------------------------}
repeat
prompt('Client: Enter name (or EOT to exit):');
readln( name );
if name <> 'EOT' then
begin
IPCSEND( vcdesc, name, namelength, , , result );
if result 0 then
ERROR( 'Send to server failed.', result );
RECV( vcdesc, buf, 1, result );
if result <> 0 then
ERROR( 'Receive from server failed.', result );
if ord(buf[1]) = indaccept then
begin
RECV( vcdesc, buf, infolength, result );
if result <> 0 then
ERROR( 'Receive from server failed.', result );
for i := 1 to infolength do
info[i] := buf[i];
writeln('Client data is: ', info);
end
else{indicator = indreject}
writeln('Client data could not be found.');
end;
until name = 'EOT';
{-------------------------------------------------------------}
{ All names have been processed. Terminate RSERVER and delete}
{ this end of the vc connection. (RSERVER will automatically }
{ delete its end of the connection.) }
{-------------------------------------------------------------}
RPMKILL( progdesc, , , result );
if result <> 0 then
ERROR( 'Couldn't kill server.', result );
IPCSHUTDOWN( vcdesc, , , result );
if result <> 0 then
ERROR( 'Couldn't shut down local vc.', result );
1:{error exit}
end.
RSERVER: Sample NetIPC/RPM Slave Program
$standard_level 'HP3000', uslinit$ program rserver( input, output );
{-------------------------------------------------------------------}
{ }
{ RSERVER: Sample NetIPC/RPM Slave Program }
{ }
{-------------------------------------------------------------------}
{ }
{ PURPOSE: }
{ The RCLIENT and RSERVER programs illustrate the use of the NetIPC }
{ and RPM services to implement a simple name server application. }
{ See the RCLIENT program for details. }
{-------------------------------------------------------------------}
label 1; {error exit }
const namelength = 20; {all lengths in bytes }
infolength = 60;
maxnodelength = 51;
socketnamelength= 8; {returned by IPCNAME }
callsocket = 3; {IPCCREATE socket type }
tcpprotocol = 4; {IPCCREATE protocol type}
indaccept = 0; {accept indication }
indreject = 1; {reject indication }
type shortint = -32768..32767;
msgtype = packed array[1..30] of char;
nametype = packed array[1..namelength] of char;
infotype = packed array[1..infolength] of char;
buftype = array [1..80] of char;
var clientsockname: packed array[1..socketnamelength] of char;
clientnode: packed array[1..maxnodelength] of char;
name: nametype;
info: infotype;
buf: buftype;
clientsocklength: integer;
clientnodelength: integer;
socketdesc: integer;
destdesc: integer;
vcdesc: integer;
result: integer;
i: integer;
found: boolean;
procedure RPMGETSTRING; intrinsic; {RPM intrinsic }
procedure IPCCREATE; intrinsic; {NetIPC intrinsics}
procedure IPCLOOKUP; intrinsic;
procedure IPCCONNECT; intrinsic;
procedure IPCRECV; intrinsic;
procedure IPCSEND; intrinsic;
procedure IPCSHUTDOWN; intrinsic;
procedure ERROR( msg: msgtype; result: integer );
{----------------------------------------------------------------}
{ ERROR prints an error message and an associated NetIPC or RPM }
{ result code. It terminates the program by going to the error }
{ exit. Any NetIPC objects (sockets or virtual circuits) will }
{ be deleted upon termination. }
{----------------------------------------------------------------}
begin
writeln( 'Server: ', msg, 'Result = ', result:3 );
goto 1;
end; {ERROR}procedure RECV( vcdesc: integer;
var buf: buftype;
length: integer;
var result: integer );
{----------------------------------------------------------------}
{ RECV receives a specified number of bytes from the virtual }
{ circuit (vc) connection. This compensates for the stream mode }
{ operation of NetIPC on the HP 3000, where an IPCRECV can return}
{ less than the requested number of bytes. The loop in RECV }
{ calls IPCRECV to receive the next chunk of data, until the }
{ requested amount of data has been received. Note that buf }
{ must be unpacked to allow it to be indexed in the IPCRECV call.}
{----------------------------------------------------------------}
var nextbufchar: integer;
recvlength: integer;
begin
result := 0;
nextbufchar := 1;
while (length <> 0) and (result = 0) do
begin
recvlength := length;
IPCRECV( vcdesc, buf[nextbufchar], recvlength, , , result );
nextbufchar := nextbufchar + recvlength;
length := length - recvlength;
end;
end; {RECV}
procedure FIND_NAME( var reqname: nametype;
var info: infotype;
var found: boolean );
{----------------------------------------------------------------}
{ FIND_NAME sequentially searches the data file for the requested}
{ name. It returns an indication of whether the name was found, }
{ and if it was found, the information field for the name. (In }
{ a real name server, a more efficient look up method would be }
{ used.) }
{----------------------------------------------------------------}
var filename: packed array[1..9] of char;
datafile: text;
name: nametype;
begin
filename := 'DATAFILE ';
reset( datafile, filename );
found := false;
while not found and not eof(datafile) do
begin
readln( datafile, name, info );
if name = reqname then
found := true
end;
end; {FIND_NAME}
begin
{-------------------------------------------------------------}
{ Retrieve the client's socket name and node name, passed as }
{ RPM strings. }
{-------------------------------------------------------------}
clientsocklength := socketnamelength;
RPMGETSTRING( clientsockname, clientsocklength, result );
if result <> 0 then
ERROR( 'Couldn't get socket name.', result );
clientnodelength := maxnodelength;
RPMGETSTRING( clientnode, clientnodelength, result );
if result <> 0 then
ERROR( 'Couldn't get local nodename.', result );
{-------------------------------------------------------------}
{ Create the server's socket, look up the client's socket, }
{ and set up a vc connection between the server and the client}
{ sockets. }
{-------------------------------------------------------------}
IPCCREATE( callsocket, tcpprotocol, , , socketdesc, result );
if result <> 0 then
ERROR( 'Couldn't create socket.', result );
IPCLOOKUP( clientsockname, clientsocklength, clientnode,
clientnodelength, destdesc, , , result );
if result <> 0 then
ERROR( 'Socket look up failed.', result );
IPCCONNECT( socketdesc, destdesc, , , vcdesc, result );
if result <> 0 then
ERROR( 'Socket connection failed', result );
{-------------------------------------------------------------}
{ Wait for the connection acknowledgement from the client. }
{-------------------------------------------------------------}
IPCRECV( vcdesc, , , , , result );
if result <> 0 then
ERROR( 'Socket connect receive failed.', result );
{-------------------------------------------------------------}
{ Once the connection is established, the socket and destina- }
{ tion descriptors are no longer needed. So delete them. }
{-------------------------------------------------------------}
IPCSHUTDOWN( socketdesc, , , result );
if result <> 0 then
ERROR( 'Couldn't shut down socket.', result );
IPCSHUTDOWN( destdesc, , , result );
if result <> 0 then
ERROR( 'Couldn't shut down dest.', result );
{-------------------------------------------------------------}
{ Each pass of this loop receives one name from the client, }
{ and looks up the name. If the name is found, an accept }
{ indication is sent back to the client, followed by the name }
{ information. If the name is not found, a reject indication }
{ is returned to the client. The server will remain in this }
{ loop until it is terminated by the client. On termination, }
{ the vc connection will automatically be shut down. }
{-------------------------------------------------------------}
repeat
RECV( vcdesc, buf, namelength, result );
if result <> 0 then
ERROR( 'Receive from client failed.', result );
for i := 1 to namelength do
name[i] := buf[i];
FIND_NAME( name, info, found );
if found then
begin
buf[1] := chr(indaccept);
IPCSEND( vcdesc, buf, 1, , , result );
if result <> 0 then
ERROR( 'Send to client failed.', result );
IPCSEND( vcdesc, info, infolength, , , result );
if result <> 0 then
ERROR( 'Send to client failed.', result );
end
else{not found}
begin
buf[1] := chr(indreject);
IPCSEND( vcdesc, buf, 1, , , result );
if result <> 0 then
ERROR( 'Send to client failed', result );
end;
until false;
1:{error exit}
end.
|
