HPlogo NetIPC 3000/XL Programmer's Reference Manual: HP 3000 MPE/iX Computer Systems > Appendix D Migration From PTOP to NetIPC and RPM

Example: Client-Server Application

» 

Technical documentation

Complete book in PDF
» Feedback

 » Table of Contents

 » Glossary

 » Index

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;
                 ar 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.
Feedback to webmaster