From:	CRDGW2::CRDGW2::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX" 27-JUL-1990 13:35:01.12
To:	MRGATE::"ARISIA::EVERHART"
CC:	
Subj:	SHOW/REMOTE 3

Received:  by crdgw1.ge.com (5.57/GE 1.70)
	 id AA06756; Fri, 27 Jul 90 13:20:29 EDT
Received: From UCBVAX.BERKELEY.EDU by CRVAX.SRI.COM with TCP; Fri, 27 JUL 90 09:40:39 PDT
Received: by ucbvax.Berkeley.EDU (5.63/1.42)
	id AA07275; Fri, 27 Jul 90 09:23:55 -0700
Received: from USENET by ucbvax.Berkeley.EDU with netnews
	for info-vax@kl.sri.com (info-vax@kl.sri.com)
	(contact usenet@ucbvax.Berkeley.EDU if you have questions)
Date: 27 Jul 90 16:08:03 GMT
From: umich!vela!tarcea@CS.YALE.EDU  (The OUTLAWS)
Organization: Oakland University, Rochester MI
Subject: SHOW/REMOTE 3
Message-Id: <2256@vela.acs.oakland.edu>
Sender: info-vax-request@kl.sri.com
To: info-vax@kl.sri.com


-+-+-+-+-+-+-+-+ START OF PART 3 -+-+-+-+-+-+-+-+
X  open(netlink,filename,HISTORY:= OLD) ;
X  rewrite(netlink) ;
X  writeln(netlink,command) ;
X  reset(netlink) ;
X  while not eof(netlink) do begin
X    readln(netlink,buffer) ;
X    writeln(buffer) ;
X  end ;
X  close(netlink) ;
Xend.
$ CALL UNPACK SHOWR.PAS;1 2016878310
$ create/nolog 'f'
X$ ! show$rem object com file
X$ run showremserver
X$ exit
$ CALL UNPACK SHOWREM.COM;1 1196365513
$ create/nolog 'f'
X`091
XINHERIT('SYS$LIBRARY:STARLET',`009`009`123* needed for most everything... *`
V125
X'SYS$LIBRARY:PASCAL$LIB_ROUTINES'`009`123* LIB$ routines`009`009 *`125
X)`093
Xprogram showremserver(input,output);
X
X%include 'system.inc'
X
Xvar
X  netlink      `123* network link *`125
X            : text ;
X
X  command,     `123* command from remote node *`125
X  buffer       `123* buffer for reads from subproc *`125
X            : string ; `032
X
X  outchan      `123* subprocess output channel *`125
X            : `091volatile`093 word ;
X
X  outmail      `123* logical name for outchannel *`125
X            : string ;
X
X  pid          `123* subprocess id *`125
X            : `091volatile`093 unsigned ;
X
X  alive        `123* is subproc alive *`125
X            : `091volatile`093 boolean ;
X
Xexit_block     `123* exit_handler_block for $dclexh *`125
X            : exit_handler_block ;
X
Xioblock        `123* return codes from $qiow for io *`125
X            : io_block ;
X
X`091unbound,asynchronous`093
Xprocedure Handler ;
X  begin
X    $delprc(pid) ;
X    $dassgn(outchan) ;
X  end ;
X
Xprocedure SetupExitHandler ;
X   begin
X     exit_block.forward_link:= 0 ;
X     exit_block.exit_handler:= iaddress(Handler) ;
X     exit_block.arg_count:= 0 ;
X     exit_block.addr_of_cond:= iaddress(exit_block.condition) ;
X     exit_block.arg0:= 0 ;
X     $dclexh(exit_block) ;
X   end ;
X
X`091unbound,asynchronous`093
Xprocedure SubprocExitHandler ;
X  begin
X    Alive:= false ;
X  end ;
X
Xprocedure CreateSubproc ;
X  var
X    spid  : string ;
X    upid : unsigned ;
X  begin
X    lib$getjpi(
X               ITEM_CODE:= JPI$_PID,
X               RESULTANT_STRING:= spid.body,
X               RESULTANT_LENGTH:= spid.length
X              ) ;
X    outmail:= 'MAILOUT' ;
X    $crembx(
X            CHAN:= outchan,
X            LOGNAM:= outmail,
X            MAXMSG:= 256
X           ) ;
X    alive:= true ;
X    lib$spawn(
X              COMMAND_STRING:= command.body,
X              INPUT_FILE:= 'NL:',
X              OUTPUT_FILE:= outmail,
X              FLAGS:= %b'1',
X              PROCESS_ID:= pid,
X              PROCESS_NAME:= 'SHOWREM'+spid,
X              AST_ADDRESS:= %immed iaddress(SubprocExitHandler)
X             ) ;
X  end ;`032
X
X
Xbegin
X  open(netlink,'SYS$NET',HISTORY:= OLD) ;
X  reset(netlink) ;
X  readln(netlink,command) ;
X  command:= 'SHOW '+command ;
X  rewrite(netlink) ;
X  CreateSubproc ;
X  SetupExitHandler ;
X  while alive do begin
X     $qiow(CHAN:= outchan,
X           FUNC:= IO$_READVBLK+IO$M_NOW,
X           IOSB:= ioblock,
X           P1:= buffer.body,
X           P2:= size(buffer.body)) ;
X     buffer.length:= ioblock.count ;
X     if ioblock.io_stat <> SS$_ENDOFFILE then writeln(netlink,buffer) ;
X  end ;
X  close(netlink) ;
Xend.
$ CALL UNPACK SHOWREMSERVER.PAS;1 2020094441
$ create/nolog 'f'
X$ new_uaf
X   set class ocs
X   add show$server/id=1/password=qwerty123
X$ mcr authorize
X   mod show$server/nointeractive/nolocal/nobatch/noremote
X   mod show$server/flag=restricted
X$ mcr ncp
X   define object showrem file sys$common:`091sysmgr`093showrem.com number 12
V8
X   set object showrem file sys$common:`091sysmgr`093showrem.com number 128
X   define object showrem account show$server password qwerty123
X   set object showrem account show$server password qwerty123
X   define object showrem user show$server
X   set object showrem user show$server
X$ exit  `032
$ CALL UNPACK SHOWREMSETUP.COM;1 1245133713
$ create/nolog 'f'
X%include 'ou$pascal:type.inc'
X%include 'ou$pascal:cli.inc'
X
$ CALL UNPACK SYSTEM.INC;1 252973759
$ create/nolog 'f'
X%include 'ou$pascal:type.v4_inc'
X%include 'ou$pascal:cli.v4_inc'
X%include 'ou$pascal:str.v4_inc'
X%include 'ou$pascal:lib.v4_inc'
X%include 'ou$pascal:smg.v4_inc'
X
$ CALL UNPACK SYSTEM.V4_INC;1 659641650
$ create/nolog 'f'
Xfunction FindSubStr(
X                     SUBSTRING  : string ;
X                     THE_STRING : string
X                   ): boolean ;
Xextern ;
X
Xfunction lower_case(s: varying`091llen`093 of char): string ;
Xextern ;
X
Xfunction is_numeric(
X                     STR   `123* string to test *`125
X                           : string
X                   ): boolean ;
Xextern ;
X
Xfunction LessThan_Time(t1,t2: quadword): boolean ;
Xextern ;
X
Xfunction uic(name: varying`091x`093 of char):integer;
Xextern;
X
Xfunction check_time(line:varying`091len`093 of char):boolean;
Xextern;
X
Xfunction binary_time(line:varying`091len`093 of char):quadword;
Xextern;
X
Xfunction max_time(d1,d2: quadword): quadword;
Xextern;
X
Xfunction ascii_time(bin_tim: quadword):string;
Xextern;
X
Xfunction current_time: quadword;
Xextern;
X
Xfunction expired(exp_tim: quadword): boolean;
Xextern;
X
Xfunction yes_no:boolean;
Xextern;
X
Xfunction group_name(num:integer) :string;
Xextern;
X
Xfunction group_num(the_group:varying`091x`093 of char):integer;
Xextern;
X
Xfunction on_system(name:varying`091nlen`093 of char):boolean;
Xextern;
X
Xfunction diff(s1,s2:varying`091len`093 of char):integer;
Xextern;
X
Xprocedure trim(var line: varying`091x`093 of char);
Xextern;
X
Xfunction trim_packed(in_line: packed array`091l1..u1:integer`093 of char ):s
Vtring;
Xextern;
X
Xfunction to_integer(str: varying`091len`093 of char): integer;
Xextern;
X
Xfunction to_string(i:integer): string;
Xextern;
X
Xfunction after(the_str:string; the_start: integer): string;
Xextern;
X
Xfunction before(the_str: string; the_start: integer): string;
Xextern;
X
Xprocedure fix_name(var name: packed array`091l1..u1:integer`093 of char);
Xextern;
X
Xprocedure remove_illegal(var name:string);
Xextern;
X
Xfunction parse_full_name(name:string): string;
Xextern;
X
Xfunction yes(answer:char):boolean ;
Xextern ;
X
Xprocedure to_packed(str: varying`091len`093 of char ;
X                    var out: packed array`091lo..hi: integer`093 of char) ;
Xextern ;
X
Xprocedure make_string(in_str: packed array `091u1..u2: integer`093 of char;
V var out_str: string) ;
Xextern ;
X
Xfunction exists(file_spec: varying`091len1`093 of char): boolean ;
Xextern ;
X
Xfunction SetDefaultExpiration: quadword ;
Xextern ;
$ CALL UNPACK UTIL.INC;1 1563369885
$ create/nolog 'f'
X`091inherit('sys$library:starlet')`093
Xmodule util(input,output);
X
X%INCLUDE 'SYSTEM.V4_INC'
X
X`091global`093
Xfunction FindSubStr(
X                     SUBSTRING  : string ;
X                     THE_STRING : string
X                   ): boolean ;
X  begin
X    if (index(THE_STRING,SUBSTRING) <> 0) then FindSubStr:= true
X    else FindSubStr:= false ;
X  end ;
X
X`091global`093
Xfunction lower_case(s: varying`091llen`093 of char):string;
Xvar
X i : integer;
X t : string;
Xbegin
X t:='';
X for i:=1 to length(s) do begin
X  if (s`091i`093>='A') and (s`091i`093<='Z') then t:= t+chr(ord(s`091i`093)+
V32)
X  else t:= t+s`091i`093;
X end;
X lower_case:=t;
Xend;
X
X`091global`093
Xfunction is_numeric(
X                     STR   `123* string to test *`125
X                           : string
X                   ): boolean ;
X  label leaveloop ;
X  var
X    i : integer ;
X    flag : boolean ;
X  begin
X    flag:= true ;
X    for i:= 1 to length(STR) do begin
X      if ((STR`091i`093 < '0') or (STR`091i`093 > '9')) then begin`032
X        flag:= false ;
X        goto leaveloop ;
X      end ;
X    end ;
X   leaveloop: ;
X   is_numeric:= flag ;
X  end ;
X          `032
X
X
X`091global`093
Xfunction uic(name: varying`091x`093 of char):integer;
Xtype
X word = `091word`093 0..65535;
X unsigned_rec = record
X  case integer of
X   1:( w1 : word; w2 : word);
X   2:(un:unsigned);
X  end;
Xvar
X id: unsigned_rec; syserr: integer;
Xbegin
X syserr:= $asctoid(name,id.un);
X uic:=id.w1;
Xend;
X
X`091global`093
Xfunction check_time(line:varying`091len`093 of char):boolean;
Xvar
X bin_tim: quadword;
X err: integer;
X asc_tim: packed array`0911..23`093 of char;
Xbegin
X if index(line,'NEVER')>0 then check_time:=true else
X begin
X  asc_tim:=line;
X  err:=$bintim(asc_tim,bin_tim);
X  if err=SS$_IVTIME then check_time:=false else check_time:=true;
X end;
Xend;
X
X`091global`093
Xfunction binary_time(line:varying`091len`093 of char):quadword;
Xvar
X bin_tim: quadword;
X asc_tim: packed array`0911..23`093 of char;
X i: unsigned ;
Xbegin
X if index(line,'NEVER')>0 then asc_tim:='31-DEC-9999' else asc_tim:=line;
X $bintim(asc_tim,bin_tim);
X binary_time:=bin_tim;
Xend;
X
X`091global`093
Xfunction LessThan_Time(t1,t2: quadword): boolean ;
X  var
X   n1,n2: array`0911..7`093 of word ; lessthan: boolean ;
X  begin
X    lessthan:= false ;
X    $numtim(n1,t1) ;
X    $numtim(n2,t2) ;
X    if n1`0911`093 < n2`0911`093 then lessthan:= true`032
X    else if n1`0911`093 = n2`0911`093 then
X            if n1`0912`093 < n2`0912`093 then lessthan:= true
X            else if n1`0912`093 = n2`0912`093 then
X                   if n1`0913`093 < n2`0913`093 then lessthan:= true ;
X    LessThan_Time:= lessthan ;
X  end ;
X
X`091global`093
Xfunction max_time(d1,d2: quadword): quadword;
Xvar
X n1,n2: array`0911..7`093 of word;
Xbegin
X $numtim(n1,d1);
X $numtim(n2,d2);
X if (n1`0911`093>n2`0911`093) then max_time:=d1
X else if (n2`0911`093>n1`0911`093) then max_time:=d2
X else if (n1`0912`093>n2`0912`093) then max_time:=d1
X else if (n2`0912`093>n1`0912`093) then max_time:=d2
X else if (n1`0913`093>n2`0913`093) then max_time:=d1
X else max_time:=d2;
Xend;
X
X`091global`093
Xfunction ascii_time(bin_tim: quadword):string;
Xvar
X asc_tim: packed array`0911..23`093 of char;
X line   : string;
Xbegin
X $asctim(,asc_tim,bin_tim);
X line:=asc_tim;
X ascii_time:=substr(line,1,11);
Xend;
X
X`091global`093
Xfunction current_time: quadword;
Xvar
X cur_tim: quadword;
X asc_tim: packed array`0911..23`093 of char;
Xbegin
X $asctim(,asc_tim);
X $bintim(asc_tim,cur_tim);
X current_time:=cur_tim;
Xend;
X
X`091global`093
Xfunction SetDefaultExpiration: quadword ;
X  var
X   time: packed array`0911..23`093 of char ;
X   date: string ;
X   month_array:`091static`093 array`0911..12`093 of string:= ('JAN','FEB','M
VAR','APR','MAY',
X                                          'JUN','JUL','AUG','SEP','OCT',
X                                          'NOV','DEC') ;
X   month,i: integer ;
X   quadtime: quadword ;
X  begin
X    date:= '' ;
X    $asctim(,time) ;
X    for i:= 3 to 5 do date:= date+time`091i`093 ; `123* get month *`125
X    for i:= 1 to 12 do if date = month_array`091i`093 then month:= i ;
X    case month of
X      1: date:= 'MAY' ;      7: date:= 'SEP' ;
X      2: date:= 'MAY' ;      8: date:= 'SEP' ;
X      3: date:= 'MAY' ;      9: date:= 'DEC' ;
X      4: date:= 'MAY' ;     10: date:= 'DEC' ;
X      5: date:= 'JUL' ;     11: date:= 'DEC' ;
X      6: date:= 'JUL' ;     12: date:= 'DEC' ;
X    end ;`032
X    time`0913`093:= date`0911`093 ;
X    time`0914`093:= date`0912`093 ;
X    time`0915`093:= date`0913`093 ;
X    $bintim(time,quadtime) ;
X    SetDefaultExpiration:= quadtime ;
X  end ;
X
X`091global`093
Xfunction expired(exp_tim: quadword): boolean;
Xvar
X cur_tim: quadword;
X max_tim: quadword;
Xbegin
X cur_tim:=current_time;
X max_tim:=max_time(exp_tim,cur_tim);
X if (max_tim.lo=cur_tim.lo) and (max_tim.hi=cur_tim.hi)
X  then expired:=true else expired:=false;
Xend;
X
X`091global`093
Xfunction yes_no:boolean;
Xvar
X answer :string;
Xbegin
X repeat
X  write('Enter (Y/N):');
X  readln(answer);
X  if answer='' then answer:='*';
X  str$upcase(answer,answer);
X until ((answer`0911`093='Y') or (answer`0911`093='N'));
X if answer`0911`093='Y' then yes_no:=true else yes_no:=false;
Xend;
X
X`091global`093
Xfunction group_name(num:integer) :string;
Xbegin
X case num of
X    1 : group_name:='SYSTEM';`032
X   11 : group_name:='FACULTY';
X   12 : group_name:='SUPPORT';
X   14 : group_name:='GRADS';
X   15 : group_name:='COURTESY';
X   otherwise group_name:='STUDENT';
X end;
Xend;
X
X`091global`093
Xfunction group_num(the_group:varying`091x`093 of char):integer;
Xbegin
X   if the_group='SYSTEM' then group_num:=1
X   else if the_group='FACULTY' then group_num:=11
X   else if the_group='SUPPORT' then group_num:=12
X   else if the_group='GRADS' then group_num:=14
X   else if the_group='COURTESY' then group_num:=15
X   else if the_group='STUDENTS' then group_num:=16
X   else group_num:=-1;
Xend;
X
X`091global`093
Xfunction on_system(name:varying`091nlen`093 of char):boolean;
Xvar
X ret_stat: unsigned;
Xbegin
X ret_stat:=$asctoid(name.body);
X if ret_stat=SS$_NORMAL then on_system:=true else on_system:=false;
Xend;                      `032
X
X`091global`093
Xfunction diff(s1,s2:varying`091len`093 of char):integer;
Xvar
X i,c: integer;
Xbegin
X c:=0;
X for i:=1 to min(length(s1),length(s2)) do if s1`091i`093<>s2`091i`093 then
V c:=c+1;`032
X diff:=c;
Xend;
X
X`091global`093
Xprocedure trim(var line: varying`091x`093 of char);
Xvar
X i,l: integer;
Xbegin
X if line<>'' then
X begin
X  str$trim(line,line);
X  while ((line<>'') and (line`0911`093=' ') and (length(line)>0)) do
X    line:=substr(line,2,length(line)-1);
X end;
Xend;
X
X`091global`093
Xfunction trim_packed(in_line: packed array`091l1..u1:integer`093 of char ):s
Vtring;
Xvar
X i,l: integer;
X line:string;
Xbegin
X line:=in_line;
X if line<>'' then
X begin
X str$trim(line,line);
X  while ((line<>'') and (line`0911`093=' ') and (length(line)>0)) do
X    line:=substr(line,2,length(line)-1);
X end;
X trim_packed:=line;
Xend;
X
X`091global`093
Xfunction to_integer(str: varying`091len`093 of char): integer;
Xvar i:integer;
Xbegin
X readv(str,i,error:=continue);
X if statusv <> 0 then`032
X   begin`032
X    i:=0;`032
X   end;
X to_integer:=i;
Xend;
X
X`091global`093
Xfunction to_string(i:integer): string;
Xvar s:string;
Xbegin
X s:='';
X writev(s,i,error:=continue);
X if s='' then s:='';
+-+-+-+-+-+-+-+-  END  OF PART 3 +-+-+-+-+-+-+-+-

