Date: Wed, 18 Mar 87 13:12:48 est From: David Krowitz Subject: New version of qsend program Here is the latest version of my qsend program. It now is able to handle diskless nodes which have been catalogged in the // directory. (eg. //kanga *** DISKLESS *** partner node: 4892 ) -- David Krowitz ---------------------------------------------------------------------- #! /bin/sh # This is a shell archive, meaning: # 1. Remove everything above the #! /bin/sh line. # 2. Save the resulting text in a file. # 3. Execute the file with /bin/sh (not csh) to create the files: # network.ins.pas # network.pas # qsend.bld # qsend.doc # qsend.doc.install # qsend.hlp # This archive created: Wed Mar 18 13:09:38 1987 export PATH; PATH=/bin:$PATH if test -f 'network.ins.pas' then echo shar: will not over-write existing file "'network.ins.pas'" else cat << \SHAR_EOF > 'network.ins.pas' {***************************************************************************** ***** ***** ***** NETWORK.INS.PAS ***** ***** ***** ***** Insert file for programs using the NETWORK library of ***** ***** routines to get info about the node and users on the ***** ***** Apollo DOMAIN network. ***** ***** Version 6 ***** ***** David M. Krowitz March 17, 1987. ***** ***** ***** ***** Copyright (c) 1987 ***** ***** David M. Krowitz ***** ***** Massachusetts Institute of Technology ***** ***** Department of Earth, Atmospheric, and Planetary Sciences ***** ***************************************************************************** } TYPE network_$node_id_t = array[1..5] of char; network_$entry_dir_t = array[1..32] of char; network_$user_name_t = array[1..32] of char; network_$user_sid_t = array[1..140] of char; network_$pathname_t = array[1..256] of char; network_$node_data_t = RECORD node_id: network_$node_id_t; {5 digit hex. node ID} entry_dir: network_$entry_dir_t; {Entry directory of node} entry_len: integer16; {Length of entry dir} catalog_dir: network_$entry_dir_t; {Name node cataloged by (same as entry dir for nodes with disks)} catalog_len: integer16; {Length of catalog name (0 if diskless node not catalogged)} diskless: boolean; {TRUE if node is diskless} partner_id: network_$node_id_t; {Node ID of partner for diskless nodes} END; network_$node_array_t = array[1..1024] of network_$node_data_t; network_$user_t = RECORD user_sid: network_$user_sid_t; {SID of user logged into nodes' DM} user_len: integer16; {Length of user SID} node_id: network_$node_id_t; {5 digit hex. node ID} entry_dir: network_$entry_dir_t; {Entry directory of node} entry_len: integer16; {Length of entry dir} catalog_dir: network_$entry_dir_t; {Name node cataloged by (same as entry dir for nodes with disks)} catalog_len: integer16; {Length of catalog name (0 if diskless node not catalogged)} diskless: boolean; {TRUE if node is diskless} END; network_$user_array_t = array[1..1024] of network_$user_t; network_$index_list_t = array[1..1024] of pinteger; {List all nodes which are currently responding on the Apollo DOMAIN network. Use the LCNODE command to get a list of all of the currently catalogged nodes.} PROCEDURE network_$list_nodes ( OUT node_array: network_$node_array_t; OUT num_nodes: pinteger );EXTERN; {Check that a given node is on the DOMAIN network and find the index to the node's entry in the list of nodes supplied by NETWORK_$LIST_NODES so that we can look up its node ID.} PROCEDURE network_$find_node ( IN catalog_dir: network_$entry_dir_t; IN catalog_len: pinteger; IN node_list: network_$node_array_t; IN num_nodes: pinteger; OUT index: pinteger );EXTERN; {Check that a given node is on the DOMAIN network and find the index to the node's entry in the list of nodes supplied by NETWORK_$LIST_NODES so that we can look up its entry directory and see whether or not it is a diskless node.} PROCEDURE network_$find_node_id ( IN node_id: network_$node_id_t; IN node_list: network_$node_array_t; IN num_nodes: pinteger; OUT index: pinteger );EXTERN; {List all users logged into the Apollo DOMAIN network. Use the LUSR command to get a list of all of the people who are logged in to the display manager of each node on the network.} PROCEDURE network_$list_users ( OUT user_array: network_$user_array_t; OUT num_users: pinteger );EXTERN; {Find all the nodes that a given user is logged into on the DOMAIN network. Use the list of users logged into each node's display manager which is returned by NETWORK_$LIST_USERS to find which nodes a given user is logged into. Return a list of indices into the user-list for the nodes which they are logged into. Return an index_count of 0 if they are not logged in anywhere.} PROCEDURE network_$find_user ( IN user_name: network_$user_name_t; IN user_name_len: pinteger; IN user_list: network_$user_array_t; IN num_users: pinteger; OUT index_list: network_$index_list_t; OUT index_count: pinteger );EXTERN; {Check that a user is logged into a particular node on the DOMAIN network. Use the list of users logged into each node's display manager which is returned by NETWORK_$LIST_USERS and the list of nodes on the network returned by NETWORK_$LIST_NODES to check if a user is logged into a particular node. Return both an index into the user-list and an index into the node-list. Return index counts of 0 if the user is not logged into the particular node.} PROCEDURE network_$find_user_at_node_id ( IN node: network_$node_id_t; IN user_name: network_$user_name_t; IN user_name_len: pinteger; IN user_list: network_$user_array_t; IN num_users: pinteger; OUT user_index: pinteger );EXTERN; {Return the name of the user who owns this process. Extract the user name from the full user SID of this process (ie. throw away the project, organization, and node ID numbers).} PROCEDURE network_$get_proc_user_name ( OUT user_name: network_$user_name_t; OUT name_length: pinteger );EXTERN; {Return the full SID of the owner of this process. Included with the NETWORK calls for completeness of the library even though it duplicates a PM call.} PROCEDURE network_$get_proc_user_sid ( OUT user_sid: network_$user_sid_t; OUT sid_length: pinteger );EXTERN; {Return the node ID number of the node running this process. Extract the node ID from the full user SID of this process (ie. throw away the user name and the project and organization numbers).} PROCEDURE network_$get_proc_node_id ( OUT user_sid: network_$node_id_t );EXTERN; {Return the entry directory of the node running this process. Extract this info from the full pathname of the `NODE_DATA directory of the node.} PROCEDURE network_$get_proc_entry_dir ( OUT entry_dir: network_$entry_dir_t; OUT entry_len: integer16; OUT diskless_flag: boolean );EXTERN; {Return the home directory of the specified user. The user name can be short (eg. "krowitz") or long with project and organization fields, but not a node ID field (eg. "krowitz.none.jordan"). The name may contain wildcards (eg. "krowitz.%.jordan"), in which case the first matching entry from the registry is returned. Note that the user name is in a variable of the type NETWORK_$USER_SID_T not NETWORK_$USER_NAME_Tin order to provide enough characters for long names and wild cards.} PROCEDURE network_$get_user_home_dir ( IN user_name: network_$user_sid_t; IN name_len: pinteger; OUT home_dir: network_$pathname_t; OUT dir_len: pinteger );EXTERN; {Return the full name of the specified user. The user name is in the short form without wildcards, project, or organization (eg. "krowitz" but not "krowitz.sys_admin" or "krowitz.%.%"). Note that the full name is returned in a variable of the type NETWORK_$USER_SID_T in order to have enough space for the user's full name.} PROCEDURE network_$get_user_full_name ( IN user_name: network_$user_name_t; IN name_len: pinteger; OUT full_name: network_$user_sid_t; OUT full_len: pinteger );EXTERN; SHAR_EOF chmod +x 'network.ins.pas' fi # end of overwriting check if test -f 'network.pas' then echo shar: will not over-write existing file "'network.pas'" else cat << \SHAR_EOF > 'network.pas' {***************************************************************************** ***** ***** ***** NETWORK.PAS ***** ***** ***** ***** Library of routines to get info about the nodes ***** ***** and users on the Apollo DOMAIN network. ***** ***** Version 6 ***** ***** David M. Krowitz March 17, 1987. ***** ***** ***** ***** Copyright (c) 1987 ***** ***** David M. Krowitz ***** ***** Massachusetts Institute of Technology ***** ***** Department of Earth, Atmospheric, and Planetary Sciences ***** ***************************************************************************** } MODULE NETWORK; %NOLIST; %INCLUDE '/sys/ins/base.ins.pas'; %INCLUDE '/sys/ins/name.ins.pas'; %INCLUDE '/sys/ins/pm.ins.pas'; %INCLUDE '/sys/ins/pgm.ins.pas'; %INCLUDE '/sys/ins/streams.ins.pas'; %LIST; CONST {Definitions of some standard ascii control characters} etx = chr(3); {etx (control-C) character} lf = chr(10); {line-feed character} ff = chr(12); {form-feed character} cr = chr(13); {carriage-return character} sub = chr(26); {sub (control-Z) character} esc = chr(27); {escape character} rs = chr(30); {rs character} TYPE network_$node_id_t = array[1..5] of char; network_$entry_dir_t = array[1..32] of char; network_$user_name_t = array[1..32] of char; network_$user_sid_t = array[1..140] of char; network_$pathname_t = array[1..256] of char; network_$node_data_t = RECORD node_id: network_$node_id_t; {5 digit hex. node ID} entry_dir: network_$entry_dir_t; {Entry directory of node} entry_len: integer16; {Length of entry dir} catalog_dir: network_$entry_dir_t; {Name node cataloged by (same as entry dir for nodes with disks)} catalog_len: integer16; {Length of catalog name (0 if diskless node not catalogged)} diskless: boolean; {TRUE if node is diskless} partner_id: network_$node_id_t; {Node ID of partner for diskless nodes} END; network_$node_array_t = array[1..1024] of network_$node_data_t; network_$user_t = RECORD user_sid: network_$user_sid_t; {SID of user logged into nodes' DM} user_len: integer16; {Length of user SID} node_id: network_$node_id_t; {5 digit hex. node ID} entry_dir: network_$entry_dir_t; {Entry directory of node} entry_len: integer16; {Length of entry dir} catalog_dir: network_$entry_dir_t; {Name node cataloged by (same as entry dir for nodes with disks)} catalog_len: integer16; {Length of catalog name (0 if diskless node not catalogged)} diskless: boolean; {TRUE if node is diskless} END; network_$user_array_t = array[1..1024] of network_$user_t; network_$index_list_t = array[1..1024] of pinteger; {List all nodes which are currently responding on the Apollo DOMAIN network. Use the LCNODE command to get a list of all of the currently catalogged nodes.} PROCEDURE network_$list_nodes ( OUT node_array: network_$node_array_t; OUT num_nodes: pinteger ); TYPE input_line_t = array[1..256] of char; VAR i,j,k: INTEGER16; {Counters} args: array[1..2] of ^PGM_$ARG; {Arguments to invoked program} conn_vec: array[0..1] of STREAM_$ID_T; {Stream connection vector} mode: PGM_$MODE; {Program mode} reserved: array[1..8] of char; {Reserved for future use} buffptr: ^input_line_t; {Pointer to buffer for reading LCNODE output} lineptr: ^input_line_t; {Pointer to data returned by GET_REC} linelen: INTEGER32; {Number of bytes of data returned} seek_key: STREAM_$SK_T; {Stream seek-key returned by GET_REC} status: STATUS_$T; {Status returned by PGM calls} BEGIN {Invoke CTNODE -UPDATE to make sure we have the nodes all catalogged correctly before doing the LCNODE command.} conn_vec[0] := STREAM_$STDIN; NEW (args[1]); NEW (args[2]); args[1]^.len := 6; {Length of argument} args[1]^.chars := 'ctnode'; {1st arg. is the program name} args[2]^.len := 7; {Length of 2nd argument} args[2]^.chars := '-update'; {2nd arg. is the arg to the program} mode := [PGM_$WAIT]; PGM_$INVOKE ('/com/ctnode',11,2,args,1,conn_vec,mode,reserved,status); IF (status.all <> 0) THEN BEGIN writeln ('**** NETWORK_$LIST_NODES: Error - CTNODE command failed ****'); PGM_$EXIT; END; {Create a temporary file to hold the output of the LCNODE program. Set up the connection-vector so that this stream will become LCNODE's standard output stream.} STREAM_$CREATE ('',0,STREAM_$OVERWRITE,STREAM_$NO_CONC_WRITE,conn_vec[1],status); IF (status.all <> 0) THEN BEGIN writeln ('**** NETWORK_$LIST_NODES: Error - can not create stream ****'); PGM_$EXIT; END; {Invoke LCNODE to get the info we need, and then close the stream so we can reopen it for reading.} args[1]^.len := 6; {Length of argument} args[1]^.chars := 'lcnode'; {1st arg. is the program name} mode := [PGM_$WAIT]; PGM_$INVOKE ('/com/lcnode',11,1,addr(args),2,conn_vec, mode,reserved,status); IF (status.all <> 0) THEN BEGIN writeln ('**** NETWORK_$LIST_NODES: Error - LCNODE command failed ****'); PGM_$EXIT; END; {Reset the file and read the LCNODE data. The first line is blank, the 2nd line contains the node-ID of this node, the 3rd line contains the number of nodes on the network - 1, the 4th line is blank, the 5th line is the column headings of the node listing, the 6th line is blank, and the node listings start on the 7th line. The first node listed is the node making this call.} STREAM_$SEEK (conn_vec[1],STREAM_$CHR,STREAM_$ABSOLUTE,1,status); IF (status.all <> 0) THEN BEGIN writeln ('**** NETWORK_$LIST_NODES: Error - can not reset stream ****'); PGM_$EXIT; END; {Get the number of other nodes on the network. It starts at the 2nd character of the 3rd line of the listing. The actual number of nodes is one more than the number given in the listing.} NEW (buffptr); STREAM_$GET_REC (conn_vec[1],buffptr,256,lineptr,linelen,seek_key,status); STREAM_$GET_REC (conn_vec[1],buffptr,256,lineptr,linelen,seek_key,status); STREAM_$GET_REC (conn_vec[1],buffptr,256,lineptr,linelen,seek_key,status); IF (status.all <> 0) THEN BEGIN writeln ('**** NETWORK_$LIST_NODES: Error - can not read number of nodes ****'); PGM_$EXIT; END; num_nodes := 0; i := 2; WHILE (lineptr^[i] <> ' ') DO BEGIN num_nodes := num_nodes*10+ORD(lineptr^[i])-ORD('0'); i := i+1; END; num_nodes := num_nodes+1; {Read the node listings into the return array. The 2nd through 6th characters of each line are the node-ID. The entry directory starts with the 52nd character for nodes with disks. For diskless nodes, the name the node is catalogged by starts with the 52nd character. If the node is diskless and not catalogged with any name, the 5nd character is a '*' (start of the string '*** DISKLESS *** partner node:').} STREAM_$GET_REC (conn_vec[1],buffptr,256,lineptr,linelen,seek_key,status); STREAM_$GET_REC (conn_vec[1],buffptr,256,lineptr,linelen,seek_key,status); STREAM_$GET_REC (conn_vec[1],buffptr,256,lineptr,linelen,seek_key,status); FOR i := 1 TO num_nodes DO BEGIN STREAM_$GET_REC (conn_vec[1],buffptr,256,lineptr,linelen,seek_key,status); IF (status.all <> 0) THEN BEGIN writeln ('**** NETWORK_$LIST_NODES: Error - can not read node info ****'); PGM_$EXIT; END; {Extract the node ID from the line. The node ID is left justified and padded with blanks in the LCNODE output, so we can read it directly into the node ID array.} WITH node_array[i] DO BEGIN FOR j := 1 TO 5 DO BEGIN node_id[j] := lineptr^[j+1]; END; {Extract the directory name by which the node is catalogged from the line. If the node is not diskless, then this is also the entry directory. If the node is diskless and not catalogged with any name, then return a length of 0 for the node's catalog name. If node is diskless, extract the 5 character node ID of the partner node. The node ID will be left justified and padded with blanks if necessary.} diskless := FALSE; FOR j := 1 TO linelen DO BEGIN IF (lineptr^[j] = '*') THEN diskless := TRUE; END; IF (diskless = FALSE) THEN BEGIN j := 52; k := 1; WHILE (lineptr^[j] <> lf) DO BEGIN entry_dir[k] := lineptr^[j]; j := j+1; k := k+1; END; entry_len := j-52; FOR j := 1 TO entry_len DO BEGIN catalog_dir[j] := entry_dir[j]; END; catalog_len := entry_len; END ELSE BEGIN IF (lineptr^[52] = '/') THEN BEGIN j := 52; k := 1; WHILE (lineptr^[j] <> ' ') DO BEGIN catalog_dir[k] := lineptr^[j]; j := j+1; k := k+1; END; catalog_len := k-1; END ELSE BEGIN catalog_len := 0; END; FOR k := 1 TO 5 DO partner_id[k] := ' '; j := linelen; WHILE (lineptr^[j-1] <> ' ') DO BEGIN j := j-1; END; k := 1; WHILE (lineptr^[j] <> lf) DO BEGIN partner_id[k] := lineptr^[j]; j := j+1; k := k+1; END; END; END; {End of WITH node_array[i] DO ...} END; {Find the entry directories for any diskless nodes.} FOR i := 1 TO num_nodes DO WITH node_array[i] DO BEGIN IF (node_array[i].diskless = TRUE) THEN BEGIN FOR j := 1 TO num_nodes DO BEGIN IF (i <> j) AND THEN (partner_id[1] = node_array[j].node_id[1]) AND THEN (partner_id[2] = node_array[j].node_id[2]) AND THEN (partner_id[3] = node_array[j].node_id[3]) AND THEN (partner_id[4] = node_array[j].node_id[4]) AND THEN (partner_id[5] = node_array[j].node_id[5]) THEN BEGIN FOR k := 1 TO node_array[j].entry_len DO BEGIN entry_dir[k] := node_array[j].entry_dir[k]; END; entry_len := node_array[j].entry_len; EXIT; END; END; END; END; {All done. Close and delete the file.} STREAM_$CLOSE (conn_vec[1],status); IF (status.all <> 0) THEN BEGIN writeln ('**** NETWORK_$LIST_NODES: Error - can not close stream ****'); PGM_$EXIT; END; END; {End of procedure NETWORK_$LIST_NODES.} {Check that a given node is on the DOMAIN network and find the index to the node's entry in the list of nodes supplied by NETWORK_$LIST_NODES so that we can look up its node ID.} PROCEDURE network_$find_node ( IN catalog_dir: network_$entry_dir_t; IN catalog_len: pinteger; IN node_list: network_$node_array_t; IN num_nodes: pinteger; OUT index: pinteger ); VAR i,j,k: INTEGER16; {Counters} {Some useful internal functions for doing string manipulations} FUNCTION lowercase (IN character: CHAR):CHAR; BEGIN IF (character IN ['A'..'Z']) THEN BEGIN lowercase := CHR(ORD(character)-ORD('A')+ORD('a')) END ELSE BEGIN lowercase := character; END; END; {End of function LOWERCASE.} FUNCTION uppercase (IN character: CHAR):CHAR; BEGIN IF (character IN ['a'..'z']) THEN BEGIN uppercase := CHR(ORD(character)-ORD('a')+ORD('A')) END ELSE BEGIN uppercase := character; END; END; {End of function UPPERCASE.} FUNCTION compare_entries ( IN string1: network_$entry_dir_t; IN len1: pinteger; IN string2: network_$entry_dir_t; IN len2: pinteger ):BOOLEAN; VAR i: pinteger; BEGIN IF (len1 <> len2) THEN BEGIN compare_entries := FALSE; RETURN; END; compare_entries := TRUE; FOR i := 1 TO len1 DO BEGIN IF (uppercase(string1[i]) <> uppercase(string2[i])) THEN BEGIN compare_entries := FALSE; RETURN; END; END; END; {End of function COMPARE_ENTRIES.} {Beginning of main body of NETWORK_$FIND_NODE} BEGIN index := 0; FOR i := 1 TO num_nodes DO BEGIN IF (compare_entries(catalog_dir,catalog_len,node_list[i].catalog_dir,node_list[i].catalog_len) = TRUE) THEN BEGIN index := i; EXIT; END; END; END; {End of procedure NETWORK_$FIND_NODE.} {Check that a given node is on the DOMAIN network and find the index to the node's entry in the list of nodes supplied by NETWORK_$LIST_NODES so that we can look up its entry directory and see whether or not it is a diskless node.} PROCEDURE network_$find_node_id ( IN node_id: network_$node_id_t; IN node_list: network_$node_array_t; IN num_nodes: pinteger; OUT index: pinteger ); VAR i,j,k: INTEGER16; {Counters} {Some useful internal functions for doing string manipulations} FUNCTION lowercase (IN character: CHAR):CHAR; BEGIN IF (character IN ['A'..'Z']) THEN BEGIN lowercase := CHR(ORD(character)-ORD('A')+ORD('a')) END ELSE BEGIN lowercase := character; END; END; {End of function LOWERCASE.} FUNCTION uppercase (IN character: CHAR):CHAR; BEGIN IF (character IN ['a'..'z']) THEN BEGIN uppercase := CHR(ORD(character)-ORD('a')+ORD('A')) END ELSE BEGIN uppercase := character; END; END; {End of function UPPERCASE.} FUNCTION compare_node_ids ( IN string1: network_$node_id_t; IN string2: network_$node_id_t ):BOOLEAN; VAR i: pinteger; BEGIN compare_node_ids := TRUE; FOR i := 1 TO 5 DO BEGIN IF (uppercase(string1[i]) <> uppercase(string2[i])) THEN BEGIN compare_node_ids := FALSE; RETURN; END; END; END; {End of function COMPARE_NODE_IDS.} {Beginning of main body of NETWORK_$FIND_NODE_ID} BEGIN index := 0; FOR i := 1 TO num_nodes DO BEGIN IF (compare_node_ids(node_id,node_list[i].node_id)) THEN BEGIN index := i; EXIT; END; END; END; {End of procedure NETWORK_$FIND_NODE_ID.} {List all users logged into the Apollo DOMAIN network. Use the LUSR command to get a list of all of the people who are logged in to the display manager of each node on the network.} PROCEDURE network_$list_users ( OUT user_array: network_$user_array_t; OUT num_users: pinteger ); TYPE input_line_t = array[1..256] of char; VAR i,j,k: INTEGER16; {Counters} args: array[1..2] of ^PGM_$ARG; {Arguments to invoked program} conn_vec: array[0..1] of STREAM_$ID_T; {Stream connection vector} mode: PGM_$MODE; {Program mode} reserved: array[1..8] of char; {Reserved for future use} buffptr: ^input_line_t; {Pointer to buffer for reading LUSR output} lineptr: ^input_line_t; {Pointer to data returned by GET_REC} linelen: INTEGER32; {Number of bytes of data returned} seek_key: STREAM_$SK_T; {Stream seek-key returned by GET_REC} status: STATUS_$T; {Status returned by PGM calls} BEGIN {Invoke CTNODE -UPDATE to make sure we have the nodes all catalogged correctly before doing the LUSR command.} conn_vec[0] := STREAM_$STDIN; NEW (args[1]); NEW (args[2]); args[1]^.len := 6; {Length of argument} args[1]^.chars := 'ctnode'; {1st arg. is the program name} args[2]^.len := 7; {Length of 2nd argument} args[2]^.chars := '-update'; {2nd arg. is the arg to the program} mode := [PGM_$WAIT]; PGM_$INVOKE ('/com/ctnode',11,2,args,1,conn_vec,mode,reserved,status); IF (status.all <> 0) THEN BEGIN writeln ('**** NETWORK_$LIST_NODES: Error - CTNODE command failed ****'); PGM_$EXIT; END; {Create a temporary file to hold the output of the LUSR program. Set up the connection-vector so that this stream will become LUSR's standard output stream. Then invoke LUSR -FULL to get the desired info.} STREAM_$CREATE ('',0,STREAM_$OVERWRITE,STREAM_$NO_CONC_WRITE, conn_vec[1],status); IF (status.all <> 0) THEN BEGIN writeln ('**** NETWORK_$LIST_USERS: Error - can not create stream ****'); PGM_$EXIT; END; args[1]^.len := 4; {Length of 1st argument} args[1]^.chars := 'lusr'; {1st arg. is the program name} args[2]^.len := 5; {Length of 2nd argument} args[2]^.chars := '-full'; {2nd arg. is the arg to the program} mode := [PGM_$WAIT]; PGM_$INVOKE ('/com/lusr',9,2,args,2,conn_vec,mode,reserved,status); IF (status.all <> 0) THEN BEGIN writeln ('**** NETWORK_$LIST_USERS: Error - LUSR command failed ****'); PGM_$EXIT; END; {Reset the file and read the LUSR data. Each line contains a full user name (SID) of the user who is logged into the DM on that node. Nodes which don't have anyone logged into the DM aren't listed. The last line of the file tells the number of nodes listed out of the total number of nodes on the network which responded to the LUSR program. Each user name is followed by the entry directory of the node or by the entry directory of the node's partner if it is a diskless node.} STREAM_$SEEK (conn_vec[1],STREAM_$CHR,STREAM_$ABSOLUTE,1,status); IF (status.all <> 0) THEN BEGIN writeln ('**** NETWORK_$LIST_USERS: Error - can not reset stream ****'); PGM_$EXIT; END; num_users := 0; {Read a line, if it's not blank, then the line contains a user name and an entry directory. Otherwise, the line is the second to last line in the listing. The user name starts with the 5th character of the line and ends with the first space following that character. The node-id is the last 1 to 5 characters of the user name. The entry directory starts with the 37th character unless the node is diskless. If the node is diskless and it is catalogged with some name in the // directory, then its catalog name starts in column 50 (with '//'). If the node does not have a name that it is catalogged by then return 0 for the length of the catalog name.} i := 0; NEW (buffptr); REPEAT STREAM_$GET_REC (conn_vec[1],buffptr,256,lineptr, linelen,seek_key,status); IF (status.all <> 0) THEN BEGIN writeln ('**** NETWORK_$LIST_USERS: Error - can not read user info ****'); PGM_$EXIT; END; IF (lineptr^[1] <> lf) AND (linelen <> 1) THEN BEGIN i := i+1; {Extract the user's SID from the line.} j := 5; k := 1; WHILE (lineptr^[j] <> ' ') DO BEGIN user_array[i].user_sid[k] := lineptr^[j]; j := j+1; k := k+1; END; user_array[i].user_len := k-1; {Extract the node's ID from the user's SID.} FOR j := 1 TO 5 DO BEGIN user_array[i].node_id[j] := ' '; END; j := 1; FOR k := 1 TO 3 DO BEGIN WHILE (user_array[i].user_sid[j] <> '.') DO j := j+1; j := j+1; END; k := 1; WHILE (j <= user_array[i].user_len) DO BEGIN IF (user_array[i].user_sid[j] <> '.') THEN BEGIN user_array[i].node_id[k] := user_array[i].user_sid[j]; k := k+1; j := j+1; END ELSE EXIT; END; {Extract the node's entry directory from the line. If the node is not diskless then this is the same as the node's catalogged name.} WITH user_array[i] DO BEGIN diskless := FALSE; FOR j := 1 TO linelen DO BEGIN IF (lineptr^[j] = '*') THEN diskless := TRUE; END; j := linelen; WHILE (lineptr^[j-1] <> ' ') DO BEGIN j := j-1; END; FOR k := j to linelen DO BEGIN entry_dir[k-j+1] := lineptr^[k]; END; entry_len := linelen-j; IF (diskless = FALSE) THEN BEGIN FOR j := 1 TO entry_len DO BEGIN catalog_dir[j] := entry_dir[j]; END; catalog_len := entry_len; END ELSE IF (lineptr^[50] = '/') THEN BEGIN j := 50; k := 1; WHILE (lineptr^[j] <> ' ') DO BEGIN catalog_dir[k] := lineptr^[j]; j := j+1; k := k+1; END; catalog_len := j-50; END ELSE BEGIN catalog_len := 0; END; END; END; UNTIL (lineptr^[1] = lf) AND (linelen = 1); {All done. Return total number of users list and close the file. Since it's temporary it will be deleted upon closing.} num_users := i; STREAM_$CLOSE (conn_vec[1],status); IF (status.all <> 0) THEN BEGIN writeln ('**** NETWORK_$LIST_USERS: Error - can not close stream ****'); PGM_$EXIT; END; END; {End of procedure NETWORK_$LIST_USERS.} {Find all the nodes that a given user is logged into on the DOMAIN network. Use the list of users logged into each node's display manager which is returned by NETWORK_$LIST_USERS to find which nodes a given user is logged into. Return a list of indices into the user-list for the nodes which they are logged into. Return an index_count of 0 if they are not logged in anywhere.} PROCEDURE network_$find_user ( IN user_name: network_$user_name_t; IN user_name_len: pinteger; IN user_list: network_$user_array_t; IN num_users: pinteger; OUT index_list: network_$index_list_t; OUT index_count: pinteger ); VAR i,j,k: INTEGER16; {Counters} name: network_$user_name_t; {User name extracted from user SID} name_len: pinteger; {Length of user name} {Some useful internal functions for doing string manipulations} FUNCTION lowercase (IN character: CHAR):CHAR; BEGIN IF (character IN ['A'..'Z']) THEN BEGIN lowercase := CHR(ORD(character)-ORD('A')+ORD('a')) END ELSE BEGIN lowercase := character; END; END; {End of function LOWERCASE.} FUNCTION uppercase (IN character: CHAR):CHAR; BEGIN IF (character IN ['a'..'z']) THEN BEGIN uppercase := CHR(ORD(character)-ORD('a')+ORD('A')) END ELSE BEGIN uppercase := character; END; END; {End of function UPPERCASE.} FUNCTION compare_names ( IN string1: network_$user_name_t; IN len1: pinteger; IN string2: network_$user_name_t; IN len2: pinteger ):BOOLEAN; VAR i: pinteger; BEGIN IF (len1 <> len2) THEN BEGIN compare_names := FALSE; RETURN; END; compare_names := TRUE; FOR i := 1 TO len1 DO BEGIN IF (uppercase(string1[i]) <> uppercase(string2[i])) THEN BEGIN compare_names := FALSE; RETURN; END; END; END; {End of function COMPARE_NAMES.} PROCEDURE extract_name_from_sid ( IN sid: network_$user_sid_t; IN sid_len: pinteger; OUT name: network_$user_name_t; OUT name_len: pinteger ); VAR i: pinteger; BEGIN i := 1; WHILE (sid[i] <> '.') DO BEGIN name[i] := sid[i]; i := i+1; END; name_len := i-1; END; {End of function EXTRACT_NAME_FROM_SID.} {Beginning of main body of NETWORK_$FIND_USER} BEGIN index_count := 0; FOR i := 1 TO num_users DO WITH user_list[i] DO BEGIN extract_name_from_sid (user_sid,user_len,name,name_len); IF (compare_names(user_name,user_name_len,name,name_len)) THEN BEGIN index_count := index_count+1; index_list[index_count] := i; END; END; END; {End of procedure NETWORK_$FIND_USER.} {Check that a user is logged into a particular node on the DOMAIN network. Use the list of users logged into each node's display manager which is returned by NETWORK_$LIST_USERS and the list of nodes on the network returned by NETWORK_$LIST_NODES to check if a user is logged into a particular node. Return both an index into the user-list and an index into the node-list. Return index counts of 0 if the user is not logged into the particular node.} PROCEDURE network_$find_user_at_node_id ( IN node: network_$node_id_t; IN user_name: network_$user_name_t; IN user_name_len: pinteger; IN user_list: network_$user_array_t; IN num_users: pinteger; OUT user_index: pinteger ); VAR i,j,k: INTEGER16; {Counters} name: network_$user_name_t; {User name extracted from user SID} name_len: pinteger; {Length of user name} {Some useful internal functions for doing string manipulations} FUNCTION lowercase (IN character: CHAR):CHAR; BEGIN IF (character IN ['A'..'Z']) THEN BEGIN lowercase := CHR(ORD(character)-ORD('A')+ORD('a')) END ELSE BEGIN lowercase := character; END; END; {End of function LOWERCASE.} FUNCTION uppercase (IN character: CHAR):CHAR; BEGIN IF (character IN ['a'..'z']) THEN BEGIN uppercase := CHR(ORD(character)-ORD('a')+ORD('A')) END ELSE BEGIN uppercase := character; END; END; {End of function UPPERCASE.} FUNCTION compare_names ( IN string1: network_$user_name_t; IN len1: pinteger; IN string2: network_$user_name_t; IN len2: pinteger ):BOOLEAN; VAR i: pinteger; BEGIN IF (len1 <> len2) THEN BEGIN compare_names := FALSE; RETURN; END; compare_names := TRUE; FOR i := 1 TO len1 DO BEGIN IF (uppercase(string1[i]) <> uppercase(string2[i])) THEN BEGIN compare_names := FALSE; RETURN; END; END; END; {End of function COMPARE_NAMES.} FUNCTION compare_nodes ( IN string1: network_$node_id_t; IN string2: network_$node_id_t ):BOOLEAN; VAR i: pinteger; BEGIN compare_nodes := TRUE; FOR i := 1 TO 5 DO BEGIN IF (uppercase(string1[i]) <> uppercase(string2[i])) THEN BEGIN compare_nodes := FALSE; RETURN; END; END; END; {End of function COMPARE_NODES.} PROCEDURE extract_name_from_sid ( IN sid: network_$user_sid_t; IN sid_len: pinteger; OUT name: network_$user_name_t; OUT name_len: pinteger ); VAR i: pinteger; BEGIN i := 1; WHILE (sid[i] <> '.') DO BEGIN name[i] := sid[i]; i := i+1; END; name_len := i-1; END; {End of function EXTRACT_NAME_FROM_SID.} {Beginning of main body of NETWORK_$FIND_USER_AT_NODE} BEGIN user_index := 0; FOR i := 1 TO num_users DO WITH user_list[i] DO BEGIN extract_name_from_sid (user_sid,user_len,name,name_len); IF (compare_names(user_name,user_name_len,name,name_len)) AND (compare_nodes(node,node_id))THEN BEGIN user_index := i; EXIT; END; END; END; {End of procedure NETWORK_$FIND_USER_AT_NODE.} {Return the name of the user who owns this process. Extract the user name from the full user SID of this process (ie. throw away the project, organization, and node ID numbers).} PROCEDURE network_$get_proc_user_name ( OUT user_name: network_$user_name_t; OUT name_length: pinteger ); VAR sid: array[1..140] of char; {The complete SID returned for this process} sid_len: pinteger; {The length of the SID returned} i: pinteger; {Counter} BEGIN PM_$GET_SID_TXT (140,sid,sid_len); i := 1; WHILE (sid[i] <> '.') DO BEGIN user_name[i] := sid[i]; i := i+1; END; name_length := i-1; END; {End of procedure NETWORK_$GET_PROC_USER_NAME.} {Return the full SID of the owner of this process. Included with the NETWORK calls for completeness of the library even though it duplicates a PM call.} PROCEDURE network_$get_proc_user_sid ( OUT user_sid: network_$user_sid_t; OUT sid_length: pinteger ); BEGIN PM_$GET_SID_TXT (140,user_sid,sid_length); END; {End of procedure NETWORK_$GET_PROC_USER_SID.} {Return the node ID number of the node running this process. Extract the node ID from the full user SID of this process (ie. throw away the user name and the project and organization numbers). Note that the node ID is the 4th field of up to 5 fields in the SID (ie. LUSR -ALLP will show some processes as: user.server.none.252C.LOGIN).} PROCEDURE network_$get_proc_node_id ( OUT node_id: network_$node_id_t ); VAR sid: array[1..140] of char; {The complete SID returned for this process} sid_len: pinteger; {The length of the SID returned} i,j: pinteger; {Counters} BEGIN PM_$GET_SID_TXT (140,sid,sid_len); FOR i := 1 TO 5 DO node_id[i] := ' '; j := 1; FOR i := 1 TO 3 DO BEGIN WHILE (sid[j] <> '.') DO j := j+1; j := j+1; END; i := 1; WHILE (j <= sid_len) DO BEGIN IF (sid[j] <> '.') THEN BEGIN node_id[i] := sid[j]; i := i+1; j := j+1; END ELSE EXIT; END; END; {End of procedure NETWORK_$GET_PROC_NODE_ID.} {Return the entry directory of the node running this process. Extract this info from the full pathname of the `NODE_DATA directory of the node.} PROCEDURE network_$get_proc_entry_dir ( OUT entry_dir: network_$entry_dir_t; OUT entry_len: integer16; OUT diskless_flag: boolean ); VAR i,j,k: INTEGER16; {Counters} full_path: array[1..256] of char; {Full pathname of `NODE_DATA directory} full_len: INTEGER16; {Length of full pathname} status: STATUS_$T; {Status returned by NAME calls} BEGIN {Get the full pathname of the `NODE_DATA directory of the node running this process. Then extract the entry directory from the full pathname.} NAME_$GET_PATH ('`node_data',10,full_path,full_len,status); IF (status.all <> 0) THEN BEGIN writeln ('**** NETWORK_$GET_PROC_ENTRY_DIR: Error - can not get full pathname ****'); PGM_$EXIT; END; IF (full_len <= 2) THEN BEGIN writeln ('**** NETWORK_$GET_PROC_ENTRY_DIR: Error - full pathname too short ****'); PGM_$EXIT; END; entry_dir[1] := '/'; entry_dir[2] := '/'; i := 3; WHILE (full_path[i] <> '/') DO BEGIN entry_dir[i] := full_path[i]; i := i+1; END; entry_len := i-1; diskless_flag := FALSE; j := i+1; WHILE (j <= full_len) DO BEGIN IF (full_path[j] = '.') THEN BEGIN diskless_flag := TRUE; EXIT; END ELSE BEGIN j := j+1; END; END; END; {End of procedure NETWORK_$GET_PROC_ENTRY_DIR.} {Return the home directory of the specified user. The user name can be short (eg. "krowitz") or long with project and organization fields, but not a node ID field (eg. "krowitz.none.jordan"). The name may contain wildcards (eg. "krowitz.%.jordan"), in which case the first matching entry from the registry is returned. Note that the user name is in a variable of the type NETWORK_$USER_SID_T not NETWORK_$USER_NAME_Tin order to provide enough characters for long names and wild cards.} PROCEDURE network_$get_user_home_dir ( IN user_name: network_$user_sid_t; IN name_len: pinteger; OUT home_dir: network_$pathname_t; OUT dir_len: pinteger ); TYPE input_line_t = array[1..256] of char; VAR i,j,k: INTEGER16; {Counters} args: array[1..3] of ^PGM_$ARG; {Arguments to invoked program} conn_vec: array[0..1] of STREAM_$ID_T; {Stream connection vector} mode: PGM_$MODE; {Program mode} reserved: array[1..8] of char; {Reserved for future use} buffptr: ^input_line_t; {Pointer to buffer for reading LCNODE output} lineptr: ^input_line_t; {Pointer to data returned by GET_REC} linelen: INTEGER32; {Number of bytes of data returned} seek_key: STREAM_$SK_T; {Stream seek-key returned by GET_REC} status: STATUS_$T; {Status returned by PGM calls} BEGIN {Create a temporary file to hold the output of the EDACCT program. Set up the connection-vector so that this stream will become EDACCT's standard output stream.} conn_vec[0] := STREAM_$STDIN; STREAM_$CREATE ('',0,STREAM_$OVERWRITE,STREAM_$NO_CONC_WRITE,conn_vec[1],status); IF (status.all <> 0) THEN BEGIN writeln ('**** NETWORK_$GET_USER_HOME_DIR: Error - can not create stream ****'); PGM_$EXIT; END; {Invoke EDACCT -L to get the info we need, and then close the stream so we can reopen it for reading.} NEW (args[1]); NEW (args[2]); NEW (args[3]); args[1]^.len := 6; {Length of argument} args[1]^.chars := 'edacct'; {1st arg. is the program name} args[2]^.len := 2; {Length of 2nd argument} args[2]^.chars := '-l'; {2nd arg. is the arg to the program} i := 1; WHILE (i <= name_len) DO BEGIN IF (user_name[i] <> ' ') THEN BEGIN args[3]^.chars[i] := user_name[i]; i := i+1; END ELSE EXIT; END; args[3]^.len := i-1; mode := [PGM_$WAIT]; PGM_$INVOKE ('/com/edacct',11,3,args,2,conn_vec, mode,reserved,status); {If status was non-zero, then EDACCT couldn't find the user name in the registry. Just return a null home directory.} IF (status.all <> 0) THEN BEGIN dir_len := 0; FOR i := 1 TO 256 DO home_dir[i] := ' '; END ELSE BEGIN {Reset the file and read the EDACCT data. The first line contains the username, project, and organization seperated by spaces followed by the home directory which begins in column 35.} STREAM_$SEEK (conn_vec[1],STREAM_$CHR,STREAM_$ABSOLUTE,1,status); IF (status.all <> 0) THEN BEGIN writeln ('**** NETWORK_$GET_USER_HOME_DIR: Error - can not reset stream ****'); PGM_$EXIT; END; NEW (buffptr); STREAM_$GET_REC (conn_vec[1],buffptr,256,lineptr,linelen,seek_key,status); IF (status.all <> 0) THEN BEGIN writeln ('**** NETWORK_$GET_USER_HOME_DIR: Error - can not read user info ****'); PGM_$EXIT; END; i := 35; j := 1; WHILE (lineptr^[i] <> ' ') AND (lineptr^[i] <> lf) DO BEGIN home_dir[j] := lineptr^[i]; j := j+1; i := i+1; END; dir_len := j-1; END; {All done. Close and delete the file.} STREAM_$CLOSE (conn_vec[1],status); IF (status.all <> 0) THEN BEGIN writeln ('**** NETWORK_$GET_USER_HOME_DIR: Error - can not close stream ****'); PGM_$EXIT; END; END; {End of procedure NETWORK_$GET_USER_HOME_DIR.} {Return the full name of the specified user. The user name is in the short form without wildcards, project, or organization (eg. "krowitz" but not "krowitz.sys_admin" or "krowitz.%.%"). Note that the full name is returned in a variable of the type NETWORK_$USER_SID_T in order to have enough space for the user's full name.} PROCEDURE network_$get_user_full_name ( IN user_name: network_$user_name_t; IN name_len: pinteger; OUT full_name: network_$user_sid_t; OUT full_len: pinteger ); TYPE input_line_t = array[1..256] of char; VAR i,j,k: INTEGER16; {Counters} args: array[1..3] of ^PGM_$ARG; {Arguments to invoked program} conn_vec: array[0..1] of STREAM_$ID_T; {Stream connection vector} mode: PGM_$MODE; {Program mode} reserved: array[1..8] of char; {Reserved for future use} buffptr: ^input_line_t; {Pointer to buffer for reading LCNODE output} lineptr: ^input_line_t; {Pointer to data returned by GET_REC} linelen: INTEGER32; {Number of bytes of data returned} seek_key: STREAM_$SK_T; {Stream seek-key returned by GET_REC} status: STATUS_$T; {Status returned by PGM calls} BEGIN {Create a temporary file to hold the output of the EDPPO program. Set up the connection-vector so that this stream will become EDPPO's standard output stream.} conn_vec[0] := STREAM_$STDIN; STREAM_$CREATE ('',0,STREAM_$OVERWRITE,STREAM_$NO_CONC_WRITE,conn_vec[1],status); IF (status.all <> 0) THEN BEGIN writeln ('**** NETWORK_$GET_USER_FULL_NAME: Error - can not create stream ****'); PGM_$EXIT; END; {Invoke EDPPO -L to get the info we need, and then close the stream so we can reopen it for reading.} NEW (args[1]); NEW (args[2]); NEW (args[3]); args[1]^.len := 5; {Length of argument} args[1]^.chars := 'edppo'; {1st arg. is the program name} args[2]^.len := 3; {Length of 2nd argument} args[2]^.chars := '-lf'; {2nd arg. is the arg to the program} i := 1; WHILE (i <= name_len) DO BEGIN IF (user_name[i] <> ' ') THEN BEGIN args[3]^.chars[i] := user_name[i]; i := i+1; END ELSE EXIT; END; args[3]^.len := i-1; mode := [PGM_$WAIT]; PGM_$INVOKE ('/com/edppo',10,3,args,2,conn_vec, mode,reserved,status); {If status was non-zero, then EDACCT couldn't find the user name in the registry. Just return a null full name.} IF (status.all <> 0) THEN BEGIN full_len := 0; FOR i := 1 TO 140 DO full_name[i] := ' '; END ELSE BEGIN {Reset the file and read the EDPPO data. The first line contains the username followed by the full user name which begins in column 20.} STREAM_$SEEK (conn_vec[1],STREAM_$CHR,STREAM_$ABSOLUTE,1,status); IF (status.all <> 0) THEN BEGIN writeln ('**** NETWORK_$GET_USER_FULL_NAME: Error - can not reset stream ****'); PGM_$EXIT; END; NEW (buffptr); STREAM_$GET_REC (conn_vec[1],buffptr,256,lineptr,linelen,seek_key,status); IF (status.all <> 0) THEN BEGIN writeln ('**** NETWORK_$GET_USER_FULL_NAME: Error - can not read user info ****'); PGM_$EXIT; END; i := 20; j := 1; WHILE (lineptr^[i] <> lf) DO BEGIN full_name[j] := lineptr^[i]; j := j+1; i := i+1; END; full_len := j-1; END; {All done. Close and delete the file.} STREAM_$CLOSE (conn_vec[1],status); IF (status.all <> 0) THEN BEGIN writeln ('**** NETWORK_$GET_USER_FULL_NAME: Error - can not close stream ****'); PGM_$EXIT; END; END; {End of procedure NETWORK_$GET_USER_FULL_NAME.} {***** End of module NETWORK *****} SHAR_EOF chmod +x 'network.pas' fi # end of overwriting check if test -f 'qsend.bld' then echo shar: will not over-write existing file "'qsend.bld'" else cat << \SHAR_EOF > 'qsend.bld' von pas qsend.pas -opt 3 pas network.pas -opt 3 bind -b qsend qsend.bin network.bin voff SHAR_EOF chmod +x 'qsend.bld' fi # end of overwriting check if test -f 'qsend.doc' then echo shar: will not over-write existing file "'qsend.doc'" else cat << \SHAR_EOF > 'qsend.doc' ******************************************************************************* ***** ***** ***** QSEND.DOC ***** ***** Version 10 ***** ***** Program Notes for the QSEND Message Sending Program ***** ***** ***** ***** Copyright (c) 1987 ***** ***** David M. Krowitz ***** ***** Massachusetts Institute of Technology ***** ***** Department of Earth, Atmosheric, and Planetary Sciences ***** ******************************************************************************* Description of the QSEND Message Sending Package ------------------------------------------------ The QSEND package consists of two programs a message-sending program (QSEND) which can send a message to any logged in user or node on the Apollo Domain network and a message-receiving program (QSEND_SERVER) which waits for incoming messages and displays them in a window which it pop up on the node. The programs are based on a set of network information routines which look up the current list of catalogged nodes and users logged into the display manager. These routines are, in turn, based upon invoking the LCNODE and LUSR commands to get the necessary network status information. As a result, QSEND is very flexible. It does not rely on any central node in the network to act as a server, it does not require a predetermined list of available nodes and/or users on the network, and it does not require any specific disk volume in the network to be mounted. Each node relies only upon its own MBX_HELPER, its own QSEND_SERVER, and a mailbox in its own NODE_DATA directory to receive messages. The node is totally independent of any other node in the network. Nodes can be shut down and restarted, diskless nodes can change partners, users can logout and login again on another node and QSEND will still be able to get the message to the desired recipient. The one drawback to this method is that on large Apollo networks the LCNODE and LUSR commands can take a long time to return the network status information which QSEND needs in order to determine where to find a particular user and where a node's entry directory is located (for diskless nodes). On very large networks this could limit the usefulness of the program. The network info routines have been kept seperate from the main body of the QSEND and QSEND_SERVER programs so that if a better means of gathering up to date network status information becomes available the QSEND package can be modified to take advantage of it. Using QSEND ----------- To send a message to up to 64 users and/or nodes, simply type the command: QSEND recipient-1 recipient-2 ... recipient-64 (eg. qsend john mary //node1 george@node2 ) QSEND will then ask you for a one line subject of the message after which you can enter as many lines of text as you wish, ending the message with a control-Z (the end-of-file character. Note that if you have logged into an Apollo node from another machine with TELNET that the end-of-file character may be something other than a control-Z. In particular, if you have logged into an Apollo node with TELNET from a DSP9000 (an Alliant FX/1 or FX/8) you will need to type a control-D instead of a control-Z). QSEND will then determine where each of the recipients is logged in (if anywhere) and determine where to find the mailboxes of the QSEND_SERVER's running on those nodes. If you do not list any recipients on the command line, QSEND will prompt you for a list before asking for the subject line. QSEND recognizes six different formats of recipients names which are listed below along with four different switches. The switches may be entered either on the command line along with the recipient names or when the program prompts you for a list of recipients. The name formats which are recognized are: USER (eg. 'john') Sends a copy of the message to every node on which john.%.%.% is logged into the display manager. USER@NODE (eg. 'john@bert') Sends one copy of the message to the node //BERT only if john.%.%.% is logged in there. USER@NODE_ID (eg. 'john@3115') Sends one copy of the message to node 3115 only if john.%.%.% is logged in there. @NODE (eg. '@bert') Sends one copy of the message to the node //BERT regardless of whether or not anyone is logged in on the node. @NODE_ID (eg. '@3115') Sends one copy of the message to node 3115 regardless of whether or not anyone is logged in on the node. //NODE (eg. '//bert') Sends one copy of the message to the node //BERT regardless of whether or not anyone is logged in on the node. The switches which are recognized are: -ME Sends a copy of the message to each node on which the owner of the process is logged into. Useful for background jobs notifying their owner that they have completed. Note that it sends to the owner of the process which is running the QSEND program, which may be different from the person who is logged into the display manager of the node (they could have CRP'd onto the node from another node). -NODE Sends one copy of the message to the node on which the QSEND program is running. Useful for background jobs notifying the user of the node of some condition (eg. 'the print server on this node has died, please start a new one with the CPS command'). Also good for displaying the message of the day when someone is logging into the node. (eg. in the node's STARTUP_LOGIN file have a line like IF EXISTF MESSAGE_FILE THEN QSEND -NODE ...). -ALLUSERS Sends a copy of the message to every node in the network which has someone logged into the display manager. Useful for system-wide notices (eg. 'Everyone please logout -- diskless node server going down in 5 minutes -- your node will crash unless it is shutdown'). -ALLNODES Sends a copy of the message to every node in the network regardless of whether or not anyone is logged in on that node. Useful for system wide messages which you want people to see before they try to login (eg. 'the 500 Mbyte disk is dead, it will not be up again until tomorrow ...'). -FILE Uses the contents of the specified file as the main body of the message to be sent. Useful for sending precanned messages (eg. a message of the day). -SUBJECT Uses the specified text string for the text of the SUBJECT line of the message. If the string contains spaces, it must be enclosed in single or double quotes. Also useful for sending precanned messages (eg. a message of the day). -DEBUG Prints out debugging info while the program is processing the message and trying to find the mailbox of the server. Note that the -ME, -NODE, -ALLUSERS, and -ALLNODES switches are recognized if they appear either on the command line (eg. qsend -me) or if they are given in response to the TO: prompt (if there were no recipients given on the command line). The -FILE, -SUBJECT, and -DEBUG switches are only recognized if they occur on the command line. Running the QSEND_SERVER ------------------------ The QSEND_SERVER program must be running on a node in order for it to receive and display messages. QSEND will give a warning to the user if they try to send a message to a node which does not have a server running. You can run the QSEND_SERVER program in a regular window by typing the command QSEND_SERVER, and it will print out some diagnostic messages as it receives and displays messages. Alternatively, you can run the program as a server process (so that it does not go away when you logout) by using the CPS command to create a process with server status to run the QSEND_SERVER program (ie. CPS /COM/QSEND_SERVER -N QSEND_SERVER). Once the server is running it will create a mailbox in the node's `NODE_DATA directory after which it is ready to receive messages. The server can process up to four incoming messages simultaneously. It can display much more than four messages on the screen at one time, the limit is on the number of messages it can be in the process of receiving at the same time. The QSEND_SERVER will place each message that it receives on the screen in a slightly different position so that the message windows do not completely obscure each other. Normally, the window is made large enough to hold the complete message, but in some cases the message may be too long to fit on the screen. In this case the window will be made as large as is possible and the pad-scrolling keys can be used to look at the rest of the message. The message windows can be deleted by simply placing the cursor in the window and typing a control-N or hitting the 'exit' key on the keyboard. Differences Between Program Versions of QSEND --------------------------------------------- Version 7 --------- First released version. Handles up to 64 different user names, node name/ID's, and switches in the TO: line. Does not read names/nodes/switches on the command line yet. Version 8 --------- Same as version 7 except now reads names/nodes/switches from the command line. If no recipients given on the command line, then QSEND will give the TO: prompt for recipients before asking for the subject of the message. Version 9 --------- Added the -FILE and -SUBJECT switches to make it easier to use QSEND for sending a message of the day and for doing bulletin board messages. Also added time and date that the message was sent to the message header. Version 10 ---------- Added the -DEBUG switches to make it easier to find problems with QSEND's method of finding the mailbox of the server program. Also beefed up the network info routines so that they can recognize diskless nodes which have been catalogged on the network. (eg. //kanga *** DISKLESS *** partner node: 4892) Differences Between Program Versions of QSEND_SERVER ---------------------------------------------------- Version 7 --------- First released version. Handles up to 4 incoming messages simultaneously. Can display an unlimited number of messages on the screen, limit of 4 is only on the number of messages that are in the process of being received at once. Version 8 --------- Made minor change in way the number of lines in a message are counted to allow the -FILE option of QSEND to work correctly. Also added a line in the message header giving the date and time the message was sent. Files Needed for the QSEND Package ---------------------------------- The files which are provided for the QSEND package are: QSEND.DOC - This file. QSEND.DOC.INSTALL - Documentation on how to install the QSEND package on your network. QSEND.HLP - Help file for using QSEND. QSEND.PAS - The source code for the QSEND message sending program. QSEND_SERVER.PAS - The source code for the QSEND message message receiving and display program. QSEND.INS.PAS - Insert file defining common data structures for QSEND and QSEND_SERVER. NETWORK.PAS - Library of subroutines to get info about the nodes and users on the Domain network. NETWORK.INS.PAS - Insert file defining data type and procedure calls for NETWORK library. QSEND.BLD - Command file to compile and bind the QSEND program. QSEND_SERVER.BLD - Command file to compile and bind the QSEND_SERVER program. QSEND - A ready to run copy of the QSEND program (in case you don't have a Pascal compiler). QSEND_SERVER - A ready to run copy of the QSEND_SERVER program (in case you don't have a Pascal compiler). You will also need the following standard Apollo-supplied files: /SYS/INS/BASE.INS.PAS - These are all standard insert files which /SYS/INS/CAL.INS.PAS are used by QSEND, QSEND_SERVER, or the /SYS/INS/GPR.INS.PAS NETWORK library. /SYS/INS/MBX.INS.PAS /SYS/INS/NAME.INS.PAS /SYS/INS/PAD.INS.PAS /SYS/INS/PFM.INS.PAS /SYS/INS/PGM.INS.PAS /SYS/INS/PM.INS.PAS /SYS/INS/STREAMS.INS.PAS /SYS/INS/TIME.INS.PAS /SYS/INS/TONE.INS.PAS /SYS/INS/VFMT.INS.PAS Bugs, Questions, and Improvements --------------------------------- If you find a bugs in the QSEND package, have questions on how to install or use it, or have a good idea for improving the program please feel free to contact me at the address below. David M. Krowitz MIT dept. of Earth, Atmospheric, and Planetary Sciences Room 54-527 Cambridge, MA 02139 (617) 253-6180 network mailing address: mit-erl!mit-kermit!krowitz@eddie.mit.edu mit-erl!mit-kermit!krowitz@mit-eddie.arpa david@mit-mc.arpa (in order of decreasing preference) SHAR_EOF chmod +x 'qsend.doc' fi # end of overwriting check if test -f 'qsend.doc.install' then echo shar: will not over-write existing file "'qsend.doc.install'" else cat << \SHAR_EOF > 'qsend.doc.install' ******************************************************************************* ***** ***** ***** QSEND.DOC.INSTALL ***** ***** Version 8 ***** ***** Installing the QSEND Message Sending Program ***** ***** ***** ***** Copyright (c) 1986 ***** ***** David M. Krowitz ***** ***** Massachusetts Institute of Technology ***** ***** Department of Earth, Atmosheric, and Planetary Sciences ***** ******************************************************************************* Read the general installation and documentation notes in QSEND.DOC if you have not already done so. Then use the shell script files QSEND.BLD and QSEND_SERVER.BLD to compile the QSEND program, its network-information subroutine library (NETWORK.PAS), and the QSEND_SERVER program. Then copy the file QSEND (the message sending program) to /COM/QSEND on every node in your network from which you want to be able to send messages (or which is the partner for diskless nodes from which you want to be able to send messages). Then copy the file QSEND_SERVER (the message receiving program) to /COM/QSEND_SERVER on every node in your network which you want to be able to receive messages. Note that file server nodes (DSP80's , DSP90's, DSP160's, and DSP3000's) can not receive messages since they have no screen on which to display the messages. However, file servers which have diskless partners will need a copy of the QSEND_SERVER for the partners. All machines should have a copy of QSEND, since any machine is capable of sending a message whether or not it has a screen on which to receive messages. Also note that the DSP9000 machines can neither send nor receive messages with the current implemenation of QSEND because the DSP9000 machines are not part of the Apollo ringnet and do not have the networking facilities which are the basis of QSEND. Finally, copy the file QSEND.HLP to the /SYS/HELP directory of every node in your network (including file servers) which has a help directory. Once the QSEND and QSEND_SERVER programs have been copied to the nodes in your network, the QSEND_SERVER program must be started on each node which is to receive messages. This can be done by typing the following display manager command on each node: CPS /COM/QSEND_SERVER -N QSEND_SERVER If you want to run the QSEND server automatically when the system is brought up, add the following command line to your node's startup file in `NODE_DATA (eg. the file `NODE_DATA/STARTUP.19L or `NODE_DATA/STARTUP.COLOR): ### ### To startup message sending and receiving server. ### CPS /COM/QSEND_SERVER -N QSEND_SERVER This will run the QSEND server program automatically when the node is brought up and will give it the process a server status so that you can logout and leave the server running. You can also run the QSEND server program in a normal window for debugging purposes. The program will print out various values each time it receives a message to make it easier to track down problems will the mailbox facility and the pad/windowing facility. When the QSEND_SERVER program is running on the nodes which you wish to be able to receive messages then you can begin sending messages with the QSEND program. Simply type the command: QSEND ... to send a message to up to 64 different users and/or nodes. (A message may actually be sent to more than 64 different users and/or nodes by using the recipient names -ALLUSERS or -ALLNODES). If no recipients are specified, the QSEND program will prompt you for a list of recipients before asking for the subject of the message and the message itself. SHAR_EOF chmod +x 'qsend.doc.install' fi # end of overwriting check if test -f 'qsend.hlp' then echo shar: will not over-write existing file "'qsend.hlp'" else cat << \SHAR_EOF > 'qsend.hlp' 9.0;qsend (quick_send), revision 9.0, 86/13/04 QSEND (QUICK_SEND) -- Send a message. usage: QSEND [recipient list] [-ME] [-NODE] [-ALLNODES] [-ALLUSERS] [-FILE] [-SUBJECT] FORMAT QSEND [recipient list] [options] QSEND sends a message to up to 64 different users and/or nodes on the Domain network which are running the QSEND_SERVER program to display the message on the screen. If -ALLNODES or -ALLUSERS is specified as one of the 64 users/nodes then the message can be sent to up to 1024 nodes on the network. ARGUMENTS recipient list (optional) List of names of users and/or nodes which are to receive a copy of the message. The various name formats which are understood are: USERNAME (eg. 'beth' or 'jsr') USERNAME@NODE (eg. 'beth@bert' or 'jsr@ernie') USERNAME@NODE_ID (eg. 'beth@252c' or 'jsr@2d91') //NODE (eg. '//bert' or '//ernie') @NODE (eg. '@bert' or '@ernie') @NODE_ID (eg. '@3115' or '@252c') The first format sends a message to every node on which the given user is logged into the display manager (ie. every node which LUSR shows the user as being logged into). The second and third formats send the message only to the given node if the specified user is logged in there. The forth, fifth, and sixth formats send the message to the given node regardless of whether or not anyone is logged into the node. OPTIONS -ME Sends a copy of the message to every node on which the user who owns the process sending the message is logged into. Used by background jobs trying to contact their owner. -NODE Send a copy of the message to the node on which the process is running. Used by background jobs which want to display a message on their own node. -ALLNODES Send a copy of the message to every node in the network. Useful for messages like 'Network going down ... Eric's dog has chewed up a ringnet cable again'. -ALLUSERS Send a copy of the message to every node in the network which has someone logged into its display manager. Useful for messages like 'File server going down for 10 minutes to fix tape drive -- please log out from diskless nodes'. -FILE filename Use the text in the file 'filename' as the main body of the message to be sent. -SUBJECT subject Use the text 'subject' as the subject of the message to be sent. If 'subject' contain spaces, surround it with single or double quotes (see examples). -DEBUG Print debugging info while running. EXAMPLES 1. $ qsend john mary@bert doe@3115 Send a copy of the message to every Subject: party on 5th floor node that 'john' is logged into and . to //BERT if 'mary' is logged in . there and to node 3115 if 'doe' is . logged in on that node. 2. $ qsend -allusers //ernie @bert Send a message to every node which Subject: ethernet gateway down has someone logged into the display . manager and also to nodes //ERNIE . and //BERT. . 3. $ qsend -me -node Send a message to every node on Subject: program finished which the owner of this process is . logged into and to the node running . this process. . 4. $ qsend -file motd -node -subject "message of the day for ^'date'" Send the contents of the file MOTD to the node on which this process is running and set the SUBJECT line to the string 'message of the day' followed by the output of the DATE command (done by using active argument command substitution with the shell). SHAR_EOF chmod +x 'qsend.hlp' fi # end of overwriting check # End of shell archive exit 0 #! /bin/sh # This is a shell archive, meaning: # 1. Remove everything above the #! /bin/sh line. # 2. Save the resulting text in a file. # 3. Execute the file with /bin/sh (not csh) to create the files: # qsend.ins.pas # qsend.pas # qsend_server.bld # qsend_server.pas # This archive created: Wed Mar 18 13:09:44 1987 export PATH; PATH=/bin:$PATH if test -f 'qsend.ins.pas' then echo shar: will not over-write existing file "'qsend.ins.pas'" else cat << \SHAR_EOF > 'qsend.ins.pas' {***************************************************************************** ***** ***** ***** QSEND.INS.PAS ***** ***** ***** ***** Insert file for programs using the system's MBX facility ***** ***** to send messages to nodes on the Apollo DOMAIN network. ***** ***** Version 6 ***** ***** David M. Krowitz August 18, 1986. ***** ***** ***** ***** Copyright (c) 1986 ***** ***** David M. Krowitz ***** ***** Massachusetts Institute of Technology ***** ***** Department of Earth, Atmospheric, and Planetary Sciences ***** ***************************************************************************** } CONST {Definitions of constants for the QSEND mailbox} qsend_max_nodes = 4; {Maximum number of processes which can talk to this mailbox at once} qsend_svr_open_rec_size = (6+32+2+140+2+256+2+64+2+5); {Size of MBX open request message received by the QSEND server} qsend_clt_open_rec_size = (32+2+140+2+256+2+64+2+5); {Size of MBX open request message sent by the QSEND client} qsend_svr_data_rec_size = (6+1024+2); {Size of the MBX data message received by the QSEND server} qsend_clt_data_rec_size = (1024+2); {Size of the MBX data message sent by the QSEND client} qsend_max_rec_size = (6+1024+2); TYPE {Define the QSEND message format and the message-received reply format} {The MBX record received by the QSEND_SERVER program from a client QSEND program requesting a channel.} qsend_svr_open_ptr_t = ^qsend_svr_open_rec; qsend_svr_open_rec = RECORD header: MBX_$MSG_HDR_T; from: array[1..32] of char; from_len: pinteger; full_name: array[1..140] of char; full_name_len: pinteger; subject: array[1..256] of char; subject_len: pinteger; date: array[1..64] of char; date_len: pinteger; node: array[1..5] of char; END; {The MBX record sent by the QSEND program to the QSEND_SERVER program to request a channel.} qsend_clt_open_ptr_t = ^qsend_clt_open_rec; qsend_clt_open_rec = RECORD from: array[1..32] of char; from_len: pinteger; full_name: array[1..140] of char; full_name_len: pinteger; subject: array[1..256] of char; subject_len: pinteger; date: array[1..64] of char; date_len: pinteger; node: array[1..5] of char; END; {The MBX record containing the data portion of the message received by the QSEND_SERVER program from the client. More than one data record may be received if the message is longer than 1024 bytes.} qsend_svr_data_ptr_t = ^qsend_svr_data_rec; qsend_svr_data_rec = RECORD header: MBX_$MSG_HDR_T; data: array[1..1024] of char; data_len: pinteger; END; {The MBX record containing the data portion of the message sent by the QSEND program to the QSEND_SERVER. More than one data record may be received if the message is longer than 1024 bytes.} qsend_clt_data_ptr_t = ^qsend_clt_data_rec; qsend_clt_data_rec = RECORD data: array[1..1024] of char; data_len: pinteger; END; {The MBX record used by the QSEND_SERVER program to acknowledge the receipt of an "open" request from a client QSEND program.} qsend_svr_ack_ptr_t = ^qsend_svr_ack_rec; qsend_svr_ack_rec = MBX_$MSG_HDR_T; SHAR_EOF chmod +x 'qsend.ins.pas' fi # end of overwriting check if test -f 'qsend.pas' then echo shar: will not over-write existing file "'qsend.pas'" else cat << \SHAR_EOF > 'qsend.pas' {***************************************************************************** ***** ***** ***** QSEND.PAS ***** ***** ***** ***** Program to send messages to other users or nodes on the ***** ***** Apollo ringnet using the mailbox facility. ***** ***** Version 10 ***** ***** David M. Krowitz March 18, 1987. ***** ***** ***** ***** Copyright (c) 1987 ***** ***** David M. Krowitz ***** ***** Massachusetts Institute of Technology ***** ***** Department of Earth, Atmospheric, and Planetary Sciences ***** ***************************************************************************** } PROGRAM QSEND; %NOLIST; %INCLUDE '/sys/ins/base.ins.pas'; %INCLUDE '/sys/ins/cal.ins.pas'; %INCLUDE '/sys/ins/mbx.ins.pas'; %INCLUDE '/sys/ins/name.ins.pas'; %INCLUDE '/sys/ins/pgm.ins.pas'; %INCLUDE '/sys/ins/streams.ins.pas'; %INCLUDE '/sys/ins/time.ins.pas'; %INCLUDE '/sys/ins/tone.ins.pas'; %INCLUDE '/sys/ins/vfmt.ins.pas'; %INCLUDE 'qsend.ins.pas'; %INCLUDE 'network.ins.pas'; %LIST; CONST {Program version number - should be same as in file header above} version_number = 10; {Definitions of standard ascii control characters} etx = chr(3); {etx (control-C) character} lf = chr(10); {line-feed character} ff = chr(12); {form-feed character} cr = chr(13); {carriage-return character} sub = chr(26); {sub (control-Z) character} esc = chr(27); {escape character} rs = chr(30); {rs character} TYPE string1_t = array[1..1] of char; string2_t = array[1..2] of char; string3_t = array[1..3] of char; string128_t = array[1..128] of char; buffer_t = qsend_clt_data_ptr_t; header_t = qsend_clt_open_ptr_t; message_t = array[1..32] of qsend_clt_data_ptr_t; recipient_t = RECORD name: array[1..128] of char; len: pinteger; END; day_t = RECORD name: array[1..32] of char; len: pinteger; END; month_t = RECORD name: array[1..32] of char; len: pinteger; END; VAR crlf: string2_t; {Carriage-return Line-feed} i,j,k: INTEGER32; {Counters} ii,jj,kk: INTEGER16; {Counters} ch: CHAR; {For reading and testing single characters} stream_id: STREAM_$ID_T; {Stream ID number of window} seek_key: STREAM_$SK_T; {Stream's seek-key} status: STATUS_$T; {Status returned by system calls} beep_time: TIME_$CLOCK_T; {Length of time to beep at user} mbx_handle: UNIV_PTR; {Handle to mailbox of receiving node} mailbox_path: network_$pathname_t; {Location of mailbox of receiving node} header_ptr: header_t; {Pointer to the complete message to be sent} message_ptr: message_t; {Pointers to the message to be sent} message_cnt: pinteger; {Number of blocks of the message that have been used} daytime: CAL_$TIMEDATE_REC_T; {Date and time message sent} time_zone: CAL_$TIMEZONE_REC_T; {Time zone for date/time (eg. EDT)} my_name: network_$user_name_t; {Name of owner of this process} my_name_len: pinteger; {Length of name} my_full_name: network_$user_sid_t; {Full name of user from registry} my_full_len: pinteger; {Length of full name} my_node: network_$node_id_t; {Node ID of node running this process} my_entry_dir: network_$entry_dir_t; {Entry directory of node running this process} my_entry_len: pinteger; {Length of entry directory} my_disk_flag: BOOLEAN; {TRUE if node is diskless} recipients: array[1..64] of recipient_t; {List of people/nodes to send message to} num_recipients: pinteger; {Number of people/nodes to send to} list_users_flag: BOOLEAN; {TRUE if have current list of network users} list_nodes_flag: BOOLEAN; {TRUE if have current list of network nodes} users: network_$user_array_t; {List of users currently logged into network} num_users: pinteger; {Number of users} nodes: network_$node_array_t; {List of nodes currently running on network} num_nodes: pinteger; {Number of nodes} index_list: network_$index_list_t; {List of indices into a user_array or a node_array} index_count: pinteger; {Number of entries found in the array (0 if not found)} node_index: pinteger; {Index in the node-list of a user on a particular node} user_index: pinteger; {Index in the user-list of a user on a particular node} entry_dir: network_$entry_dir_t; {Entry directory of node receiving a message} entry_len: pinteger; {Length of entry directory} node_id: network_$node_id_t; {Node ID of node receiving a message} name: network_$user_name_t; {Name of a user receiving a message} name_len: pinteger; {Length of name} full_name: network_$user_sid_t; {Full name of a user receiving a message} full_name_len: pinteger; {Length of full name} file_name: array[1..256] of char; {File name specified by -FILE switch} file_name_len: pinteger; {Length of file name} file_stream: STREAM_$ID_T; {Stream ID for reading message file} file_sk_key: STREAM_$SK_T; {Seek key for reading message file} file_buffer_ptr: buffer_t; {Pointer to data read from message file} days: array[0..6] of day_t; {Names of the days of the week} months: array[1..12] of month_t; {Names of the months of the year} weekday: pinteger; {Day of the week} month: pinteger; {Month of the year} debug_flag: BOOLEAN; {TRUE if we want debugging info printed while running} FUNCTION lowercase (IN character: CHAR):CHAR; BEGIN IF (character IN ['A'..'Z']) THEN BEGIN lowercase := CHR(ORD(character)-ORD('A')+ORD('a')) END ELSE BEGIN lowercase := character; END; END; {End of function LOWERCASE.} FUNCTION uppercase (IN character: CHAR):CHAR; BEGIN IF (character IN ['a'..'z']) THEN BEGIN uppercase := CHR(ORD(character)-ORD('a')+ORD('A')) END ELSE BEGIN uppercase := character; END; END; {End of function UPPERCASE.} FUNCTION compare_strings ( IN string1: string128_t; IN len1: pinteger; IN string2: string128_t; IN len2: pinteger ):BOOLEAN; VAR i: pinteger; BEGIN IF (len1 <> len2) THEN BEGIN compare_strings := FALSE; RETURN; END; compare_strings := TRUE; FOR i := 1 TO len1 DO BEGIN IF (uppercase(string1[i]) <> uppercase(string2[i])) THEN BEGIN compare_strings := FALSE; RETURN; END; END; END; {End of function COMPARE_STRINGS.} FUNCTION find_char_in_string ( IN ch: char; IN string1: string128_t; IN len1: pinteger ):PINTEGER; VAR i: pinteger; BEGIN find_char_in_string := 0; FOR i := 1 TO len1 DO BEGIN IF (uppercase(ch) = uppercase(string1[i])) THEN BEGIN find_char_in_string := i; RETURN; END; END; END; {End of function COMPARE_STRINGS.} PROCEDURE qsend_send_message ( IN diskname: network_$entry_dir_t; IN name_len: INTEGER16; IN node_id: network_$node_id_t; IN diskless_flag: BOOLEAN ); VAR i,j: pinteger; status: STATUS_$T; {Status returned by system calls} mailbox_path: array[1..256] of char; {Pathname of receiving node's mailbox} mailbox_len: pinteger; {Length of pathname} node_data_path: array[1..14] of char; {The string '/SYS/NODE_DATA'} mbx_path: array[1..10] of char; {The string '/QSEND_MBX'} sleep_time: TIME_$CLOCK_T; {Time to sleep before trying another 'open'} BEGIN {Put together the pathname of the receiving node's mailbox. Should be in the node's `NODE_DATA directory.} node_data_path := '/SYS/NODE_DATA'; FOR i := 1 TO name_len DO mailbox_path[i] := diskname[i]; FOR i := 1 TO 14 DO mailbox_path[name_len+i] := node_data_path[i]; mailbox_len := name_len+14; IF (diskless_flag) THEN BEGIN mailbox_len := mailbox_len+1; mailbox_path[mailbox_len] := '.'; i := 1; WHILE (i <= 5) DO BEGIN IF (node_id[i] <> ' ') THEN BEGIN mailbox_len := mailbox_len+1; mailbox_path[mailbox_len] := node_id[i]; i := i+1; END ELSE EXIT; END; END; mbx_path := '/QSEND_MBX'; FOR i := 1 TO 10 DO mailbox_path[mailbox_len+i] := mbx_path[i]; mailbox_len := mailbox_len+10; {*** DO SOME DEBUGGING ***} IF (debug_flag) THEN BEGIN writeln ('mail box pathname is: ',mailbox_path:mailbox_len,'.'); END; {Check that the mailbox file exists. MBX_$OPEN will only return the status MBX_$NO_SERVERS if the mailbox exists and the server is not running. If the server has not yet created a mailbox then MBX_$OPEN returns the *inappropiate* status code of MBX_$MSG_TOO_BIG_FOR_CHANNEL. So until the MBX calls are fixed we have to check for the existance of the mailbox ourselves.} NAME_$CREATE_FILE (mailbox_path,mailbox_len,status); IF (status.all <> NAME_$ALREADY_EXISTS) THEN BEGIN WRITELN ('**** QSEND_SEND_MESSAGE: Warning - node ',node_id,' not running QSEND_SERVER? No mailbox file. ****'); NAME_$DELETE_FILE (mailbox_path,mailbox_len,status); RETURN; END; {Open the receiving node's mailbox and send the message header info (ie. FROM, SUBJECT, etc). If the receiving node is out of channels wait up to 10 seconds for a channel to become free.} MBX_$OPEN (mailbox_path,mailbox_len,header_ptr,qsend_clt_open_rec_size,mbx_handle,status); IF (status.all = MBX_$NO_SERVERS) THEN BEGIN WRITELN ('**** QSEND_SEND_MESSAGE: Warning - node ',node_id,' has mailbox but no QSEND_SERVER ****'); RETURN; END; IF (status.all <> STATUS_$OK) AND (status.all <> MBX_$NO_MORE_CHANNELS) THEN BEGIN WRITELN ('**** QSEND_SEND_MESSAGE: Warning - failed to open MBX channel to node ',node_id,' ****'); RETURN; END; IF (status.all = MBX_$NO_MORE_CHANNELS) THEN BEGIN i := 0; CAL_$SEC_TO_CLOCK (1,sleep_time); REPEAT TIME_$WAIT (TIME_$RELATIVE,sleep_time,status); IF (status.all <> STATUS_$OK) THEN BEGIN WRITELN ('**** QSEND_SEND_MESSAGE: Error - TIME_$WAIT call failed while waiting for free channel ****'); PGM_$EXIT; END; i := i+1; MBX_$OPEN (mailbox_path,mailbox_len,header_ptr,qsend_clt_open_rec_size,mbx_handle,status); UNTIL (i = 10) OR (status.all = STATUS_$OK); IF (status.all <> STATUS_$OK) THEN BEGIN WRITELN ('**** QSEND_SEND_MESSAGE: Error - timed out waiting to free MBX channel to node ',node_id,' ****'); PGM_$EXIT; END; END; {Now that we've got a channel open, send the rest of the message to the receiving node. If everything sent OK then close the channel so that it can be reused.} FOR i := 1 TO message_cnt DO BEGIN MBX_$PUT_REC (mbx_handle,message_ptr[i],qsend_clt_data_rec_size,status); IF (status.all <> STATUS_$OK) THEN BEGIN WRITELN ('**** QSEND_SEND_MESSAGE: Error - bad status sending block ',i:-1,' to node ',node_id,' ****'); PGM_$EXIT; END; END; MBX_$CLOSE (mbx_handle,status); IF (status.all <> STATUS_$OK) THEN BEGIN WRITELN ('**** QSEND_SEND_MESSAGE: Error - bad status closing channel to node ',node_id,' ****'); PGM_$EXIT; END; END; {End of procedure QSEND_SEND_MESSAGE.} BEGIN {Initialize some variables.} WRITELN ('This is QSEND version ',version_number:-1,'.'); NEW (header_ptr); {Allocate memory for the message} NEW (message_ptr[1]); {Allocate memory for the message} message_cnt := 1; {Using first block of message buffer} days[0].name := 'Sunday'; days[0].len := 6; days[1].name := 'Monday'; days[1].len := 6; days[2].name := 'Tuesday'; days[2].len := 7; days[3].name := 'Wednesday'; days[3].len := 9; days[4].name := 'Thursday'; days[4].len := 8; days[5].name := 'Friday'; days[5].len := 6; days[6].name := 'Saturday'; days[6].len := 8; months[1].name := 'January'; months[1].len := 7; months[2].name := 'February'; months[2].len := 8; months[3].name := 'March'; months[3].len := 5; months[4].name := 'April'; months[4].len := 5; months[5].name := 'May'; months[5].len := 3; months[6].name := 'June'; months[6].len := 4; months[7].name := 'July'; months[7].len := 4; months[8].name := 'August'; months[8].len := 6; months[9].name := 'September'; months[9].len := 9; months[10].name := 'October'; months[10].len := 7; months[11].name := 'November'; months[11].len := 8; months[12].name := 'December'; months[12].len := 8; {Find out who we are (ie. name, full name, and node) and set the FROM section of the message.} network_$get_proc_user_name (my_name,my_name_len); FOR i := 1 TO my_name_len DO BEGIN header_ptr^.from[i] := my_name[i]; END; header_ptr^.from_len := my_name_len; network_$get_user_full_name (my_name,my_name_len,my_full_name,my_full_len); FOR i := 1 TO my_full_len DO BEGIN header_ptr^.full_name[i] := my_full_name[i]; END; header_ptr^.full_name_len := my_full_len; network_$get_proc_node_id (my_node); FOR i := 1 TO 5 DO BEGIN header_ptr^.node[i] := my_node[i]; END; {Get the current date and time and set the DATE section of the message.} CAL_$DECODE_LOCAL_TIME (daytime); CAL_$GET_INFO (time_zone); weekday := ORD(CAL_$WEEKDAY(daytime.year,daytime.month,daytime.day)); month := daytime.month; WITH header_ptr^ DO BEGIN VFMT_$ENCODE10 ('%A, %A %JWD, %4JWD %2ZWD:%2ZWD:%2ZWD (%3M3UA)%$',date,64,date_len, days[weekday].name,days[weekday].len,months[month].name, months[month].len,daytime.day,daytime.year,daytime.hour, daytime.minute,daytime.second,time_zone.tz_name); END; {Check if there was a list of recipients on the command line. If so read the recipients, else prompt the user for a list of names to send the message to. We can read up to 64 names. Also check for the -FILE and -SUBJECT switches at this time.} num_recipients := 0; header_ptr^.subject_len := 0; file_name_len := 0; debug_flag := FALSE; IF (PGM_$GET_ARG(1,recipients[1].name,status,128) <> 0) THEN BEGIN i := 1; REPEAT recipients[i].len := PGM_$GET_ARG(i,recipients[i].name,status,128); IF (status.all = STATUS_$OK) THEN WITH recipients[i] DO BEGIN IF (name[1] <> '-') THEN BEGIN i := i+1; END ELSE BEGIN IF (compare_strings(name,len,'-SUBJECT',8)) THEN BEGIN PGM_$DEL_ARG(i); header_ptr^.subject_len := PGM_$GET_ARG(i,header_ptr^.subject,status,256); PGM_$DEL_ARG(i); END ELSE IF (compare_strings(name,len,'-FILE',5)) THEN BEGIN PGM_$DEL_ARG(i); file_name_len := PGM_$GET_ARG(i,file_name,status,256); PGM_$DEL_ARG(i); END ELSE IF (compare_strings(name,len,'-ME',3)) OR (compare_strings(name,len,'-NODE',5)) OR (compare_strings(name,len,'-ALLUSERS',9)) OR (compare_strings(name,len,'-ALLNODES',9)) THEN BEGIN i := i+1; END ELSE IF (compare_strings(name,len,'-DEBUG',6)) THEN BEGIN debug_flag := TRUE; PGM_$DEL_ARG(i); END ELSE BEGIN WRITELN ('**** QSEND: Error - unknown switch ''',name:len,''' ****'); PGM_$EXIT; END; END; END; UNTIL (status.all <> STATUS_$OK) OR (i > 64); IF (status.all <> STATUS_$OK) THEN num_recipients := i-1 ELSE num_recipients := 64; END; {*** DO SOME DEBUGGING ***} IF (debug_flag) THEN WITH header_ptr^ DO BEGIN writeln ('FROM field is: ',from:from_len,'.'); writeln ('FULL_NAME field is: ',full_name:full_name_len,'.'); writeln ('NODE field is: ',node,'.'); writeln ('DATE field is: ',date:date_len,'.'); END; {If there were no recipients given on the command line then get the list of recipients from the user. Up to 64 names/nodes can be specified. Last READ is to get rid of end-of-line character before trying to read the subject of the message.} IF (num_recipients = 0) THEN BEGIN REPEAT WRITE ('To: '); i := 0; j := 0; WHILE NOT(EOLN) DO BEGIN READ (ch); IF (ch <> ' ') THEN BEGIN IF (i = 0) THEN j := j+1; IF (j > 64) THEN EXIT; i := i+1; recipients[j].name[i] := ch; END ELSE BEGIN IF (i <> 0) THEN recipients[j].len := i; i := 0; END; END; READ (ch); IF (j <= 64) THEN num_recipients := j ELSE num_recipients := 64; IF (i <> 0) THEN BEGIN recipients[j].len := i; END; UNTIL (num_recipients <> 0); END; {If the subject of the message was not specified on the command line then get the subject of the message from the user. Last READ is to get rid of of end-of-line character.} IF (header_ptr^.subject_len = 0) THEN BEGIN WRITE ('Subject: '); i := 0; WHILE NOT(EOLN) DO BEGIN i := i+1; READ (header_ptr^.subject[i]); END; READ (header_ptr^.subject[i+1]); header_ptr^.subject_len := i; END; {If the -FILE switch was not given then get the message from the user and store it up in the DATA section of the message buffer. Otherwise, read the message from the file name specified with the -FILE switch.} IF (file_name_len = 0) THEN BEGIN WRITELN (''); WRITELN ('Enter message below, end with a control-Z.'); WRITE ('> '); i := 0; WHILE NOT(EOF) DO BEGIN WHILE NOT(EOLN) DO BEGIN i := i+1; READ (message_ptr[message_cnt]^.data[i]); IF (i = 1024) THEN BEGIN message_ptr[message_cnt]^.data_len := 1024; message_cnt := message_cnt+1; NEW (message_ptr[message_cnt]); i := 0; END; END; READ(message_ptr[message_cnt]^.data[i+1]); WRITE ('> '); i := i+1; message_ptr[message_cnt]^.data[i] := lf; IF (i = 1024) THEN BEGIN message_ptr[message_cnt]^.data_len := 1024; message_cnt := message_cnt+1; NEW (message_ptr[message_cnt]); i := 0; END; END; IF (i <> 0) THEN message_ptr[message_cnt]^.data_len := i ELSE message_cnt := message_cnt-1; END ELSE BEGIN STREAM_$OPEN (file_name,file_name_len,STREAM_$READ,STREAM_$NO_CONC_WRITE,file_stream,status); IF (status.all <> STATUS_$OK) THEN BEGIN WRITELN ('**** QSEND: Error - Failed to open file ''',file_name:file_name_len,''' ****'); PGM_$EXIT END; WRITELN ('Reading message from file: ''',file_name:file_name_len,'''.'); REPEAT STREAM_$GET_BUF (file_stream,message_ptr[message_cnt],1024,file_buffer_ptr, i,file_sk_key,status); IF (status.all = STATUS_$OK) THEN BEGIN message_ptr[message_cnt]^.data_len := i; IF (file_buffer_ptr <> message_ptr[message_cnt]) THEN BEGIN FOR j := 1 TO i DO message_ptr[message_cnt]^.data[j] := file_buffer_ptr^.data[j]; END; message_cnt := message_cnt+1; NEW (message_ptr[message_cnt]); message_ptr[message_cnt]^.data_len := 0; END; UNTIL (status.all <> STATUS_$OK); IF (message_ptr[message_cnt]^.data_len = 0) THEN message_cnt := message_cnt-1; END; {Send the message to each of the recipients.} list_users_flag := FALSE; list_nodes_flag := FALSE; FOR i := 1 TO num_recipients DO BEGIN IF (compare_strings(recipients[i].name,recipients[i].len,'-ME',3)) THEN BEGIN IF (NOT list_users_flag) THEN BEGIN network_$list_users (users,num_users); list_users_flag := TRUE; END; network_$get_proc_user_name (my_name,my_name_len); network_$find_user (my_name,my_name_len,users,num_users,index_list,index_count); IF (index_count <> 0) THEN BEGIN FOR j := 1 TO index_count DO WITH users[index_list[j]] DO BEGIN qsend_send_message (entry_dir,entry_len,node_id,diskless); END; END ELSE BEGIN WRITELN ('**** QSEND: Warning - User ''',my_name:my_name_len,''' not logged in for -ME option ****'); END; END ELSE IF (compare_strings(recipients[i].name,recipients[i].len,'-NODE',5)) THEN BEGIN network_$get_proc_node_id (my_node); network_$get_proc_entry_dir (my_entry_dir,my_entry_len,my_disk_flag); qsend_send_message (my_entry_dir,my_entry_len,my_node,my_disk_flag); END ELSE IF (compare_strings(recipients[i].name,recipients[i].len,'-ALLNODES',9)) THEN BEGIN IF (NOT list_nodes_flag) THEN BEGIN network_$list_nodes (nodes,num_nodes); list_nodes_flag := TRUE; END; FOR j := 1 TO num_nodes DO WITH nodes[j] DO BEGIN qsend_send_message (entry_dir,entry_len,node_id,diskless); END; END ELSE IF (compare_strings(recipients[i].name,recipients[i].len,'-ALLUSERS',9)) THEN BEGIN IF (NOT list_users_flag) THEN BEGIN network_$list_users (users,num_users); list_users_flag := TRUE; END; FOR j := 1 TO num_users DO WITH users[j] DO BEGIN qsend_send_message (entry_dir,entry_len,node_id,diskless); END; END ELSE IF (recipients[i].name[1] = '-') THEN WITH recipients[i] DO BEGIN WRITELN ('**** QSEND: Warning - Unknown switch ''',name:len,''' ignored ****'); END ELSE IF (recipients[i].name[1] = '/') AND (recipients[i].name[2] = '/') THEN BEGIN IF (NOT list_nodes_flag) THEN BEGIN network_$list_nodes (nodes,num_nodes); list_nodes_flag := TRUE; END; FOR j := 1 TO recipients[i].len DO entry_dir[j] := recipients[i].name[j]; entry_len := recipients[i].len; network_$find_node (entry_dir,entry_len,nodes,num_nodes,index_count); IF (index_count <> 0) THEN BEGIN WITH nodes[index_count] DO qsend_send_message (entry_dir,entry_len,node_id,diskless); END ELSE WITH recipients[i] DO BEGIN WRITELN ('**** QSEND: Warning - Node ''',name:len,''' not found on network ****'); END; END ELSE IF (recipients[i].name[1] = '@') THEN BEGIN IF (NOT list_nodes_flag) THEN BEGIN network_$list_nodes (nodes,num_nodes); list_nodes_flag := TRUE; END; entry_dir[1] := '/'; entry_dir[2] := '/'; FOR j := 2 TO recipients[i].len DO entry_dir[j+1] := recipients[i].name[j]; entry_len := recipients[i].len+1; network_$find_node (entry_dir,entry_len,nodes,num_nodes,index_count); IF (index_count <> 0) THEN BEGIN WITH nodes[index_count] DO qsend_send_message (entry_dir,entry_len,node_id,diskless); END ELSE BEGIN FOR j := 1 TO 5 DO node_id[j] := ' '; FOR j := 2 TO recipients[i].len DO node_id[j-1] := recipients[i].name[j]; network_$find_node_id (node_id,nodes,num_nodes,index_count); IF (index_count <> 0) THEN BEGIN WITH nodes[index_count] DO qsend_send_message (entry_dir,entry_len,node_id,diskless); END ELSE WITH recipients[i] DO BEGIN FOR j := 2 TO len DO name[j-1] := name[j]; len := len-1; WRITELN ('**** QSEND: Warning - Node ''',name:len,''' not found on network ****'); END; END; END ELSE IF (find_char_in_string ('@',recipients[i].name,recipients[i].len) <> 0) THEN BEGIN IF (NOT list_users_flag) THEN BEGIN network_$list_users (users,num_users); list_users_flag := TRUE; END; IF (NOT list_nodes_flag) THEN BEGIN network_$list_nodes (nodes,num_nodes); list_nodes_flag := TRUE; END; k := find_char_in_string ('@',recipients[i].name,recipients[i].len); FOR j := 1 TO k-1 DO BEGIN name[j] := recipients[i].name[j]; END; name_len := k-1; network_$find_user (name,name_len,users,num_users,index_list,index_count); IF (index_count = 0) THEN BEGIN network_$get_user_full_name (name,name_len,full_name,full_name_len); IF (full_name_len <> 0) THEN BEGIN WRITELN ('**** QSEND: Warning - User ''',name:name_len,''' not logged in ****'); END ELSE BEGIN WRITELN ('**** QSEND: Warning - User ''',name:name_len,''' not known to network registry ****'); END; END; FOR j := 1 TO 5 DO node_id[j] := ' '; FOR j := k+1 TO recipients[i].len DO BEGIN node_id[j-k] := recipients[i].name[j]; END; network_$find_node_id (node_id,nodes,num_nodes,index_count); IF (index_count <> 0) THEN BEGIN network_$find_user_at_node_id (node_id,name,name_len,users,num_users,user_index); IF (user_index <> 0) THEN BEGIN WITH users[user_index] DO qsend_send_message (entry_dir,entry_len,node_id,diskless); END ELSE BEGIN WRITELN ('**** QSEND: Warning - User ''',name:name_len,''' not logged in on node ',node_id,' ****'); END; END ELSE BEGIN entry_dir[1] := '/'; entry_dir[2] := '/'; FOR j := k+1 TO recipients[i].len DO BEGIN entry_dir[j-k+2] := recipients[i].name[j]; END; entry_len := recipients[i].len-k+2; network_$find_node (entry_dir,entry_len,nodes,num_nodes,node_index); IF (node_index <> 0) THEN BEGIN network_$find_user_at_node_id (nodes[node_index].node_id,name,name_len, users,num_users,user_index); IF (user_index <> 0) THEN BEGIN WITH users[user_index] DO qsend_send_message (entry_dir,entry_len,node_id,diskless); END ELSE BEGIN WRITELN ('**** QSEND: Warning - User ''',name:name_len,''' not logged in on node ',node_id,' ****'); END; END ELSE BEGIN FOR j := 3 TO entry_len DO entry_dir[j-2] := entry_dir[j]; entry_len := entry_len-2; WRITELN ('**** QSEND: Warning - Node ''',entry_dir:entry_len,''' not found on network ****'); END; END; END ELSE BEGIN IF (NOT list_users_flag) THEN BEGIN network_$list_users (users,num_users); list_users_flag := TRUE; END; FOR j := 1 TO recipients[i].len DO name[j] := recipients[i].name[j]; name_len := recipients[i].len; network_$find_user (name,name_len,users,num_users,index_list,index_count); IF (index_count <> 0) THEN BEGIN FOR j := 1 TO index_count DO WITH users[index_list[j]] DO BEGIN qsend_send_message (entry_dir,entry_len,node_id,diskless); END; END ELSE BEGIN network_$get_user_full_name (name,name_len,full_name,full_name_len); IF (full_name_len <> 0) THEN BEGIN WRITELN ('**** QSEND: Warning - User ''',name:name_len,''' not logged in ****'); END ELSE BEGIN WRITELN ('**** QSEND: Warning - User ''',name:name_len,''' not known to network registry ****'); END; END; END; END; END. SHAR_EOF chmod +x 'qsend.pas' fi # end of overwriting check if test -f 'qsend_server.bld' then echo shar: will not over-write existing file "'qsend_server.bld'" else cat << \SHAR_EOF > 'qsend_server.bld' von pas qsend_server.pas pas network.pas bind -b qsend_server qsend_server.bin network.bin voff SHAR_EOF chmod +x 'qsend_server.bld' fi # end of overwriting check if test -f 'qsend_server.pas' then echo shar: will not over-write existing file "'qsend_server.pas'" else cat << \SHAR_EOF > 'qsend_server.pas' {***************************************************************************** ***** ***** ***** QSEND_SERVER.PAS ***** ***** ***** ***** Program to receive messages from other users or nodes on ***** ***** the Apollo ringnet using the mailbox facility and to ***** **** display them in a window on the receiving node. ***** ***** Version 8 ***** ***** David M. Krowitz August 18, 1986. ***** ***** ***** ***** Copyright (c) 1986 ***** ***** David M. Krowitz ***** ***** Massachusetts Institute of Technology ***** ***** Department of Earth, Atmospheric, and Planetary Sciences ***** ***************************************************************************** } PROGRAM QSEND_SERVER; %NOLIST; %INCLUDE '/sys/ins/base.ins.pas'; %INCLUDE '/sys/ins/gpr.ins.pas'; %INCLUDE '/sys/ins/mbx.ins.pas'; %INCLUDE '/sys/ins/name.ins.pas'; %INCLUDE '/sys/ins/pad.ins.pas'; %INCLUDE '/sys/ins/pfm.ins.pas'; %INCLUDE '/sys/ins/pgm.ins.pas'; %INCLUDE '/sys/ins/streams.ins.pas'; %INCLUDE '/sys/ins/time.ins.pas'; %INCLUDE '/sys/ins/tone.ins.pas'; %INCLUDE 'qsend.ins.pas'; %INCLUDE 'network.ins.pas'; %LIST; CONST {Program version number - should be same as in file header above} version_number = 8; {Definitions of standard ascii control characters} etx = chr(3); {etx (control-C) character} lf = chr(10); {line-feed character} ff = chr(12); {form-feed character} cr = chr(13); {carriage-return character} sub = chr(26); {sub (control-Z) character} esc = chr(27); {escape character} rs = chr(30); {rs character} TYPE string1_t = array[1..1] of char; string2_t = array[1..2] of char; string3_t = array[1..3] of char; screen_size_t = RECORD x: pinteger; y: pinteger; END; buffer_t = array[1..qsend_max_rec_size] of char; VAR crlf: string2_t; {Carriage-return Line-feed} i,j: INTEGER32; {Counters} status: STATUS_$T; {Status returned by system calls} cleanup_id: PFM_$CLEANUP_REC; {Handle for processing faults} node_id: network_$node_id_t; {Node-id of this node} beep_time: TIME_$CLOCK_T; {Length of time to beep at user} mbx_handle: UNIV_PTR; {Handle to MBX mailbox} mbx_msg_len: INTEGER32; {Number of byte in MBX message} mbx_type: MBX_$MTYPE_T; {Type of MBX message received} mbx_chan: pinteger; {Number of MBX channel message recevied from} mbx_ptr: UNIV_PTR; {Generic pointer to MBX message} mbx_header_ptr: ^MBX_$MSG_HDR_T; {Pointer to access MBX header} mbx_open_ptr: qsend_svr_open_ptr_t; {Pointer to access an 'open' request} mbx_data_ptr: qsend_svr_data_ptr_t; {Pointer to access a data message} mbx_ack_ptr: qsend_svr_ack_ptr_t; {Pointer to acknowledge an 'open' request} mbx_buffer: buffer_t; {Buffer to receive MBX messages} mbx_ack_buffer: qsend_svr_ack_rec; {Buffer to send acknowledgements} display_type: GPR_$DISPLAY_CONFIG_T; {Type of screen this node has} display_size: screen_size_t; {Size of the screen the node has} working_dir: network_$pathname_t; {Current working directory} working_dir_len: INTEGER16; {Length of working directory name} pad_path: network_$pathname_t; {Pathname of transcript pad without extension} pad_name: network_$pathname_t; {Pathname of the transcript pad with window-number extension} pad_name_len: pinteger; {Length of transcript pad pathname} pad_stream_id: array[1..qsend_max_nodes] of STREAM_$ID_T; {Stream ID number of transcript pad} pad_seek_key: array[1..qsend_max_nodes] of STREAM_$SK_T; {Stream's seek-key} pad_lines: array[1..qsend_max_nodes] of INTEGER16; {Number of lines in the message window} pad_window: array[1..qsend_max_nodes] of PAD_$WINDOW_DESC_T; {Position and size of the message window} open_file: TEXT; {File variable for checking if file already exists} open_status: INTEGER32; {File status for checking if file already exists} font_width: INTEGER16; {Width of current font in pixels} font_height: INTEGER16; {Height of font in pixels (including spacing between lines} font_name: PAD_$STRING_T; {Pathname of the font file} font_name_len: INTEGER16; {Length of the pathname} BEGIN {Initialize some variables.} crlf[1] := cr; crlf[2] := lf; pad_path := 'Message_From_#'; {Find out what kind of screen we have and set the size of the screen's bitmap so that we can guarantee that the message window will be on a visible portion of the screen. We use GPR to inquire what kind of screen we have because the PAD calls require us to create a window before we can find out what kind of display this node has -- stupid!} GPR_$INQ_CONFIG (display_type,status); IF (status.all <> STATUS_$OK) THEN BEGIN WRITELN ('**** QSEND_SERVER: Error - unable to get the display type ****'); PGM_$EXIT; END; display_size.x := 0; display_size.y := 0; CASE display_type OF GPR_$BW_800x1024: BEGIN display_size.x := 800; display_size.y := 1024; END; GPR_$BW_1024x800: BEGIN display_size.x := 1024; display_size.y := 800; END; GPR_$COLOR_1024x1024x4: BEGIN display_size.x := 1024; display_size.y := 1024; END; GPR_$COLOR_1024x1024x8: BEGIN display_size.x := 1024; display_size.y := 1024; END; GPR_$COLOR_1024x800x4: BEGIN display_size.x := 1024; display_size.y := 800; END; GPR_$COLOR_1024x800x8: BEGIN display_size.x := 1024; display_size.y := 800; END; GPR_$COLOR1_1024x800x8: BEGIN display_size.x := 1024; display_size.y := 800; END; GPR_$COLOR_1280x1024x8: BEGIN display_size.x := 1280; display_size.y := 1024; END; GPR_$COLOR2_1024x800x4: BEGIN display_size.x := 1024; display_size.y := 800; END; END; IF (display_size.x = 0) OR (display_size.y = 0) THEN BEGIN WRITELN ('**** QSEND_SERVER: Error - unknown display type ****'); PGM_$EXIT; END; {Set up an acknowledgement message for "open" requests received from clients. Use a dummy channel # for now. Actual channel number will be filled in when request received from client.} mbx_ack_buffer.cnt := 6; mbx_ack_buffer.mt := MBX_$ACCEPT_OPEN_MT; mbx_ack_buffer.chan := 0; mbx_ack_ptr := ADDR(mbx_ack_buffer); {Create a mailbox on this node for receiving messages. Put the mailbox in the node's `NODE_DATA directory in case we have more than one node booting off the same disk (ie. diskless nodes). Also set the working directory of the server process to `NODE_DATA so that we can store the pad files there without having to give the full pathname of the file (eg. we can specify the file as MESSAGE_FROM_FOOBAR rather than `NODE_DATA/MESSAGE_FROM_FOOBAR). This will make the header line of the message pad look nicer.} WRITELN ('This is QSEND_SERVER version ',version_number:-1,'.'); network_$get_proc_node_id (node_id); WRITELN ('Node ID of this node is: ',node_id); WRITELN (''); MBX_$CREATE_SERVER ('`NODE_DATA/QSEND_MBX',20,qsend_max_rec_size, qsend_max_nodes,mbx_handle,status); IF (status.all <> STATUS_$OK) THEN BEGIN WRITELN ('**** QSEND_SERVER: Error - unable to create mailbox in `NODE_DATA ****'); PGM_$EXIT; END; NAME_$GET_WDIR (working_dir,working_dir_len,status); IF (status.all <> STATUS_$OK) THEN BEGIN WRITELN ('**** QSEND_SERVER: Error - unable to get current working directory ****'); PGM_$EXIT; END; NAME_$SET_WDIR ('`NODE_DATA',10,status); IF (status.all <> STATUS_$OK) THEN BEGIN WRITELN ('**** QSEND_SERVER: Error - unable to set working directory to `NODE_DATA ****'); PGM_$EXIT; END; {Set up a cleanup fault handler to close and delete the mailbox when the server is killed (either by a SIGP or by the node being shutdown). Also reset the working directory from `NODE_DATA to the working directory we started with (done to make debugging the program easier).} status := PFM_$CLEANUP (cleanup_id); IF (status.all <> PFM_$CLEANUP_SET) THEN BEGIN WRITELN ('***** QSEND_SERVER: Cleanup in progress *****'); MBX_$CLOSE (mbx_handle,status); IF (status.all <> STATUS_$OK) THEN BEGIN; WRITELN ('***** QSEND_SERVER: Cleanup handler failed to close mailbox *****'); END; NAME_$DELETE_FILE ('`NODE_DATA/QSEND_MBX',20,status); IF (status.all <> STATUS_$OK) THEN BEGIN; WRITELN ('***** QSEND_SERVER: Cleanup handler failed to delete mailbox *****'); END; NAME_$SET_WDIR (working_dir,working_dir_len,status); IF (status.all <> STATUS_$OK) THEN BEGIN; WRITELN ('***** QSEND_SERVER: Cleanup handler failed to reset working directory *****'); END; WRITELN ('***** QSEND_SERVER: Cleanup handler done *****'); PGM_$EXIT; END; WHILE TRUE DO BEGIN {Wait until an MBX message is received, then decode the message type and the channel number and process the message according to the message type.} MBX_$GET_REC (mbx_handle,addr(mbx_buffer),qsend_max_rec_size, mbx_ptr,mbx_msg_len,status); IF (status.all <> STATUS_$OK) THEN BEGIN WRITELN ('***** QSEND_SERVER: Error - bad status reading MBX message *****'); PGM_$EXIT; END; mbx_header_ptr := mbx_ptr; mbx_chan := mbx_header_ptr^.chan; mbx_type := mbx_header_ptr^.mt; IF (mbx_type = MBX_$CHANNEL_OPEN_MT) THEN BEGIN {Set up a pad and a window to display the message, then display the FROM and SUBJECT info in the pad.} mbx_open_ptr := mbx_ptr; mbx_ack_ptr^.chan := mbx_chan; MBX_$PUT_REC (mbx_handle,mbx_ack_ptr,6,status); IF (status.all <> STATUS_$OK) THEN BEGIN WRITELN ('***** QSEND_SERVER: Error - bad status acknowledging "open" request *****'); PGM_$EXIT; END; {***** DO SOME DEBUGGING *****} WITH mbx_open_ptr^ DO BEGIN writeln ('Received open request on channel ',mbx_chan); writeln ('From: ',from:from_len); writeln ('Full Name: ',full_name:full_name_len); writeln ('Subject: ',subject:subject_len); writeln ('Node: ',node:5); writeln ('Date: ',date:date_len); END; {Get a unique path-name for the transcript pad of the window in which the message will be displayed. Adjust the position of the window so that it will not fall directly on top of another message window. If a file already exists by the current pad-name, then appended a number to the pad-name and test if the new pad-name already exists.} i := 0; WHILE pad_path[i+1] <> '#' DO BEGIN pad_name[i+1] := pad_path[i+1]; i := i+1; END; FOR j := 1 TO mbx_open_ptr^.from_len DO BEGIN pad_name[i+j] := mbx_open_ptr^.from[j]; END; pad_name_len := i+mbx_open_ptr^.from_len; pad_window[mbx_chan].top := ROUND(0.30*display_size.y); pad_window[mbx_chan].left := ROUND(0.20*display_size.x); pad_window[mbx_chan].height := 10; pad_window[mbx_chan].width := 600; NAME_$CREATE_FILE (pad_name,pad_name_len,status); IF status.all = NAME_$ALREADY_EXISTS THEN BEGIN pad_name[pad_name_len+1] := '.'; pad_name[pad_name_len+2] := PRED('0'); pad_name_len := pad_name_len+2; WHILE status.all = NAME_$ALREADY_EXISTS DO BEGIN WITH pad_window[mbx_chan] DO BEGIN top := top+25; left := left+25; IF (top > display_size.y-50) OR (left+width > display_size.x) THEN BEGIN left := 0; top := 0; END; pad_name[pad_name_len] := SUCC(pad_name[pad_name_len]); IF (pad_name[pad_name_len] > '9') THEN BEGIN pad_name[pad_name_len] := '1'; pad_name[pad_name_len+1] := '0'; pad_name_len := pad_name_len+1; END; NAME_$CREATE_FILE (pad_name,pad_name_len,status); END; END; NAME_$DELETE_FILE (pad_name,pad_name_len,status); END ELSE BEGIN NAME_$DELETE_FILE (pad_name,pad_name_len,status); END; {***** DO SOME DEBUGGING *****} writeln ('Pad name for message is: ',pad_name:pad_name_len); {Now that we have a unique path-name for the transcript pad create the window a get a stream ID to which we can start writing the message. Use the default window width and height (ie. 600,10) to begin writing the message header.} PAD_$CREATE_WINDOW (pad_name,pad_name_len,PAD_$TRANSCRIPT,1, pad_window[mbx_chan],pad_stream_id[mbx_chan],status); IF (status.all <> STATUS_$OK) THEN BEGIN WRITELN ('***** QSEND_SERVER: Error - PAD_$CREATE_WINDOW call failed *****'); PGM_$EXIT; END; WITH mbx_open_ptr^ DO BEGIN STREAM_$PUT_REC (pad_stream_id[mbx_chan],addr('From: '),6,pad_seek_key[mbx_chan],status); STREAM_$PUT_REC (pad_stream_id[mbx_chan],addr(from),from_len,pad_seek_key[mbx_chan],status); STREAM_$PUT_REC (pad_stream_id[mbx_chan],addr(' ('),2,pad_seek_key[mbx_chan],status); STREAM_$PUT_REC (pad_stream_id[mbx_chan],addr(full_name),full_name_len,pad_seek_key[mbx_chan],status); STREAM_$PUT_REC (pad_stream_id[mbx_chan],addr(' at node '),9,pad_seek_key[mbx_chan],status); STREAM_$PUT_REC (pad_stream_id[mbx_chan],addr(node),5,pad_seek_key[mbx_chan],status); STREAM_$PUT_REC (pad_stream_id[mbx_chan],addr(')'),1,pad_seek_key[mbx_chan],status); STREAM_$PUT_REC (pad_stream_id[mbx_chan],addr(crlf),2,pad_seek_key[mbx_chan],status); STREAM_$PUT_REC (pad_stream_id[mbx_chan],addr('Subject: '),9,pad_seek_key[mbx_chan],status); STREAM_$PUT_REC (pad_stream_id[mbx_chan],addr(subject),subject_len,pad_seek_key[mbx_chan],status); STREAM_$PUT_REC (pad_stream_id[mbx_chan],addr(crlf),2,pad_seek_key[mbx_chan],status); STREAM_$PUT_REC (pad_stream_id[mbx_chan],addr('Date: '),6,pad_seek_key[mbx_chan],status); STREAM_$PUT_REC (pad_stream_id[mbx_chan],addr(date),date_len,pad_seek_key[mbx_chan],status); STREAM_$PUT_REC (pad_stream_id[mbx_chan],addr(crlf),2,pad_seek_key[mbx_chan],status); STREAM_$PUT_REC (pad_stream_id[mbx_chan],addr(crlf),2,pad_seek_key[mbx_chan],status); END; pad_lines[mbx_chan] := 0; END; {End of IF message-type is MBX open request} IF (mbx_type = MBX_$DATA_MT) THEN BEGIN {Read data records from the client and add them to the transcript pad until the client signals the end of the message. Count the number of lines in the message so we know how big a window is needed.} mbx_data_ptr := mbx_ptr; IF (mbx_data_ptr^.data_len <> 0) THEN BEGIN FOR i := 1 TO (mbx_data_ptr^.data_len) DO BEGIN IF (mbx_data_ptr^.data[i] = lf) THEN pad_lines[mbx_chan] := pad_lines[mbx_chan]+1; END; END; STREAM_$PUT_REC (pad_stream_id[mbx_chan],addr(mbx_data_ptr^.data), mbx_data_ptr^.data_len,pad_seek_key[mbx_chan],status); IF (status.all <> STATUS_$OK) THEN BEGIN WRITELN ('***** QSEND_SERVER: Error - couldn''t write message to pad *****'); PGM_$EXIT; END; END; {End of IF message-type is MBX data message} IF (mbx_type = MBX_$EOF_MT) THEN BEGIN {Deallocate the MBX channel so that it can be re-used now that the complete message has been received, then set the window size to fit the complete message.} MBX_$DEALLOCATE (mbx_handle,mbx_chan,status); IF (status.all <> STATUS_$OK) THEN BEGIN WRITELN ('***** QSEND_SERVER: Error - couldn''t deallocate channel *****'); PGM_$EXIT; END; {Resize the message window to fit all of the text we have displayed in it. Window actually has to have 3 extra lines in it for all of the text to appear (One line is for the 'Pad Closed' message, the others appear to be blank space that appears at the top and bottom. Note that the message also includes lines for the FROM/FULL_NAME,SUBJECT, and DATE lines and a blank line in between the preceeding two lines and the beginning of the user's text. If the pad is too long to fit on the screen, then cut it down to fit on the available screen area.} pad_lines[mbx_chan] := pad_lines[mbx_chan]+3+3+1; PAD_$INQ_FONT (pad_stream_id[mbx_chan],font_width,font_height,font_name, 256,font_name_len,status); pad_window[mbx_chan].width := 600; pad_window[mbx_chan].height := pad_lines[mbx_chan]*font_height; IF (pad_window[mbx_chan].top+pad_window[mbx_chan].height > display_size.y) THEN BEGIN pad_window[mbx_chan].height := display_size.y-pad_window[mbx_chan].top; END; PAD_$SET_FULL_WINDOW (pad_stream_id[mbx_chan],1,pad_window[mbx_chan],status); beep_time.high16 := 0; beep_time.low32 := 30000; TONE_$TIME (beep_time); {Close the stream and delete the transcript pad file. The pad file will hang around in the user's working directory until they type a control-N in the message window, at which time the window will be closed and the pad will be unlocked and deleted from the working directory. The path-name of the pad can then be reused by the message server for a new incoming message.} STREAM_$DELETE (pad_stream_id[mbx_chan],status); END; {End of IF message-type is MBX end of message} END; {End of WHILE TRUE DO} END. SHAR_EOF chmod +x 'qsend_server.pas' fi # end of overwriting check # End of shell archive exit 0