head     56.3;
access   paws bayes jws quist brad dew jwh;
symbols  ;
locks    ; strict;
comment  @# @;


56.3
date     93.01.27.13.21.11;  author jwh;  state Exp;
branches ;
next     56.2;

56.2
date     93.01.27.12.01.39;  author jwh;  state Exp;
branches ;
next     56.1;

56.1
date     91.11.05.09.40.53;  author jwh;  state Exp;
branches ;
next     55.1;

55.1
date     91.08.25.10.19.17;  author jwh;  state Exp;
branches ;
next     54.3;

54.3
date     91.08.21.12.36.59;  author jwh;  state Exp;
branches ;
next     54.2;

54.2
date     91.08.21.09.48.37;  author jwh;  state Exp;
branches ;
next     54.1;

54.1
date     91.03.18.15.24.26;  author jwh;  state Exp;
branches ;
next     53.1;

53.1
date     91.03.11.19.25.39;  author jwh;  state Exp;
branches ;
next     52.1;

52.1
date     91.02.19.09.09.27;  author jwh;  state Exp;
branches ;
next     51.1;

51.1
date     91.01.30.16.08.52;  author jwh;  state Exp;
branches ;
next     50.12;

50.12
date     91.01.28.13.30.39;  author jwh;  state Exp;
branches ;
next     50.11;

50.11
date     91.01.07.15.42.59;  author jwh;  state Exp;
branches ;
next     50.10;

50.10
date     91.01.02.12.56.33;  author jwh;  state Exp;
branches ;
next     50.9;

50.9
date     91.01.02.11.03.41;  author jwh;  state Exp;
branches ;
next     50.8;

50.8
date     90.11.16.11.40.01;  author jwh;  state Exp;
branches ;
next     50.7;

50.7
date     90.11.13.10.51.42;  author jwh;  state Exp;
branches ;
next     50.6;

50.6
date     90.11.12.15.26.10;  author jwh;  state Exp;
branches ;
next     50.5;

50.5
date     90.11.01.10.03.15;  author jwh;  state Exp;
branches ;
next     50.4;

50.4
date     90.10.30.11.04.32;  author jwh;  state Exp;
branches ;
next     50.3;

50.3
date     90.10.30.10.12.52;  author jwh;  state Exp;
branches ;
next     50.2;

50.2
date     90.10.30.10.10.42;  author jwh;  state Exp;
branches ;
next     50.1;

50.1
date     90.10.29.16.23.59;  author jwh;  state Exp;
branches ;
next     49.3;

49.3
date     90.10.25.15.56.36;  author jwh;  state Exp;
branches ;
next     49.2;

49.2
date     90.10.25.15.30.42;  author jwh;  state Exp;
branches ;
next     49.1;

49.1
date     90.08.14.14.08.15;  author jwh;  state Exp;
branches ;
next     48.2;

48.2
date     90.08.10.11.17.22;  author jwh;  state Exp;
branches ;
next     48.1;

48.1
date     90.07.26.11.14.15;  author jwh;  state Exp;
branches ;
next     47.6;

47.6
date     90.07.10.11.08.24;  author jwh;  state Exp;
branches ;
next     47.5;

47.5
date     90.06.03.15.42.43;  author jwh;  state Exp;
branches ;
next     47.4;

47.4
date     90.06.03.15.38.55;  author jwh;  state Exp;
branches ;
next     47.3;

47.3
date     90.06.03.15.25.19;  author jwh;  state Exp;
branches ;
next     47.2;

47.2
date     90.06.03.15.03.58;  author jwh;  state Exp;
branches ;
next     47.1;

47.1
date     90.05.14.10.55.24;  author dew;  state Exp;
branches ;
next     46.1;

46.1
date     90.05.07.08.42.23;  author jwh;  state Exp;
branches ;
next     45.1;

45.1
date     90.04.19.15.49.48;  author jwh;  state Exp;
branches ;
next     44.1;

44.1
date     90.04.01.22.07.26;  author jwh;  state Exp;
branches ;
next     43.1;

43.1
date     90.03.20.13.58.30;  author jwh;  state Exp;
branches ;
next     42.1;

42.1
date     90.01.23.17.42.59;  author jwh;  state Exp;
branches ;
next     41.1;

41.1
date     89.12.22.11.26.00;  author jwh;  state Exp;
branches ;
next     40.1;

40.1
date     89.09.29.11.48.20;  author jwh;  state Exp;
branches ;
next     39.2;

39.2
date     89.09.28.17.26.25;  author jwh;  state Exp;
branches ;
next     39.1;

39.1
date     89.09.26.16.32.52;  author dew;  state Exp;
branches ;
next     38.5;

38.5
date     89.09.21.09.49.27;  author jwh;  state Exp;
branches ;
next     38.4;

38.4
date     89.09.20.15.41.46;  author jwh;  state Exp;
branches ;
next     38.3;

38.3
date     89.09.20.12.51.47;  author jwh;  state Exp;
branches ;
next     38.2;

38.2
date     89.09.20.12.12.13;  author jwh;  state Exp;
branches ;
next     38.1;

38.1
date     89.08.29.11.24.13;  author jwh;  state Exp;
branches ;
next     37.2;

37.2
date     89.08.23.11.30.05;  author jwh;  state Exp;
branches ;
next     37.1;

37.1
date     89.05.12.11.37.01;  author dew;  state Exp;
branches ;
next     36.2;

36.2
date     89.05.09.11.25.33;  author quist;  state Exp;
branches ;
next     36.1;

36.1
date     89.02.06.10.15.42;  author dew;  state Exp;
branches ;
next     35.1;

35.1
date     89.02.02.13.29.06;  author dew;  state Exp;
branches ;
next     34.1;

34.1
date     89.01.23.16.04.18;  author jwh;  state Exp;
branches ;
next     33.1;

33.1
date     89.01.16.11.37.38;  author dew;  state Exp;
branches ;
next     32.1;

32.1
date     89.01.10.11.45.00;  author bayes;  state Exp;
branches ;
next     31.1;

31.1
date     88.12.14.18.06.11;  author bayes;  state Exp;
branches ;
next     30.1;

30.1
date     88.12.09.13.43.42;  author dew;  state Exp;
branches ;
next     29.1;

29.1
date     88.10.31.15.28.12;  author bayes;  state Exp;
branches ;
next     28.1;

28.1
date     88.10.06.10.56.16;  author dew;  state Exp;
branches ;
next     27.1;

27.1
date     88.09.29.11.25.54;  author bayes;  state Exp;
branches ;
next     26.1;

26.1
date     88.09.28.13.05.19;  author bayes;  state Exp;
branches ;
next     25.2;

25.2
date     88.04.08.09.46.27;  author quist;  state Exp;
branches ;
next     25.1;

25.1
date     88.03.02.09.23.09;  author bayes;  state Exp;
branches ;
next     24.1;

24.1
date     87.08.31.09.41.24;  author jws;  state Exp;
branches ;
next     23.1;

23.1
date     87.08.26.10.18.16;  author bayes;  state Exp;
branches ;
next     22.1;

22.1
date     87.08.17.11.02.26;  author bayes;  state Exp;
branches ;
next     21.1;

21.1
date     87.08.12.13.46.49;  author bayes;  state Exp;
branches ;
next     20.1;

20.1
date     87.07.30.10.59.39;  author bayes;  state Exp;
branches ;
next     19.1;

19.1
date     87.06.01.08.15.44;  author jws;  state Exp;
branches ;
next     18.1;

18.1
date     87.05.20.15.11.28;  author bayes;  state Exp;
branches ;
next     17.1;

17.1
date     87.04.30.10.27.07;  author jws;  state Exp;
branches ;
next     16.1;

16.1
date     87.04.26.15.39.46;  author jws;  state Exp;
branches ;
next     15.1;

15.1
date     87.04.13.09.12.49;  author jws;  state Exp;
branches ;
next     14.1;

14.1
date     87.04.01.15.15.11;  author jws;  state Exp;
branches ;
next     13.1;

13.1
date     87.02.28.18.25.52;  author jws;  state Exp;
branches ;
next     12.1;

12.1
date     87.02.02.13.15.40;  author jws;  state Exp;
branches ;
next     11.1;

11.1
date     87.01.19.09.41.36;  author jws;  state Exp;
branches ;
next     10.1;

10.1
date     86.12.24.10.49.04;  author jws;  state Exp;
branches ;
next     9.1;

9.1
date     86.12.12.14.26.16;  author bayes;  state Exp;
branches ;
next     8.1;

8.1
date     86.11.27.11.46.34;  author jws;  state Exp;
branches ;
next     7.1;

7.1
date     86.11.20.13.35.37;  author hal;  state Exp;
branches ;
next     6.1;

6.1
date     86.11.04.17.45.55;  author paws;  state Exp;
branches ;
next     5.2;

5.2
date     86.10.31.15.17.56;  author danm;  state Exp;
branches ;
next     5.1;

5.1
date     86.10.28.16.33.12;  author hal;  state Exp;
branches ;
next     4.1;

4.1
date     86.09.30.19.38.27;  author hal;  state Exp;
branches ;
next     3.1;

3.1
date     86.09.01.11.48.03;  author hal;  state Exp;
branches ;
next     2.1;

2.1
date     86.07.30.14.33.58;  author hal;  state Exp;
branches ;
next     1.1;

1.1
date     86.06.30.14.33.45;  author danm;  state tmp;
branches ;
next     ;


desc
@Base file for PWS 3.2 release.

@


56.3
log
@
pws2rcs automatic delta on Wed Jan 27 13:14:25 MST 1993
@
text
@					       (*

 (c) Copyright Hewlett-Packard Company, 1983.
All rights are reserved.  Copying or other
reproduction of this program except for archival
purposes is prohibited without the prior
written consent of Hewlett-Packard Company.


	    RESTRICTED RIGHTS LEGEND

Use, duplication, or disclosure by the Government
is subject to restrictions as set forth in
paragraph (b) (3) (B) of the Rights in Technical
Data and Computer Software clause in
DAR 7-104.9(a).

HEWLETT-PACKARD COMPANY
Fort Collins, Colorado                         *)


$copyright 'COPYRIGHT (C) 1983 BY HEWLETT-PACKARD COMPANY'$
$range off$
$debug off$
$modcal$
$ALLOW_PACKED ON$  { JWS 4/10/85 }

program init_srm
{INTERNAL ONLY BEGIN}
	 (INPUT,OUTPUT)
{INTERNAL ONLY END}
	  ;

module srmdammodule;

{}
$SEARCH 'SRM_DRV',
	 'IOLIB:KERNEL'
{INTERNAL ONLY BEGIN}
	 ,'LANSRM','IOLIB:LANDECS'
{INTERNAL ONLY END}
	 $
{{
$SEARCH 'SRM_DRV',
	'LANSRM','LANDECS'$
{}
import
  sysglobals,
  misc,
  bootdammodule,
  iodeclarations,
{INTERNAL ONLY BEGIN}
  lansrm,
  landecs,
{INTERNAL ONLY END}
  srm
{INTERNAL ONLY BEGIN}
  ,asm
{INTERNAL ONLY END}
   ;

export

procedure srmdaminit;

procedure srmdam(anyvar f       : fib;
			unum    : unitnum;
			request : damrequesttype);


{ SRM/UX TESTING ONLY !!! }
{ procedure reset_counters;
  procedure show_counter_values;
  function srmux_mapfkind(ftype : gang_file_codes) : filekind; }

implement

type
  passarray     = array[1..8] of passentry;

const
  extentsize    = 8*512;   {arbitrary choice -- multiple of common block sizes}
  constpassarray= passarray[
			   passentry[pbits:hex('80000000'),pword:'MANAGER'   ],
			   passentry[pbits:hex('40000000'),pword:'READ'      ],
			   passentry[pbits:hex('20000000'),pword:'WRITE'     ],
			   passentry[pbits:hex('10000000'),pword:'SEARCH'    ],
			   passentry[pbits:hex('08000000'),pword:'PURGELINK' ],
			   passentry[pbits:hex('04000000'),pword:'CREATELINK'],
			   passentry[pbits:hex('FFFFFFFF'),pword:'ALL'       ],
			   passentry[pbits:hex('00000000'),pword:'NONE'      ]
			   ];
  allcapabilities = access_capabilities[32 of true];
  nocapabilities  = access_capabilities[32 of false];
  temp_file_pass  = '>TEMP_FILE_PASS<';         {password on temporary files}
  BDATTYPE      = -5791;
  BDATTYPE_500  = -5663;    { fix for BDAT 500 file }
  BASICBINTYPE  = -5775;
  BASICPROGTYPE = -5808;
  SYSTMTYPE     = -5822;
  DATATYPE      = -5622;
  CODETYPE      = -5582;
  TEXTTYPE      = -5570;
{INTERNAL ONLY BEGIN}
{ Added for SRM/UX : }
  PIPETYPE      = -5812;
  BDEVTYPE      = -5811;
  CDEVTYPE      = -5810;
  MISCTYPE      = -5809;
  NETTYPE       = -5806;
  SOCKTYPE      = -5805;
{INTERNAL ONLY END}
var
  passwordarrayptr      : ^passarray;
  tempcounter           : shortint;


{=================================================}
{ TESTING ONLY !!!!!!!!!! }
{ procedure reset_counters;
var i : damrequesttype;
begin
 for i := getvolumename to openunit do
   usage_array[i] := 0;
end;
procedure show_counter_values;
var i : damrequesttype;
var c : char;
begin
 for i := getvolumename to openunit do
   begin
    writeln(i,' request made ',usage_array[i] : 6,' times.');
    if i = closefile then read(c);
    if i = catalog then read(c);
   end;
end;
procedure log_srmdam_request(req : damrequesttype);
begin
  usage_array[req] := usage_array[req] + 1;
end; }
{=================================================}

(****************************************************************************)
procedure setioresult(result    : integer);
begin
  if ioresult = ord(inoerror) then
    ioresult := result;
end;

(****************************************************************************)
function mapfkind(ftype : gang_file_codes) : filekind;
var
  fk: filekind;
begin
  mapfkind      := datafile;
  for fk := lastfkind downto untypedfile do
    if efttable^[fk] = ftype.si2 then
      mapfkind := fk;
end;
(****************************************************************************)
function srmux_mapfkind(ftype : gang_file_codes) : filekind;
LABEL 1;
var
  fk: filekind;
  assigned : boolean;
  what : shortint;
begin
  srmux_mapfkind      := datafile;
  assigned := false;
  for fk := lastfkind downto untypedfile do
    if efttable^[fk] = ftype.si2 then
     begin
      srmux_mapfkind := fk;
      assigned := true;
     end;
  if not assigned then { just defaulted to datafile - do something ! }
    begin
      what := ftype.si2;
      { Pipetype : }
      if what = -5812 then begin srmux_mapfkind := fkind9; GOTO 1; end;
      { Bdevtype : }
      if what = -5811 then begin srmux_mapfkind := fkind10; GOTO 1; end;
      { Cdevtype : }
      if what = -5810 then begin srmux_mapfkind := fkind11; GOTO 1; end;
      { Othertype : }
      if what = -5809 then begin srmux_mapfkind := fkind12; GOTO 1; end;
      { Nettype : }
      if what = -5806 then begin srmux_mapfkind := fkind13; GOTO 1; end;
      { Socktype : }
      if what = -5805 then begin srmux_mapfkind := fkind14; GOTO 1; end;
      { Otherwise just leave it alone }
    end;
1:
end;

(****************************************************************************)
procedure paoc16tostr(anyvar paoc       : name_type;
		      anyvar strng      : string255);
var
  i     : shortint;
begin
  i     := sizeof(paoc);
  while (paoc[i] = ' ') and (i > 0) do
    i   := i - 1;
  setstrlen(strng,0);
  strmove(i,paoc,1,strng,1);
end;

(****************************************************************************)
procedure strtopaoc16(anyvar strng      : string255;
		      anyvar paoc       : name_type);
begin
  paoc  := ' ';
  if strlen(strng) < 17 then
    strmove(strlen(strng),strng,1,paoc,1);
end;

(****************************************************************************)
procedure setup_fns(var f       : fib;
		    anyvar fns  : file_name_set);
begin
  with f, fns do
    if strlen(ftid) = 0 then
      setioresult(ord(ibadtitle))
    else
      begin
	strtopaoc16(ftid,file_name);
	strtopaoc16(ffpw,password)
      end;
end;

(****************************************************************************)
procedure setup_fns3(var f      : fib;
		  anyvar nsa    : name_set_array_three);
var
  n             : integer;
  tempioresult  : integer;
  tempstr       : string[16];
begin
  with f do
    if (not fisnew) or fnosrmtemp then
      setup_fns(f,nsa)
    else
      if (strlen(ftid) = 0) and (not fanonymous) then
	setioresult(ord(ibadtitle))
      else
	begin
	  with nsa[1] do
	    begin
	      password  := ' ';
	      file_name := 'WORKSTATIONS';
	    end;
	  with nsa[2] do
	    begin
	      password  := ' ';
	      file_name := 'TEMP_FILES';
	    end;
	  with nsa[3] do
	    begin
	      password          := temp_file_pass;
	      setstrlen(tempstr,0);
	      tempioresult      := ioresult;
	      strwrite(tempstr,1,n,srmnode(unitable^[funit].sc),'_',fanonctr:1);
	      ioresult          := tempioresult;
	      strtopaoc16(tempstr,file_name);
	    end;
	end;
end;

(****************************************************************************)
procedure check_protectcode_set_array(    nps   : integer;
				      var psa   : protectcode_set_array);
{
9-May-1983 RAM
This routine has been added to check for right angle brackets ('>') in
passwords.  If any are found, ioresult is set to ord(ibadpass).  This
is because the parsing routines normally used with file opens terminate
passwords at the first '>', therefore it is not possible to use them in
passwords in normal operation.  If they are really desired, they can still be
created by calling the lower level packet routines directly.
Note that temporary files still have an "illegal" password.
This routine is called from srm_create_file and from srm_set_pass.
}
var     n       : integer;
	i       : integer;
begin
  for n := 1 to nps do
    for i := 1 to name_type_len do
      if psa[n].password[i] = '>' then
	setioresult(ord(ibadpass));
end;

(****************************************************************************)
procedure parseoptparm(    foptstring   : string255ptr;
		       var sharemode    : integer;
		       var lockable     : boolean;
		       var nps          : integer;
		       var psa          : protectcode_set_array;
			   modeonly     : boolean);
type
  tokentype     = (none,mode,pass,cap);
  statetype     = (needmodeorpass,needpass,needcap);
  acstrarrtype  = array [ac_manager .. ac_createlink] of string[10];
const
  tokenlen      = 16;
  acstrarray    = acstrarrtype['MANAGER','READ','WRITE',
			       'SEARCH','PURGELINK','CREATELINK'];
var
  typeoftoken   : tokentype;
  state         : statetype;
  sindx         : integer;
  delim         : char;
  ac            : ac_manager..ac_createlink;
  token         : string[16];
  ok            : boolean;

procedure getuntildelim(del1    : char;
			del2    : char);
var
  startindx     : integer;
begin
  delim         := chr(0);
  startindx     := sindx;
  while (sindx <= strlen(foptstring^)) and (delim = chr(0)) do
    if  (foptstring^[sindx] <> del1)
    and (foptstring^[sindx] <> del2) then
      sindx     := sindx + 1
    else
      delim     := foptstring^[sindx];
  if (sindx - startindx) <= tokenlen then
    token := str(foptstring^,startindx,sindx - startindx)
  else
    setioresult(ord(ibadvalue));
  if sindx <= strlen(foptstring^) then
    sindx     := sindx + 1;
end;

begin   {parseoptparm}
  sharemode     := exclusive_share_code;
  lockable      := false;
  state         := needmodeorpass;
  nps           := 0;
  sindx         := 1;
  if foptstring <> nil then
    while (sindx <= strlen(foptstring^)) and (ioresult = ord(inoerror)) do
      begin
	case state of
	  needmodeorpass:
			begin
			  getuntildelim(',', ':');
			  if delim = ':' then
			    begin
			      typeoftoken     := pass;
			      state           := needcap;
			    end
			  else
			    begin
			      typeoftoken     := mode;
			      state           := needpass;
			    end;
			  if modeonly then
			    sindx := strlen(foptstring^) + 1;
			end;
	  needpass    : begin
			  getuntildelim(':', ':');
			  if delim = ':' then
			    begin
			      typeoftoken     := pass;
			      state           := needcap;
			    end
			  else
			    setioresult(ord(ibadvalue));
			end;
	  needcap     : begin
			  getuntildelim(',', ';');
			  typeoftoken        := cap;
			  if delim = ',' then
			    state     := needcap
			  else if delim = ';' then
			    state     := needpass;
			end;
	end;    {case}
	if ioresult = ord(inoerror) then
	  case typeoftoken of
	    mode  : begin
		      upc(token);
		      if token = 'EXCLUSIVE' then
			sharemode := exclusive_share_code
		      else if token = 'SHARED' then
			sharemode := shared_share_code
		      else if token = 'LOCKABLE' then
			begin
			  sharemode := shared_share_code;
			  lockable  := true;
			end
		      else
			setioresult(ord(ibadvalue));
		    end;
	    pass  : begin
		      nps := nps + 1;
		      with psa[nps] do
			begin
			  strtopaoc16(token,password);
			  capabilities := nocapabilities;
			end;
		    end;
	    cap   : begin
		      upc(token);
		      ok := false;
		      with psa[nps] do
			if token = 'ALL' then
			  begin
			    capabilities := allcapabilities;
			    ok := true;
			  end
			else
			  for ac := ac_manager to ac_createlink do
			    if token = acstrarray[ac] then
			      begin
				capabilities[ac] := true;
				ok := true;
			      end;
		      if not ok then
			setioresult(ord(ibadvalue));
		    end;
	  end;
      end;
end;

(****************************************************************************)
procedure srm_close_fileid(unum         : unitnum;
			   var fileid   : integer);
begin
  if fileid = 0 then
    fileid    := -1
  else
    if (fileid > 0) and (fileid <> unitable^[unum].dvrtemp) then
      with packet_ptr.rhead^ do
	begin
	  closepack(unum,fileid);
	  if status = 0 then
	    fileid := -1;
	end;
end;

(****************************************************************************)
procedure srm_close_pathid(unum         : unitnum;
			   var pathid   : integer;
			   savepathid   : boolean);
begin
  if not savepathid then
    srm_close_fileid(unum,pathid);
end;

(****************************************************************************)
procedure translatedate(var srmdate     : date_type;
			var systemdate  : daterec;
			var systemtime  : timerec);
var
  time          : integer;
begin
  with srmdate do
    begin
      with systemdate do
	begin
	  month         := date.month;
	  day           := date.day;
	  year          := date.year;
	  {RDQ 21MAR88 map 0..27 to 100..127}
	  if year < 28 then year := year + 100;
	end;
      with systemtime do
	begin
	  time          := seconds_since_midnight;
	  hour          := time div 3600;
	  minute        := (time-(hour*3600)) div 60;
	  centisecond   := (time mod 60) * 100;
	end;
    end;
end;

(****************************************************************************)
procedure srm_get_dir_info(anyvar dircatentry   : catentry;
			      var dirid         : integer;
				  unum          : unitnum;
				  long          : boolean;
				  dir_is_dvrtemp: boolean);
const
  zerodate      = daterec[year:0,day:0,month:0];
  zerotime      = timerec[hour:0,minute:0,centisecond:0];
var
  n             : integer;
  tempioresult  : integer;
begin
  with dircatentry, unitable^[unum] do
    begin
      setstrlen(cname,0);
      volpack(unum);
      with packet_ptr.rvol^, packet_ptr.rhead^ do
	begin
	  if status = 0 then
	    if not exist { .value } then { Changed for SRM-UX }
	      setioresult(ord(ilostunit))  {set ioresult to no volume}
	    else
	      begin
		paoc16tostr(volume_name,cname);
		cextra1         := -1;  {max_file_size div 32}
		cpsize          := -1;
		clsize          := -1;
		cextra2         := interleave;
		cstart          := -1;
		cblocksize      := 1;
		ccreatedate     := zerodate;
		ccreatetime     := zerotime;
		clastdate       := zerodate;
		clasttime       := zerotime;
		setstrlen(cinfo,0);
		tempioresult    := ioresult;
		{ Changed for SRM-UX : }
{INTERNAL ONLY BEGIN}
		if is_srmux_unit(unum) then
		  strwrite(cinfo,1,n,'SRM/UX ',sc:1,',',ba:1,',',du:1)
		else
{INTERNAL ONLY END}
		  strwrite(cinfo,1,n,'SRM  ',sc:1,',',ba:1,',',du:1);
		ioresult        := tempioresult;
		if dirid > 0 then
		  begin
		    fileinfopack(unum,dirid);
		    with packet_ptr.rfileinfo^, file_info do
		      if status <> 0 then
			begin
			  ioresult := tempioresult;
			  if dir_is_dvrtemp then
			    dirid := 0;
			end
		      else
			begin
			  if file_name <> ' ' then
			    paoc16tostr(file_name,cname);
			  if long then
			    begin
			      translatedate(creation_date,ccreatedate,ccreatetime);
			      translatedate(last_access_date,clastdate,clasttime);
			    end;
			end;
		  end;
	      end;
	end;
    end;
end;

(****************************************************************************)
procedure srm_get_vol_name(anyvar f     : vid;
				  unum  : unitnum);
var
  dircatentry   : catentry;
begin
  srm_get_dir_info(dircatentry,unitable^[unum].dvrtemp,unum,false,true);
  f := dircatentry.cname;
end;

(****************************************************************************)
procedure srm_set_pass(anyvar f         : fib;
			      unum      : unitnum);
type
  catarray      = array[0..maxint] of passentry;
  catarrayptr   = ^catarray;
var
  volpass       : name_type;
  fns           : file_name_set;
  nps           : integer;
  done          : boolean;
  i             : integer;
  j             : integer;
  catindx       : integer;
  catentryindx  : integer;
  tempcapbits   : record case boolean of
		    true  : (i  : integer);
		    false : (b  : access_capabilities);
		  end;
  psa           : protectcode_set_array;
begin
  with f do
    begin
      setup_fns(f,fns);
      if ioresult = ord(inoerror) then
	begin
	  for i := 1 to fpeof do
	    with psa[i], catarrayptr(fwindow)^[i-1] do
	      begin
		strtopaoc16(pword,password);
		tempcapbits.i   := pbits;
		capabilities    := tempcapbits.b;
		nps             := i;
	      end;
	  strtopaoc16(fvid,volpass);
	  check_protectcode_set_array(nps,psa);
	  if ioresult = ord(inoerror) then
	    changeprotectpack(unum,1,addr(fns),start_alternate,pathid,
			      volpass,nps,addr(psa));
	end;
    end;
end;

(****************************************************************************)
procedure srm_cat_pass(anyvar f         : fib;
			      unum      : unitnum);
type
  catarray      = array[0..maxint] of passentry;
  catarrayptr   = ^catarray;
var
  volpass       : name_type;
  fns           : file_name_set;
  done          : boolean;
  i             : integer;
  j             : integer;
  catindx       : integer;
  catentryindx  : integer;
  tempcapbits   : record case boolean of
		    true  : (i  : integer);
		    false : (b  : access_capabilities);
		  end;
begin
  catentryindx  := 0;
  done  := false;
  with f, packet_ptr.rcatpass^ do
    begin
      setup_fns(f, fns);
      if ioresult = ord(inoerror) then
	begin
	  strtopaoc16(fvid,volpass);
	  foptstring    := anyptr(passwordarrayptr);
	  catindx   := fpos + 1;
	  while (catentryindx < fpeof) and (not done) and (ioresult = ord(inoerror)) do
	    begin
	      catpasspack(unum,1,addr(fns),start_alternate,
			  pathid,volpass,24,catindx);
	      if ioresult = ord(inoerror) then
		begin
		  i   := 1;
		  if actual_num_passwords < 24 then
		    done      := true;
		  while i <= actual_num_passwords do
		    if catentryindx < fpeof then
		      begin
			with password_info[i], catarrayptr(fwindow)^[catentryindx] do
			  begin
			    paoc16tostr(password,pword);
			    tempcapbits.b   := capabilities;
			    pbits           := tempcapbits.i;
			  end;
			i             := i + 1;
			catentryindx  := catentryindx + 1;
		      end
		    else
		      begin
			i       := 25;
			done    := true;
		      end;
		  catindx     := catindx + 24;
		end;
	    end;
	end;
      fpeof := catentryindx;
    end;
end;

(****************************************************************************)
procedure srm_catalog(anyvar f      : fib;
			 unum   : unitnum);
type
  catarray      = array[0..maxint] of catentry;
  catarrayptr   = ^catarray;
  ac_char_arr   = array [ac_manager..ac_createlink] of char;
const
  ac_chars      = ac_char_arr['M','R','W','S','P','C'];
var
  volpass       : name_type;
  fns           : file_name_set;
  done          : boolean;
  i             : integer;
  j             : integer;
  catindx       : integer;
  catentryindx  : integer;
  ac            : access_code_type;
  temp_num      : integer; { Added for SRM-UX }
  leading       : boolean;
begin
  catentryindx  := 0;
  done  := false;
  with f, packet_ptr.rcat^ do
    begin
      strtopaoc16(fvid,volpass);
      catindx   := fpos + 1;
      while (catentryindx < fpeof) and not done do
	begin
	  catpack(unum,0,addr(fns),start_alternate,
		  pathid,volpass,7,catindx);
	  if ioresult <> ord(inoerror) then
	    done      := true
	  else
	    begin
	      i   := 1;
	      if actual_num_files < 7 then
		done      := true;
	      while i <= actual_num_files do
		if catentryindx < fpeof then
		  begin
		    with cat_info[i], catarrayptr(fwindow)^[catentryindx] do
		      begin
			paoc16tostr(file_name,cname);
	     {=============================================================}
			if is_srmux_unit(unum) then
			 begin
			  ceft      := file_code.si2;
			  ckind     := srmux_mapfkind(file_code);
			 end
	     {=============================================================}
			else { same as before }
			 begin
			  ceft      := file_code.si2;
			  ckind     := mapfkind(file_code);
			 end;
			cpsize    := physical_size;
			clsize    := logical_eof;
			cstart    := -1;
			translatedate(creation_date,ccreatedate,ccreatetime);
			translatedate(last_access_date,clastdate,clasttime);
			cblocksize:= -1;
			cextra1   := -1;
			cextra2   := -1;
			if not is_srmux_unit(unum) then
			 begin
			  setstrlen(cinfo,ord(ac_createlink)+1);
			  for ac := ac_manager to ac_createlink do
			    if capabilities[ac] then
			      cinfo[ord(ac) + 1] := ac_chars[ac]
			    else
			      cinfo[ord(ac) + 1] := ' ';
			   case share_code of
			    exclusive_share_code  : cinfo := cinfo + ' EXCLUSIVE';
			    shared_share_code     : cinfo := cinfo + ' SHARED';
			    {
			    closed_share_code     : cinfo := cinfo + ' CLOSED';
			    }
			    corrupt_share_code    : cinfo := cinfo + ' CORRUPT';
			    otherwise               cinfo := cinfo + ' CLOSED';
			  end; { CASE }
			end { Not an SRM-UX unit }
			 else
			  begin { Is an SRM-UX unit }
			  setstrlen(cinfo,17); { SRM-UX size needed }

			  { Initialize to no permissions : }
			  cinfo[1] := ' '; { for now }
			  if ckind = untypedfile then
			    cinfo[1] := 'd'; { for now }

			  cinfo[2] := '0'; cinfo[3] := '0'; cinfo[4] := '0';
			  cinfo[5] := 'm';

{===========================================================================}
{ Handle the special Hp-ux files that could show up for an SRM/UX user :    }
{ Put an appropriate character in front of the mode, set the type and       }
{ kind to 0. This is what the HFSDAM does now when we encounter a file of   }
{ one of these types on an HFS disk shared with HP/UX.                      }

			  case ckind of
			     fkind9 : begin
				       cinfo[1] := 'p'; { Pipe }
				       ceft := 0;
				       ckind := fkind8; { 0 }
				      end;
			     fkind10 : begin
					cinfo[1] := 'b'; { Bdev }
					ceft := 0;
					ckind := fkind8; { 0 }
				       end;
			     fkind11 : begin
					cinfo[1] := 'c'; { Cdev }
					ceft := 0;
					ckind := fkind8; { 0 }
				       end;
			     fkind12 : begin
					cinfo[1] := 'o'; { Other }
					ceft := 0;
					ckind := fkind8; { 0 }
				       end;
			     fkind13 : begin
					cinfo[1] := 'n'; { Network }
					ceft := 0;
					ckind := fkind8; { 0 }
				       end;
			     fkind14 : begin
					cinfo[1] := 's'; { Socket }
					ceft := 0;
					ckind := fkind8; { 0 }
				       end;
			     otherwise ; { do nothing }
			  end; { case }
{===========================================================================}


			  { Just set the darn things brute force,
			    there is no need to be cute : }

			  temp_num := 0;
			  if capabilities[ac_owner_r] then
			  temp_num := temp_num + 4;
			  if capabilities[ac_owner_w] then
			  temp_num := temp_num + 2;
			  if capabilities[ac_owner_x] then
			  temp_num := temp_num + 1;
			  if temp_num > 0 then
			     cinfo[2] := chr(ord('0') + temp_num);

			  temp_num := 0;
			  if capabilities[ac_group_r] then
			  temp_num := temp_num + 4;
			  if capabilities[ac_group_w] then
			  temp_num := temp_num + 2;
			  if capabilities[ac_group_x] then
			  temp_num := temp_num + 1;
			  if temp_num > 0 then
			     cinfo[3] := chr(ord('0') + temp_num);

			  temp_num := 0;
			  if capabilities[ac_other_r] then
			  temp_num := temp_num + 4;
			  if capabilities[ac_other_w] then
			  temp_num := temp_num + 2;
			  if capabilities[ac_other_x] then
			  temp_num := temp_num + 1;
			  if temp_num > 0 then
			     cinfo[4] := chr(ord('0') + temp_num);

			   { Keep filling in cinfo fields ... : }

			  temp_num := creation_date.id; { has uid now }
			  leading := true;
			  cinfo[6] := chr(ord('0') + temp_num div 10000);
			  if (cinfo[6] = '0') then
			     cinfo[6] := ' '
			  else
			     leading := false;
			  cinfo[7] := chr(ord('0') +
					  (temp_num div 1000) mod 10);
			  if ((cinfo[7] = '0') and leading) then
			     cinfo[7] := ' '
			  else
			     leading := false;
			  cinfo[8] := chr(ord('0') +
					  (temp_num div 100) mod 10);
			  if ((cinfo[8] = '0') and leading) then
			     cinfo[8] := ' '
			  else
			     leading := false;
			  cinfo[9] := chr(ord('0') +
					  (temp_num div 10) mod 10);
			  if ((cinfo[9] = '0') and leading) then
			     cinfo[9] := ' '
			  else
			     leading := false;
			  cinfo[10] := chr(ord('0') +
					  temp_num mod 10);
			  cinfo[11] := 'u';

			  temp_num := last_access_date.id; { has gid now }
			  leading := true;
			  cinfo[12] := chr(ord('0') + temp_num div 10000);
			  if (cinfo[12] = '0') then
			     cinfo[12] := ' '
			  else
			     leading := false;
			  cinfo[13] := chr(ord('0') +
					  (temp_num div 1000) mod 10);
			  if ((cinfo[13] = '0') and leading) then
			     cinfo[13] := ' '
			  else
			     leading := false;
			  cinfo[14] := chr(ord('0') +
					  (temp_num div 100) mod 10);
			  if ((cinfo[14] = '0') and leading) then
			     cinfo[14] := ' '
			  else
			     leading := false;
			  cinfo[15] := chr(ord('0') +
					  (temp_num div 10) mod 10);
			  if ((cinfo[15] = '0') and leading) then
			     cinfo[15] := ' '
			  else
			     leading := false;
			  cinfo[16] := chr(ord('0') +
					  temp_num mod 10);
			  cinfo[17] := 'g';

			   case share_code of
			    exclusive_share_code  : cinfo := cinfo + ' EX';
			    shared_share_code     : cinfo := cinfo + ' SH';
			    corrupt_share_code    : cinfo := cinfo + ' CO';
			    otherwise               cinfo := cinfo + ' CL';
			  end; { CASE }
			end; { Is an SRM-UX unit }
		      end;
		    i := i + 1;
		    catentryindx := catentryindx + 1;
		  end
		else
		  begin
		    i       := 8;
		    done    := true;
		  end;
	      catindx     := catindx + 7;
	    end;
	end;
      fpeof := catentryindx;
    end;
end;  { srm_catalog }
(****************************************************************************)
procedure srm_open_dir(anyvar f         : fib;
			      unum      : unitnum;
			      opentype  : gang_open_type;
			      openparent:boolean);
var
  volpass       : name_type;
  lentitle      : integer;
  sindx         : integer;
  pindx         : integer;
  nindx         : integer;
  i             : integer;
  path          : path_start_type;
  saveid        : file_id_type;
  origpathid    : file_id_type;
  last          : boolean;
  alreadyopen   : boolean;
  nfns          : integer;
  nsa           : name_set_array;

procedure getpaoc(anyvar paoc   : name_type;
			 del1   : char;
			 del2   : char);
var
  done  : boolean;
begin
  with f do
    begin
      done  := false;
      while (sindx <= lentitle) and (pindx <= name_type_len) and (not done) do
	if  (ftitle[sindx] = del1) or (ftitle[sindx] = del2) then
	  done            := true
	else
	  begin
	    paoc[pindx]   := ftitle[sindx];
	    pindx         := pindx + 1;
	    sindx         := sindx + 1;
	  end;
      if (sindx > lentitle) then
	begin
	  if del1 = '>' then
	    ioresult := ord(ibadpass);
	end
      else
	begin
	  if  (ftitle[sindx] <> del1) and (ftitle[sindx] <> del2) then
	    begin
	      if del1 = '>' then
		ioresult := ord(ibadpass)
	      else
		ioresult := ord(ibadtitle);
	    end
	  else
	    if (del1 = '>') then
	      if (ftitle[sindx] <> '>') then
		ioresult := ord(ibadpass);
	end;
    end;
end;



begin
  last          := false;
  alreadyopen   := false;
  sindx         := 1;

  with f do
    begin
      origpathid        := pathid;
      lentitle          := strlen(ftitle);
      setstrlen(ftid,0);
      if pathid = -1 then
	begin
	  setstrlen(fvid,0);
	  setstrlen(ffpw,0);
	end;
      if (sindx <= lentitle) then
	if ftitle[sindx] = '<' then       {get volume password}
	  begin
	    sindx   := sindx + 1;
	    pindx   := 1;
	    volpass := ' ';
	    getpaoc(volpass,'>','>');
	    paoc16tostr(volpass,fvid);
	    sindx   := sindx + 1;
	  end;

      path := start_alternate;
      if ioresult = ord(inoerror) then
	if (sindx <= lentitle) then
	  if ftitle[sindx] = '/' then
	    begin
	      path  := start_root;
	      sindx := sindx + 1;
	    end;
      if pathid = -1 then
	if path = start_root then
	  pathid := 0
	else
	  pathid := unitable^[unum].dvrtemp;

      if sindx > lentitle then
	begin
	  last      := true;
	  setstrlen(ftitle,0);
	end
      else
	if (ftitle[lentitle] = '/') then
	  setioresult(ord(ibadtitle));

      with packet_ptr.ropen^ do
	while (not last) and (ioresult = ord(inoerror)) do
	  begin
	    nfns        := 0;
	    while (sindx <= lentitle) and (nfns < 6) and (ioresult = ord(inoerror)) do
	      begin
		with nsa[nfns+1] do
		  begin
		    if (ftitle[sindx] = '/') then
		      ioresult      := ord(ibadtitle)
		    else
		      begin
			file_name       := ' ';
			password        := ' ';
			pindx           := 1;
			getpaoc(file_name,'<','/');
			nindx           := pindx;
			if ioresult = ord(inoerror) then
			  if (sindx <= lentitle) then
			    if (ftitle[sindx] = '<') then
			      begin
				sindx   := sindx + 1;
				pindx   := 1;
				getpaoc(password,'>','>');
				sindx   := sindx + 1;
				if sindx <= lentitle then
				  if ftitle[sindx] <> '/' then
				    if nindx > lentitle then
				      ioresult := ord(ibadtitle)
				    else
				      begin
					pindx := nindx;
					getpaoc(file_name,'/','/');
				      end;
			      end;
			if ioresult = ord(inoerror) then
			  if (sindx > lentitle) then
			    begin
			      last    := true;
			      setstrlen(ftitle,0);
			    end;
		      end;
		  end;
		if ioresult = ord(inoerror) then
		  nfns := nfns + 1;
		sindx   := sindx + 1;
	      end;

	    if ioresult = ord(inoerror) then
	      begin
		if not (last and openparent) then
		  begin
		    openpack(unum,nfns,addr(nsa),path,
			     pathid,volpass,shared_share_code,opentype);
		    if ioresult <> ord(inoerror) then
		      begin
			if last then
			  begin
			    ioresult := ord(inoerror);
			    openparent := true;
			  end;
		      end
		    else
		      begin
			saveid        := file_id;
			if alreadyopen then
			  srm_close_pathid(unum,pathid,false)
			else
			  alreadyopen := true;
			pathid        := saveid;
			path          := start_alternate;
		      end;
		  end;
		if ioresult = ord(inoerror) then
		  begin
		    if last and openparent then
		      begin
			if (nfns <= 1) then
			  begin
			    if pathid = -1 then
			      setioresult(ord(inodirectory));
			  end
			else
			  begin
			    openpack(unum,nfns-1,addr(nsa),path,
				     pathid,volpass,shared_share_code,opentype);
			    if ioresult <> ord(inoerror) then
			      begin
				if alreadyopen then
				  srm_close_pathid(unum,pathid,false);
			      end
			    else
			      begin
				saveid        := file_id;
				if alreadyopen then
				  srm_close_pathid(unum,pathid,false);
				pathid        := saveid;
			      end;
			  end;
			if ioresult = ord(inoerror) then
			  with nsa[nfns] do
			    begin
			      paoc16tostr(file_name,ftid);
			      ftitle      := ftid;
			      if password <> ' ' then
				paoc16tostr(password,ffpw);
			    end;
		      end;
		  end;
	      end;
	  end;
      if ((origpathid <> -1) and (origpathid = pathid))
      or (pathid = unitable^[unum].dvrtemp) then
	fsavepathid     := true
      else
	fsavepathid     := false;
    end;
end;

(****************************************************************************)
procedure srm_set_unit_prefix(anyvar f  : fib;
			      unum      : unitnum);
var
  savpathid     : integer;
begin
  with f, unitable^[unum] do
    begin
      srm_open_dir(f,unum,open_protected_directory,false);
      if ioresult = ord(inoerror) then
	begin
	  if strlen(ftitle) > 0 then
	    setioresult(ord(inounit))
	  else
	    begin
	      savpathid := pathid;
	      pathid    := dvrtemp;
	      dvrtemp   := savpathid;
	    end;
	  srm_close_pathid(unum,pathid,false);
	end;
      srm_get_vol_name(uvid,unum);
    end;
end;

(****************************************************************************)
procedure doopenpack(unum       : unitnum;
		     var f      : fib;
		     nfns       : integer;
		     anyvar nsa : name_set_array;
		     path       : path_start_type;
		     volpass    : name_type;
		     sharecode  : integer;
		     lockable   : boolean);
type
  trickrec      = record case boolean of
		    true  :(i   : integer);
		    false :(chs : packed array [1..2] of char;
			    si2 : shortint);
		  end;
var
  temprec       : trickrec;
begin
      with f, packet_ptr.ropen^ do
	begin
	  if lockable and fistextvar then
	    setioresult(ord(inotlockable))
	  else
	    openpack(unum,nfns,addr(nsa),path,pathid,volpass,
			       sharecode,open_data);
	  if ioresult = ord(inoerror) then
	    if file_code.si2 = 3 then   {directory}
	      begin
		setioresult(ord(inotondir));
		closepack(unum,file_id);
	      end
	    else
	      begin
		fileid        := file_id;
		fpeof         := open_logical_eof;
		fleof         := open_logical_eof;
		feft          := file_code.si2;
		fkind         := mapfkind(file_code);
		flockable     := lockable;
		flocked       := not lockable;  {default to locked unless lockable}
		if (feft = BDATTYPE)            {BDAT file}
		or (feft = BDATTYPE_500)        {fix for BDAT 500 file}
		or (feft = BASICBINTYPE)        {BIN  file}
		or (feft = BASICPROGTYPE) then  {PROG file}
		  begin
		    temprec.chs   := '  ';
		    temprec.si2   := max_record_size div 2;
		    fstartaddress := temprec.i;
		  end
		else
		  fstartaddress   := boot_start_address;
		if not fbuffered   then     am := amtable^[untypedfile]
		else if fistextvar then     am := amtable^[fkind]
		else                        am := amtable^[datafile];
	      end;
	end;
end;

(****************************************************************************)
procedure srm_open_file(anyvar f        : fib;
			       unum     : unitnum);
type
  trickrec      = record case boolean of
		    true  :(i   : integer);
		    false :(si1 : shortint;
			    si2 : shortint);
		  end;
var
  volpass       : name_type;
  fns           : file_name_set;
  temprec       : trickrec;
  sharemode     : integer;
  nps           : integer;
  psa           : protectcode_set_array;
  lockable      : boolean;
begin
  with f do
    begin
      setup_fns(f, fns);
      parseoptparm(foptstring,sharemode,lockable,nps,psa,true);
      if ioresult = ord(inoerror) then
	begin
	  strtopaoc16(fvid,volpass);
	  doopenpack(unum,f,1,fns,start_alternate,volpass,sharemode,lockable);
	end;
    end;
end;

(****************************************************************************)
procedure srm_create_dir (anyvar f      : fib;
				 unum   : unitnum);
type
  catentryptr   = ^catentry;
const
  dirfilecode   = gang_file_codes[i:3];
var
  volpass       : name_type;
  fns           : file_name_set;
begin
  with f, catentryptr(fwindow)^ do
    if strlen(cname) = 0 then
      setioresult(ord(ibadtitle))
    else
      begin
	with fns do
	  begin
	    password      := ' ';
	    strtopaoc16(cname,file_name);
	  end;
	strtopaoc16(fvid,volpass);
	createpack(unum,1,addr(fns),start_alternate,pathid,volpass,0,nil,
		   dirfilecode,directory_records,0,0,0,0);
      end;
end;

(****************************************************************************)
procedure srm_create_file(anyvar f      : fib;
				 unum   : unitnum);
const
  dirfilecode   = gang_file_codes[i:3];
type
  trickrec      = record case boolean of
		    true  :(i   : integer);
		    false :(si1 : shortint;
			    si2 : shortint);
		  end;
var
  volpass       : name_type;
  nsa           : name_set_array_three;
  ext1          : integer;
  temprec       : trickrec;
  sharemode     : integer;
  maxrec        : integer;
  nps           : integer;
  usefeft       : gang_file_codes;
  psa           : protectcode_set_array;
  i             : integer;
  ac            : ac_manager..ac_purgelink;
  lockable      : boolean;

begin
  with f, nsa[3] do
    begin
      strtopaoc16(fvid,volpass);
      repeat
	ioresult        := ord(inoerror);
	fanonctr        := tempcounter;
	tempcounter     := tempcounter + 1;
	usefeft.i       := feft;

	{BDAT file} {fix for BDAT 500 file}
	if (feft = BDATTYPE) or (feft = BDATTYPE_500) then
	  begin
	    temprec.i       := fstartaddress;
	    maxrec          := temprec.si2 * 2;
	    if maxrec < 1 then
	      maxrec := 1;
	  end
	else
	  maxrec    := 256;
	if fpos > 0 then
	  ext1 := fpos
	else
	  ext1 := extentsize;
	parseoptparm(foptstring,sharemode,lockable,nps,psa,false);
	check_protectcode_set_array(nps,psa);
	if (nps > 0) and (nps < 24) and (ioresult = ord(inoerror)) then
	  begin
	    nps := nps + 1;
	    with psa[nps] do
	      begin
		password        := temp_file_pass;
		capabilities    := nocapabilities;
		if nps > 1 then
		  for i := 1 to nps-1 do
		    for ac := ac_manager to ac_purgelink do
		      if psa[i].capabilities[ac] then
			capabilities[ac] := true;
	      end;
	  end;

	if (not fanonymous) and (ioresult = ord(inoerror)) then
	  begin
	    setup_fns(f,nsa);
	    foldfileid := -1;
	    openpack(unum,1,addr(nsa),start_alternate,pathid,volpass,sharemode,open_data);
	    if ioresult = ord(inofile) then
	      begin
		ioresult := ord(inoerror);
		nsa[1].password := ' ';
		createpack(unum,1,addr(nsa),start_alternate,pathid,volpass,
			   nps,addr(psa),usefeft,data_records,
			   maxrec,ext1,extentsize,fstartaddress);
		if ioresult = ord(inoerror) then
		  if feft <> SYSTMTYPE then
		    fnosrmtemp := true
		  else
		    begin               {SYSTM files must go through temp first}
		      nsa[1].password := temp_file_pass;
		      openpack(unum,1,addr(nsa),start_alternate,pathid,
			       volpass,sharemode,open_data);
		    end;
	      end;
	    if (ioresult = ord(inoerror)) and (not fnosrmtemp) then
	      begin
		foldfileid := packet_ptr.ropen^.file_id;
		fileinfopack(unum,foldfileid);
		with packet_ptr.rfileinfo^.file_info do
		  begin
		    if  (not capabilities[ac_manager])
		    and (not capabilities[ac_purgelink]) then
		      setioresult(ord(ibadpass))   {won't be able to purge old}
		    else           {this test added in version 2.2 on 4-May-83}
		      if file_code.si2 = 3 then {disallow rewrite on directory}
			setioresult(ord(inotondir));
		    if ioresult <> ord(inoerror) then
		      srm_close_fileid(unum,foldfileid);
		  end;
	      end;
	  end;

	if (ioresult = ord(inoerror)) and (not fnosrmtemp) then
	  begin
	    setup_fns3(f,nsa);
	    if ioresult = ord(inoerror) then
	      begin
		password        := ' ';
		createpack(unum,3,addr(nsa),start_root,pathid,volpass,
			   nps,addr(psa),usefeft,data_records,
			   maxrec,ext1,extentsize,fstartaddress);
		if ioresult = ord(inofile) then
		  begin
		    ioresult := ord(inoerror);
		    createpack(unum,2,addr(nsa),start_root,pathid,volpass,
			       0,nil,dirfilecode,directory_records,0,0,0,0);
		    if ioresult <> ord(inoerror) then
		      ioresult := ord(ineedtempdir)
		    else
		      createpack(unum,3,addr(nsa),start_root,pathid,volpass,
				 nps,addr(psa),usefeft,data_records,
				 maxrec,ext1,extentsize,fstartaddress);
		  end
		else
		  if ioresult = ord(idupfile) then
		    begin
		      ioresult := ord(inoerror);
		      password := temp_file_pass;
		      purgepack(unum,3,addr(nsa),start_root,pathid,volpass);
		      ioresult := ord(inoerror);
		      password := ' ';
		      createpack(unum,3,addr(nsa),start_root,pathid,volpass,
				 nps,addr(psa),usefeft,data_records,
				 maxrec,ext1,extentsize,fstartaddress);
		    end;
	      end;
	  end;
      until (ioresult <> ord(idupfile));
      if ioresult <> ord(inoerror) then
	srm_close_fileid(unum,foldfileid)
      else
	if fnosrmtemp then
	  begin
	    nsa[1].password := temp_file_pass;
	    doopenpack(unum,f,1,nsa,start_alternate,volpass,sharemode,lockable);
	  end
	else
	  begin
	    password := temp_file_pass;
	    doopenpack(unum,f,3,nsa,start_root,volpass,exclusive_share_code,lockable);
	  end;
    end;
end;

(****************************************************************************)
procedure srm_change_name(anyvar f      : fib;
				 unum   : unitnum);
type
  fidptr        = ^fid;
var
  volpass       : name_type;
  path1         : path_start_type;
  nfns1         : integer;
  fns1          : file_name_set;
  path2         : path_start_type;
  nfns2         : integer;
  fns2          : file_name_set;
begin
  with f, unitable^[unum] do
    begin
      srm_open_dir(f,unum,open_directory,true);
      if ioresult = ord(inoerror) then
	setup_fns(f, fns1);
      if ioresult = ord(inoerror) then
	with fns2 do
	  begin
	    file_name   := ' ';
	    password    := ' ';
	    if strpos('/',fidptr(fwindow)^) = 0 then
	      if (strpos('<',fidptr(fwindow)^) = 0) then
		strtopaoc16(fidptr(fwindow)^,file_name);
	    if file_name = ' ' then
	      setioresult(ord(ibadtitle));
	  end;
      if ioresult = ord(inoerror) then
	begin
	  strtopaoc16(fvid,volpass);
	  createlinkpack(unum,1,addr(fns1),start_alternate,pathid,volpass,
			 1,addr(fns2),start_alternate,pathid,volpass,true);
	end;
      srm_close_pathid(unum,pathid,fsavepathid);
    end;
end;

(****************************************************************************)
procedure srm_dup_link(anyvar f         : fib;
			      unum      : unitnum);
var
  volpass       : name_type;
  volpass2      : name_type;
  path1         : path_start_type;
  nfns1         : integer;
  fns1          : file_name_set;
  path2         : path_start_type;
  nfns2         : integer;
  fns2          : file_name_set;
begin
  with f, unitable^[unum] do
    begin
      srm_open_dir(f,unum,open_directory,true);
      if ioresult = ord(inoerror) then
	setup_fns(f, fns1);
      if ioresult = ord(inoerror) then
	srm_open_dir(fibp(fwindow)^,unum,open_directory,true);
      if ioresult = ord(inoerror) then
	setup_fns(fibp(fwindow)^, fns2);
      if ioresult = ord(inoerror) then
	begin
	  strtopaoc16(fvid,volpass);
	  strtopaoc16(fibp(fwindow)^.fvid,volpass2);
	  createlinkpack(unum,1,addr(fns1),start_alternate,pathid,volpass,
	      1,addr(fns2),start_alternate,fibp(fwindow)^.pathid,volpass2,
	      fpurgeoldlink);
	end;
      srm_close_pathid(unum,pathid,fsavepathid);
      srm_close_pathid(unum,fibp(fwindow)^.pathid,fibp(fwindow)^.fsavepathid);
    end;
end;

(****************************************************************************)
procedure srm_purge_name(anyvar f       : fib;
				unum    : unitnum);
var
  volpass       : name_type;
  fns           : file_name_set;
begin
  with f do
      begin
	setup_fns(f, fns);
	if ioresult = ord(inoerror) then
	  begin
	    strtopaoc16(fvid,volpass);
	    purgepack(unum,1,addr(fns),start_alternate,pathid,volpass);
	  end;
      end;
end;

(****************************************************************************)
procedure srm_purge_file(anyvar f       : fib;
				unum    : unitnum);
var
  volpass       : name_type;
  path          : path_start_type;
  nfns          : integer;
  nsa           : name_set_array_three;
begin
  with f do
    if (strlen(ftid) = 0) and not fisnew then
      setioresult(ord(ibadtitle))
    else
      begin
	if fmodified then
	  if not (flockable and not flocked) then
	    begin
	      seteofpack(funit,fileid,false,fleof);
	      if ioresult = ord(ilostfile) then
		fileid := -1;
	    end;
	if fisnew and (not fanonymous) and (not fnosrmtemp) then
	  srm_close_fileid(unum,foldfileid);
	srm_close_fileid(unum,fileid);
	setup_fns3(f,nsa);
	if ioresult <> ord(ibadtitle) then
	  begin
	    if (fisnew) and (not fnosrmtemp) then
	      begin
		path        := start_root;
		nfns        := 3;
	      end
	    else
	      begin
		path        := start_alternate;
		nfns        := 1;
	      end;
	    strtopaoc16(fvid,volpass);
	    if fisnew then
	      nsa[nfns].password := temp_file_pass;
	    purgepack(unum,nfns,addr(nsa),path,pathid,volpass);
	  end;
	if not (fisnew and fanonymous) then
	  srm_close_pathid(unum,pathid,fsavepathid);
      end;
end;

(****************************************************************************)
procedure srm_stretch(anyvar f          : fib;
			     unum       : unitnum);
var
  volpass       : name_type;
  neweof        : integer;
begin
  with f do
    begin
      neweof            := ((fpos div extentsize) + 1) * extentsize;
      seteofpack(funit,fileid,false,neweof);
      if ioresult = ord(inoerror) then
	begin
	  fpeof         := neweof;
	  fmodified     := true;
	end;
    end;
end;

(****************************************************************************)
procedure srm_close_file(anyvar f       : fib;
				unum    : unitnum);
var
  volpass       : name_type;
  nsa1          : name_set_array_three;
  fns           : file_name_set;
  tempioresult  : integer;
  ext1          : integer;
  saveleof      : integer;
  savefileid    : file_id_type;
  usefeft       : gang_file_codes;
  pcs           : protect_code_set;
begin
  with f do
    begin
      if fmodified then
	if not (flockable and not flocked) then
	  begin
	    seteofpack(funit,fileid,false,fleof);
	    if ioresult = ord(ilostfile) then
	      fileid := -1;
	  end;
      if not fisnew then
	srm_close_fileid(unum,fileid)
      else
	if ioresult <> ord(inoerror) then
	  srm_purge_file(f,unum)
	else
	  begin
	    strtopaoc16(fvid,volpass);
	    setup_fns3(f,nsa1);
	    setup_fns(f,fns);
	    if (ioresult = ord(inoerror)) and (not fnosrmtemp) then
	      if not foverwritten then
		begin
		  if not fanonymous then
		    begin
		      srm_close_fileid(unum,foldfileid);
		      purgepack(unum,1,addr(fns),start_alternate,pathid,volpass);
		    end;
		  if ioresult = ord(inofile) then
		    ioresult := ord(inoerror);
		  if ioresult <> ord(inoerror) then
		    srm_purge_file(f,unum);
		end
	      else
		begin
		  if foldfileid < 0 then
		    foverwritten := false
		  else
		    begin
		      exchangepack(unum,foldfileid,fileid);
		      srm_close_fileid(unum,foldfileid);
		      srm_close_pathid(unum,pathid,fsavepathid);
		    end;
		  srm_purge_file(f,unum);
		end;
	    if (ioresult = ord(inoerror)) and (not foverwritten) then
	      if feft <> SYSTMTYPE then   {not SYSTM file}
		begin
		  srm_close_fileid(unum,fileid);
		  if (ioresult = ord(inoerror)) and (not fnosrmtemp) then
		    createlinkpack(unum,3,addr(nsa1),start_root,pathid,volpass,
				   1,addr(fns),start_alternate,pathid,volpass,true);
		  if ioresult <> ord(inoerror) then
		    srm_purge_file(f,unum)
		  else
		    begin
		      fns.password := temp_file_pass;
		      with pcs do
			begin
			  password        := temp_file_pass;
			  capabilities    := nocapabilities;
			end;
		      tempioresult := ioresult;
		      changeprotectpack(unum,1,addr(fns),start_alternate,
					pathid,volpass,1,addr(pcs));
		      ioresult := tempioresult;
		    end;
		end
	      else
		begin                 {SYSTM file}
		  savefileid  := fileid;
		  saveleof    := fleof;
		  fpos        := saveleof;
		  if fpos > 0 then
		    ext1 := fpos
		  else
		    ext1 := extentsize;
		  usefeft.i   := feft;
		  fns.password := ' ';
		  createpack(unum,1,addr(fns),start_alternate,pathid,
			     volpass,0,nil,usefeft,data_records,
			     256,ext1,extentsize,fstartaddress);
		  if ioresult = ord(inoerror) then
		    doopenpack(unum,f,1,fns,start_alternate,volpass,exclusive_share_code,false);
		  if ioresult = ord(inoerror) then
		    copypack(unum,savefileid,0,fileid,0,saveleof);
		  srm_close_fileid(unum,fileid);
		  srm_close_pathid(unum,pathid,fsavepathid);
		  fileid      := savefileid;
		  srm_purge_file(f,unum);
		end;
	  end;
      srm_close_pathid(unum,pathid,fsavepathid);
    end;
end;
(****************************************************************************)
procedure srm_get_vol_date(anyvar f     : datetimerec;
				  unum  : unitnum);
type
  fibptr        = ^fib;
var
  tempfibspace  : packed array [1..sizeof(fib,0)] of char;
begin
  with fibptr(addr(tempfibspace))^, packet_ptr.rfileinfo^.file_info do
    begin
      funit     := unum;
      pathid    := -1;
      fileid    := -1;
      fpos      := 0;
      fkind     := datafile;
      feft      := DATATYPE;
      fisnew    := true;
      fanonymous:= true;
      fmodified := false;
      foptstring:= nil;
      fnosrmtemp:= false;
      setstrlen(ftid,0);
      srm_create_file(fibptr(addr(tempfibspace))^,unum);
      if ioresult = ord(inoerror) then
	begin
	  fileinfopack(unum,fileid);
	  if ioresult = ord(inoerror) then
	    with f do
	      translatedate(creation_date,date,time);
	  srm_purge_file(fibptr(addr(tempfibspace))^,unum);
	end;
    end;
end;

(****************************************************************************)
procedure srm_lock_file(anyvar f        : fib;
			       unum     : unitnum);
begin
  with f, packet_ptr.rlock^ do
    begin
      lockpack(unum,fileid,fwaitonlock);
      if ioresult = ord(inoerror) then
	if not success.value then
	  setioresult(ord(ifilelocked))
	else
	  begin
	    fileinfopack(unum,fileid);
	    if ioresult = ord(inoerror) then
	      with packet_ptr.rfileinfo^.file_info do
		begin
		  fpeof         := logical_eof;
		  fleof         := logical_eof;
		  flocked       := true;
		end;
	  end;
    end;
end;

(****************************************************************************)
procedure srm_unlock_file(anyvar f      : fib;
				 unum   : unitnum);
begin
  with f do
    begin
      if ioresult = ord(inoerror) then
	begin
	  call(am,addr(f),flush,f,0,0);
	  flastpos := -1;
	  if ioresult = ord(inoerror) then
	    begin
	      if fmodified then
		seteofpack(unum,fileid,false,fleof);
	      if ioresult = ord(inoerror) then
		unlockpack(unum,fileid);
	      if ioresult = ord(inoerror) then
		flocked := false;
	    end;
	end;
    end;
end;

(****************************************************************************)
procedure srm_strip(anyvar f : fib);
var
  s             : string[255];
  findx         : integer;
  sindx         : integer;
  namelen       : integer;
  passlen       : integer;
  i             : integer;
  ch            : char;
  skip          : boolean;
  inpass        : boolean;
  nopassyet     : boolean;
begin
  namelen       := 0;
  passlen       := 0;
  findx         := 1;
  sindx         := 0;
  setstrlen(s,255);
  inpass        := false;
  nopassyet     := true;
  with f do
    begin
      if ftitle[1] = '<' then   {skip over volume password}
	repeat
	  findx := findx + 1;
	  if (findx > name_type_len + 3) or (findx > strlen(ftitle)) then
	    setioresult(ord(ibadpass));
	until (ftitle[findx-1] = '>') or (ioresult <> ord(inoerror));

      while (findx <= strlen(ftitle)) and (ioresult = ord(inoerror)) do
	begin
	  skip    := false;
	  ch      := ftitle[findx];

	  if inpass then
	    begin
	      skip        := true;
	      if ch = '>' then
		inpass    := false
	      else
		passlen   := passlen + 1;
	    end
	  else if ch = '/' then
	    begin
	      nopassyet := true;
	      inpass    := false;
	      namelen   := 0;
	      passlen   := 0;
	    end
	  else if ch = '<' then
	    if nopassyet then
	      begin
		nopassyet := false;
		inpass    := true;
		skip      := true;
	      end;

	  if not skip then
	    begin
	      if ch = '/' then
		begin
		  if s[sindx] = '/' then
		    setioresult(ord(ibadtitle));
		end
	      else
		namelen   := namelen + 1;
	      sindx       := sindx + 1;
	      s[sindx]    := ch;
	    end;

	  findx           := findx + 1;

	  if (namelen > name_type_len) then
	    setioresult(ord(ibadtitle))
	  else if (passlen > name_type_len) then
	    setioresult(ord(ibadpass));
	end;

    if ioresult = ord(inoerror) then
      begin
	setstrlen(s,sindx);
	i := 0;
	while (s[sindx-i] <> '/') and (i < sindx) do
	  i       := i + 1;
	if i = 0 then
	  setioresult(ord(ibadtitle))
	else
	  begin
	    setstrlen(ftid,0);
	    strmove(i,s,sindx-i+1,ftid,1);
	    setstrlen(ftitle,0);
	    strmove(sindx-i,s,1,ftitle,1);
	  end;
      end;
    end;
end;

{****************************************************************************}

{INTERNAL ONLY BEGIN}
procedure pipe_am(fp      : fibp;
		  request : amrequesttype;
	   anyvar buffer  : window;
		  bufsize : integer;
		  position: integer);
  LABEL 1;
  const
    lf = 10;
    cr = 13;
    wbsize = 512;
    rbase  = 256;
    rbsize = 256;
  var i       : integer;
      eolchar : char;
      done    : boolean;

  { freptcnt = # of bytes in write part of fbuffer }
  procedure flushdata;
    begin
      with fp^, unitable^[funit] do
      begin
	if freptcnt>0 then call(tm,fp,writebytes,fbuffer,freptcnt,0);
	freptcnt := 0;
      end;
    end; { flushdata }

  { freptcnt = # of bytes in write part of fbuffer }
  procedure writedata(anyvar buffer : window; size : integer);
    begin
      with fp^, unitable^[funit] do
      begin
	if (freptcnt+size)>wbsize then flushdata;
	if ioresult=ord(inoerror) then
	begin
	  if size>=wbsize then
	    call(tm,fp,writebytes,buffer,size,0)
	  else
	  begin
	    moveleft(buffer,fbuffer[freptcnt],size);
	    freptcnt := freptcnt + size;
	  end;
	end;
      end;
    end; { writedata }

  { flastpos is # of bytes in read part of fbuffer.
    fstartaddress is index of next byte in read part of fbuffer.
    expects that the TM may not transfer all the requested data
    and that it will report the actual # of bytes in FLASTPOS .
    IMPLIED in the logic of this code is the expectation that
    the a call to the TM will result in at least one byte of
    data OR an error.
  }
  procedure readdata(anyvar buffer : window; size : integer);
    LABEL  2;
    var
      move     : integer;
      bindex   : integer;
    begin
      bindex   := 0;
      with fp^, unitable^[funit] do
      while (size>0) and (ioresult=ord(inoerror)) do
      begin
	if flastpos>0 then
	begin
	  if size=1 then { special case size 1 for speed }
	  begin
	    buffer[bindex] := fbuffer[fstartaddress];
	    size := 0;
	    fstartaddress := fstartaddress + 1;
	    flastpos := flastpos - 1;
	    GOTO 2;
	  end
	  else
	  begin
	    if flastpos>=size then move := size
			      else move := flastpos;
	    moveleft(fbuffer[fstartaddress],buffer[bindex],move);
	    bindex := bindex + move;
	    size   := size - move;
	    fstartaddress := fstartaddress + move;
	    flastpos      := flastpos - move;
	  end;
	end;

	if (size>=rbsize) then
	begin
	 { the SIZE of data requested won't fit in the read
	   part of fbuffer so request 512 or SIZE which ever
	   is smaller to be placed directly in the callers buffer
	   .... the TM can't accurately handle partial reads unless
	   .... the request to it is for 512 bytes or less.
	 }
	  if size > 512 then move := 512
			else move := rbsize;
	  call(tm,fp,readbytes,buffer[bindex],move,0);
	  { accept what shows up }
	  size := size - flastpos;
	  bindex := bindex + flastpos;
	  flastpos := 0; { show no data in fbuffer }
	end
	else
	if size>0 then
	begin
	  { SIZE requested will fit in read part of fbuffer
	    so try to fill the read part of fbuffer
	  }
	  call(tm,fp,readbytes,fbuffer[rbase],rbsize,0);
	  fstartaddress := rbase;
	end;
      end;
      2:
    end; { readdata }

  begin { pipe_am }
    with fp^, unitable^[funit] do
    begin
      if feft=uxfile_eft then eolchar:=chr(lf)  { eol for ux files }
			 else eolchar:=chr(cr); { Normal eol for data file}
      case request of
	flush      : begin
		       flushdata;
		       if ioresult=ord(inoerror) then
			 call(tm,fp,flush,buffer,bufsize,position);
		     end;
	writeeol   : writedata(eolchar,1);
	writebytes : writedata(buffer,bufsize);
	readbytes  : begin
		       flushdata;        { ensure all outbound data is gone }
		       readdata(buffer,bufsize);
		       if ioresult<>ord(inoerror) then GOTO 1;
		       if fistextvar then
		       begin
			 feoln := buffer[bufsize-1] = eolchar;
			 for i := 0 to bufsize - 1 do
			   if buffer[i]=eolchar then buffer[i] := ' ';
		       end;
		     end;
	readtoeol  : begin
		       flushdata;        { ensure all outbound data is gone }
		       if ioresult<>ord(inoerror) then GOTO 1;
		       feoln := false; done := false; i := 0;
		       repeat
			 i := i + 1;
			 readdata(buffer[i],1);
			 if ioresult<>ord(inoerror) then
			 begin
			   i := i - 1; done := true;
			 end
			 else
			 if (buffer[i]=eolchar) then
			 begin
			   i := i - 1; done := true;
			   fstartaddress := fstartaddress - 1;
			   flastpos := flastpos + 1;
			 end
			 else done := i=bufsize;
		       until done;
		       buffer[0]:=chr(i);
		     end;
	otherwise
	  call(tm, fp, request, buffer, bufsize, position);
      end; { case }
    end;
    1:
  end; { pipe_am }

{****************************************************************************}

function rmt_exec(anyvar f       : fib;
			 unum    : unitnum;
			 request : damrequesttype):boolean;
  var
    volpass : name_type;
    slen,
    sindx   : integer;

    procedure getvolpass;
      var
	vsize : integer;
	i     : integer;
      begin
	with f do
	begin
	  vsize   := 0;
	  i       := 2;
	  while ftitle[i]<>'>' do
	  begin
	    vsize := vsize + 1;
	    volpass[vsize] := ftitle[i];
	    i := i + 1;
	  end;
	end;
      end; { getvolpass }

  begin { rmt_exec }
    rmt_exec := false;
    with f do
    begin
      sindx := strpos('//',ftitle);
      if sindx>1 then
	if (ftitle[sindx-1]<>'>') or
	   (ftitle[1]<>'<') or
	   (sindx>(passleng+3)) then sindx := 0;

      if sindx>0 then
      begin
	sindx := strpos('//',lastfid^);
	if sindx>0 then
	begin
	  slen    := strlen(lastfid^);
	  volpass := ' ';
	  if ftitle[1]='<' then getvolpass;
	  with packet_ptr.rrmtexec^ do
	  begin
	    rmt_exec := true;
	    pathid := unitable^[unum].dvrtemp;
	    rmtexecpack(unum,start_alternate,pathid,volpass,
			addr(lastfid^[sindx+2]),slen-sindx-1);
	    if ioresult=ord(inoerror) then
	    begin
	      fileid := file_id;
	      fpeof  := minint;
	      fleof  := maxint;
	      feft   := uxfile_eft;
	      fkind  := uxfile;
	      flockable := false;
	      flocked   := true;
	      fstartaddress := 0;
	      freptcnt      := 0;
	      fnosrmtemp    := true;
	      fisnew := false; { to keep close simple }
	      am := pipe_am {amtable^[fkind]} ;
	      ffpw := '>remote execute<';
	      ftid := '<remote execute>';
	    end;
	  end; { with }
	end; { if sindx }
      end; { if sindx }
    end; { with f }
  end; { rmt_exec }
{INTERNAL ONLY END}
(****************************************************************************)
procedure srmdaminit;
{INTERNAL ONLY BEGIN}
var i : integer;
{INTERNAL ONLY END}
begin
  srm_init;
  passwordarrayptr := addr(constpassarray);
{INTERNAL ONLY BEGIN}
{ Not sure this is needed ; also done in INIT in Kernel. JWH 8/10/90 }
  for i := 1 to 50 do
    srmux_on[i] := false;
{INTERNAL ONLY END}
end;

{INTERNAL ONLY BEGIN}
{ Added for SRM-UX : }
{ This routine calls chmodpack, chownpack or chgrppack to carry out }
{ the requested command. These commands may only be requested from }
{ the FILER. Note that the name srmux_change_mode is a misnomer, }
{ 'cause it handles chown and chgrp requests as well. }
{ JWH 6/22/90.        }

procedure srmux_change_mode(f : fib;
			    unum : unitnum);
type
  command_array = array[0..maxint] of h_setpasswd_entry;
  command_arrayptr = ^command_array;

var nsa : name_set_array;
begin
  with f do
   begin
     with command_arrayptr(fwindow)^[0] do
      begin
       { writeln(new_value);
       writeln(command); }
       setup_fns(f,nsa);
       case command of
	 hfs_chmod : chmodpack(funit,
				   1, { nfns }
				addr(nsa),
				start_alternate,
				pathid,
				fileid,
				' ',
				new_value);
	hfs_chown : chownpack(funit,
				   1, { nfns }
				addr(nsa),
				start_alternate,
				pathid,
				fileid,
				' ',
				new_value);
	hfs_chgrp : chgrppack(funit,
				   1, { nfns }
				addr(nsa),
				start_alternate,
				pathid,
				fileid,
				' ',
				new_value);
	otherwise ;
      end; { case }
    end;
   end;

  { with  packet_ptr.rchmod^ do
   begin
     writeln('Status is : ',return_mess_header.status); end;
  writeln('leaving change mode'); }
end;
{INTERNAL ONLY END}
(****************************************************************************)
{INTERNAL ONLY BEGIN}
procedure srm_srmdam(anyvar f       : fib;
			    unum    : unitnum;
			    request : damrequesttype);
var
  holdpathid            : integer;
  savepathid            : integer;
  savefileid            : integer;
  saveftid              : tid;
  saveffpw              : passtype;
  savefvid              : vid;
  saveftitle            : fid;
  savefsavepathid       : boolean;
  fisafib               : boolean;
begin
  ioresult      := ord(inoerror);
  srmsavesc     := 0;
  lockup;
  fisafib       := false;
  try
    with f, unitable^[unum] do
      if offline then
	ioresult        := ord(znodevice)
      else
	begin
	  if request in [opendirectory,
			 openparentdir,
			 closedirectory,
			 catalog,
			 catpasswords,
			 setpasswords,
			 openfile,
			 createfile,
			 overwritefile,
			 makedirectory,
			 closefile,
			 changename,
			 duplicatelink,
			 purgename,
			 lockfile,
			 unlockfile,
			 purgefile,
			 setunitprefix,
			 stretchit              ] then          {f is a fib}
	    begin
	      fisafib   := true;
	      if strlen(ftid) > tidleng then    {fix uninitialized fib strings}
		setstrlen(ftid,0);
	      if strlen(ffpw) > passleng then
		setstrlen(ffpw,0);
	      if strlen(fvid) > vidleng then
		setstrlen(fvid,0);

	      savepathid        := pathid;    {save fib fields to be restored on error}
	      savefileid        := fileid;
	      savefsavepathid   := fsavepathid;
	      saveftid          := ftid;
	      saveffpw          := ffpw;
	      savefvid          := fvid;
	      if strlen(ftitle) > fidleng then
		setstrlen(saveftitle,0)
	      else
		saveftitle      := ftitle;
	    end;

 { TESTING ONLY !!!!!!!!!! }
 { if is_srmux_unit(unum) then
     log_srmdam_request(request); }

	  case request of
	    opendirectory,
	    openparentdir : begin
			      srm_open_dir(f,unum,open_directory,request = openparentdir);
			      if ioresult = ord(inoerror) then
				srm_get_dir_info(fwindow^,pathid,unum,true,false);
			    end;

	    closedirectory : begin
			       fsavepathid        := false;
			       srm_close_pathid(unum,pathid,false);
			     end;

	    catalog       : srm_catalog(f,unum);

	    catpasswords  : begin
			      srm_open_dir(f,unum,open_directory,true);
			      if ioresult = ord(inoerror) then
				begin
				  srm_cat_pass(f,unum);
				  srm_close_pathid(unum,pathid,fsavepathid);
				end;
			    end;

	    setpasswords  : { Changed for SRM-UX : }
			   if not is_srmux_unit(unum) then
			    begin
			      srm_open_dir(f,unum,open_directory,true);
			      if ioresult = ord(inoerror) then
				begin
				  srm_set_pass(f,unum);
				  srm_close_pathid(unum,pathid,fsavepathid);
				end;
			    end
			    else
			     begin { they want us to change mode, etc. }
			       { It's the FILER calling from the
				 hfs_access routine  }
			       srm_open_dir(f,unum,open_directory,true);
			       if ioresult = ord(inoerror) then
				begin
				  srmux_change_mode(f,unum);
				  srm_close_pathid(unum,pathid,fsavepathid);
				end;
				{ else
				 writeln('the opendir thing did not work'); }
			     end; { is SRM-UX request }

	    openfile      : if not rmt_exec(f,unum,request) then
			    begin
			      fisnew            := false;
			      fnosrmtemp        := true;      {default case}
			      srm_open_dir(f,unum,open_directory,true );
			      if ioresult = ord(inoerror) then
				begin
				  srm_open_file(f,unum);
				  if ioresult <> ord(inoerror) then
				    srm_close_pathid(unum,pathid,fsavepathid);
				end;
			    end;

	    createfile,
	    overwritefile : if not rmt_exec(f,unum,request) then
			    begin
			      fisnew            := true;
			      fnosrmtemp        := false;
			      foverwritten      := request = overwritefile;
			      if not fanonymous then
				srm_open_dir(f,unum,open_directory,true );
			      if ioresult = ord(inoerror) then
				begin
				  srm_create_file(f,unum);
				  if ioresult <> ord(inoerror) then
				    if not fanonymous then
				      srm_close_pathid(unum,pathid,fsavepathid);
				end;
			    end;

	    makedirectory : begin
			      holdpathid  := pathid;
			      srm_open_dir(f,unum,open_directory,false);
			      if ioresult = ord(inoerror) then
				begin
				  srm_create_dir (f,unum);
				  srm_close_pathid(unum,pathid,fsavepathid);
				end;
			      pathid      := holdpathid;
			    end;

	    closefile     : if (fisnew and fanonymous) then
			      srm_purge_file(f,unum)
			    else
			      srm_close_file(f,unum);

	    changename    : srm_change_name(f,unum);

	    duplicatelink : srm_dup_link(f,unum);

	    purgename     : begin
			      holdpathid  := pathid;
			      srm_open_dir(f,unum,open_directory,true);
			      if ioresult = ord(inoerror) then
				begin
				  srm_purge_name(f,unum);
				  srm_close_pathid(unum,pathid,fsavepathid);
				end;
			      pathid      := holdpathid;
			    end;

	    lockfile      : srm_lock_file(f,unum);

	    unlockfile    : srm_unlock_file(f,unum);

	    purgefile     : srm_purge_file(f,unum);

	    setunitprefix : srm_set_unit_prefix(f,unum);

	    stretchit     : srm_stretch(f,unum);

	    getvolumename : srm_get_vol_name(f,unum);

	    getvolumedate : srm_get_vol_date(f,unum);

	    setvolumedate,
	    crunch        : {do nothing, but no error};

	    stripname     : srm_strip(f);

	    { Used by the FILER to distinguish SRM and SRM/UX }
	    { Added for 3.23+ and 3.24 JWH 11/12/90 }

	    setvolumename : begin
			     if is_srmux_unit(unum) then
			       setioresult(ord(ibadvalue))
			     else
			       setioresult(ord(ibadrequest));
			    end;

	    otherwise       setioresult(ord(ibadrequest));
	  end;

	  if (ioresult <> ord(inoerror)) and fisafib then {restore fib for subsequent calls}
	    begin
	      pathid        := savepathid;
	      fileid        := savefileid;
	      fsavepathid   := savefsavepathid;
	      ftid          := saveftid;
	      ffpw          := saveffpw;
	      fvid          := savefvid;
	      if strlen(saveftitle) > 0 then
		ftitle      := saveftitle;
	    end;
	  if ioresult = ord(isrmcatchall) then
	    if srmsavesc <> 0 then
	      escape(srmsavesc);
	end;
  recover
    begin
      if escapecode = ioescapecode then
	setioresult(ord(isrmcatchall))
      else
	begin
	  lockdown;
	  escape(escapecode);
	end;
    end;
  lockdown;
end; {srm_srmdam}

procedure lan_srmdam(anyvar f       : fib;
			    unum    : unitnum;
			    request : damrequesttype);
  begin
    lastunit := unum;
    lastsc   := unitable^[lastunit].sc;
    lansrm_reset(lastsc);
    with lsrm_unit_table^[lastunit] do
    begin
      srm_srmdam(f,unum,request);
    end;
  end;

procedure srmdam(anyvar f       : fib;
			unum    : unitnum;
			request : damrequesttype);
  {decide which dam should be installed}
    begin
    ioresult    := 0;
    with f, unitable^[unum] do
      if offline then ioresult := ord(znodevice)
      else
      begin
	if iompx_info = nil then
	  begin
	    dam := srm_srmdam;
	    volpack(unum);
	    with packet_ptr.rvol^ do
	     begin
	      if srm_ux_flag then
		srmux_on[unum] := true
	      else
		srmux_on[unum] := false;
	     end;
	   end
	  else
	begin
	  if (isc_table[sc].card_id = hp98643) then
	  begin
	    if iompx_info^.isc_iompx_table[sc].capable then
	    begin
	      if pad=0 then lansrm_init_unit(unum);
	      pad := 1; { shadow unit has been reset }
	      dam := lan_srmdam;
	      srmux_on[unum] := true; { Only possibility }
	    end
	    else ioresult := ord(znodevice);
	  end
	  else
	    begin
	     dam := srm_srmdam;
	     volpack(unum);
	     with packet_ptr.rvol^ do
	      begin
	       if srm_ux_flag then
		srmux_on[unum] := true
	       else
		srmux_on[unum] := false;
	      end;
	    end;
	end;
	{ complete the call }
	call(dam,f,unum,request);
      end;
  end; {srmdam}
{INTERNAL ONLY END}
end; {srmdammodule}

import
  srmdammodule;
begin   {program init_srm}
  srmdaminit;
end.

@


56.2
log
@
pws2rcs automatic delta on Wed Jan 27 11:57:27 MST 1993
@
text
@d1 2525
@


56.1
log
@Automatic bump of revision number for PWS version 3.25
@
text
@a0 2525
					       (*

 (c) Copyright Hewlett-Packard Company, 1983.
All rights are reserved.  Copying or other
reproduction of this program except for archival
purposes is prohibited without the prior
written consent of Hewlett-Packard Company.


	    RESTRICTED RIGHTS LEGEND

Use, duplication, or disclosure by the Government
is subject to restrictions as set forth in
paragraph (b) (3) (B) of the Rights in Technical
Data and Computer Software clause in
DAR 7-104.9(a).

HEWLETT-PACKARD COMPANY
Fort Collins, Colorado                         *)


$copyright 'COPYRIGHT (C) 1983 BY HEWLETT-PACKARD COMPANY'$
$range off$
$debug off$
$modcal$
$ALLOW_PACKED ON$  { JWS 4/10/85 }

program init_srm
{INTERNAL ONLY BEGIN}
	 (INPUT,OUTPUT)
{INTERNAL ONLY END}
	  ;

module srmdammodule;

{}
$SEARCH 'SRM_DRV',
	 'IOLIB:KERNEL'
{INTERNAL ONLY BEGIN}
	 ,'LANSRM','IOLIB:LANDECS'
{INTERNAL ONLY END}
	 $
{{
$SEARCH 'SRM_DRV',
	'LANSRM','LANDECS'$
{}
import
  sysglobals,
  misc,
  bootdammodule,
  iodeclarations,
{INTERNAL ONLY BEGIN}
  lansrm,
  landecs,
{INTERNAL ONLY END}
  srm
{INTERNAL ONLY BEGIN}
  ,asm
{INTERNAL ONLY END}
   ;

export

procedure srmdaminit;

procedure srmdam(anyvar f       : fib;
			unum    : unitnum;
			request : damrequesttype);


{ SRM/UX TESTING ONLY !!! }
{ procedure reset_counters;
  procedure show_counter_values;
  function srmux_mapfkind(ftype : gang_file_codes) : filekind; }

implement

type
  passarray     = array[1..8] of passentry;

const
  extentsize    = 8*512;   {arbitrary choice -- multiple of common block sizes}
  constpassarray= passarray[
			   passentry[pbits:hex('80000000'),pword:'MANAGER'   ],
			   passentry[pbits:hex('40000000'),pword:'READ'      ],
			   passentry[pbits:hex('20000000'),pword:'WRITE'     ],
			   passentry[pbits:hex('10000000'),pword:'SEARCH'    ],
			   passentry[pbits:hex('08000000'),pword:'PURGELINK' ],
			   passentry[pbits:hex('04000000'),pword:'CREATELINK'],
			   passentry[pbits:hex('FFFFFFFF'),pword:'ALL'       ],
			   passentry[pbits:hex('00000000'),pword:'NONE'      ]
			   ];
  allcapabilities = access_capabilities[32 of true];
  nocapabilities  = access_capabilities[32 of false];
  temp_file_pass  = '>TEMP_FILE_PASS<';         {password on temporary files}
  BDATTYPE      = -5791;
  BDATTYPE_500  = -5663;    { fix for BDAT 500 file }
  BASICBINTYPE  = -5775;
  BASICPROGTYPE = -5808;
  SYSTMTYPE     = -5822;
  DATATYPE      = -5622;
  CODETYPE      = -5582;
  TEXTTYPE      = -5570;
{INTERNAL ONLY BEGIN}
{ Added for SRM/UX : }
  PIPETYPE      = -5812;
  BDEVTYPE      = -5811;
  CDEVTYPE      = -5810;
  MISCTYPE      = -5809;
  NETTYPE       = -5806;
  SOCKTYPE      = -5805;
{INTERNAL ONLY END}
var
  passwordarrayptr      : ^passarray;
  tempcounter           : shortint;


{=================================================}
{ TESTING ONLY !!!!!!!!!! }
{ procedure reset_counters;
var i : damrequesttype;
begin
 for i := getvolumename to openunit do
   usage_array[i] := 0;
end;
procedure show_counter_values;
var i : damrequesttype;
var c : char;
begin
 for i := getvolumename to openunit do
   begin
    writeln(i,' request made ',usage_array[i] : 6,' times.');
    if i = closefile then read(c);
    if i = catalog then read(c);
   end;
end;
procedure log_srmdam_request(req : damrequesttype);
begin
  usage_array[req] := usage_array[req] + 1;
end; }
{=================================================}

(****************************************************************************)
procedure setioresult(result    : integer);
begin
  if ioresult = ord(inoerror) then
    ioresult := result;
end;

(****************************************************************************)
function mapfkind(ftype : gang_file_codes) : filekind;
var
  fk: filekind;
begin
  mapfkind      := datafile;
  for fk := lastfkind downto untypedfile do
    if efttable^[fk] = ftype.si2 then
      mapfkind := fk;
end;
(****************************************************************************)
function srmux_mapfkind(ftype : gang_file_codes) : filekind;
LABEL 1;
var
  fk: filekind;
  assigned : boolean;
  what : shortint;
begin
  srmux_mapfkind      := datafile;
  assigned := false;
  for fk := lastfkind downto untypedfile do
    if efttable^[fk] = ftype.si2 then
     begin
      srmux_mapfkind := fk;
      assigned := true;
     end;
  if not assigned then { just defaulted to datafile - do something ! }
    begin
      what := ftype.si2;
      { Pipetype : }
      if what = -5812 then begin srmux_mapfkind := fkind9; GOTO 1; end;
      { Bdevtype : }
      if what = -5811 then begin srmux_mapfkind := fkind10; GOTO 1; end;
      { Cdevtype : }
      if what = -5810 then begin srmux_mapfkind := fkind11; GOTO 1; end;
      { Othertype : }
      if what = -5809 then begin srmux_mapfkind := fkind12; GOTO 1; end;
      { Nettype : }
      if what = -5806 then begin srmux_mapfkind := fkind13; GOTO 1; end;
      { Socktype : }
      if what = -5805 then begin srmux_mapfkind := fkind14; GOTO 1; end;
      { Otherwise just leave it alone }
    end;
1:
end;

(****************************************************************************)
procedure paoc16tostr(anyvar paoc       : name_type;
		      anyvar strng      : string255);
var
  i     : shortint;
begin
  i     := sizeof(paoc);
  while (paoc[i] = ' ') and (i > 0) do
    i   := i - 1;
  setstrlen(strng,0);
  strmove(i,paoc,1,strng,1);
end;

(****************************************************************************)
procedure strtopaoc16(anyvar strng      : string255;
		      anyvar paoc       : name_type);
begin
  paoc  := ' ';
  if strlen(strng) < 17 then
    strmove(strlen(strng),strng,1,paoc,1);
end;

(****************************************************************************)
procedure setup_fns(var f       : fib;
		    anyvar fns  : file_name_set);
begin
  with f, fns do
    if strlen(ftid) = 0 then
      setioresult(ord(ibadtitle))
    else
      begin
	strtopaoc16(ftid,file_name);
	strtopaoc16(ffpw,password)
      end;
end;

(****************************************************************************)
procedure setup_fns3(var f      : fib;
		  anyvar nsa    : name_set_array_three);
var
  n             : integer;
  tempioresult  : integer;
  tempstr       : string[16];
begin
  with f do
    if (not fisnew) or fnosrmtemp then
      setup_fns(f,nsa)
    else
      if (strlen(ftid) = 0) and (not fanonymous) then
	setioresult(ord(ibadtitle))
      else
	begin
	  with nsa[1] do
	    begin
	      password  := ' ';
	      file_name := 'WORKSTATIONS';
	    end;
	  with nsa[2] do
	    begin
	      password  := ' ';
	      file_name := 'TEMP_FILES';
	    end;
	  with nsa[3] do
	    begin
	      password          := temp_file_pass;
	      setstrlen(tempstr,0);
	      tempioresult      := ioresult;
	      strwrite(tempstr,1,n,srmnode(unitable^[funit].sc),'_',fanonctr:1);
	      ioresult          := tempioresult;
	      strtopaoc16(tempstr,file_name);
	    end;
	end;
end;

(****************************************************************************)
procedure check_protectcode_set_array(    nps   : integer;
				      var psa   : protectcode_set_array);
{
9-May-1983 RAM
This routine has been added to check for right angle brackets ('>') in
passwords.  If any are found, ioresult is set to ord(ibadpass).  This
is because the parsing routines normally used with file opens terminate
passwords at the first '>', therefore it is not possible to use them in
passwords in normal operation.  If they are really desired, they can still be
created by calling the lower level packet routines directly.
Note that temporary files still have an "illegal" password.
This routine is called from srm_create_file and from srm_set_pass.
}
var     n       : integer;
	i       : integer;
begin
  for n := 1 to nps do
    for i := 1 to name_type_len do
      if psa[n].password[i] = '>' then
	setioresult(ord(ibadpass));
end;

(****************************************************************************)
procedure parseoptparm(    foptstring   : string255ptr;
		       var sharemode    : integer;
		       var lockable     : boolean;
		       var nps          : integer;
		       var psa          : protectcode_set_array;
			   modeonly     : boolean);
type
  tokentype     = (none,mode,pass,cap);
  statetype     = (needmodeorpass,needpass,needcap);
  acstrarrtype  = array [ac_manager .. ac_createlink] of string[10];
const
  tokenlen      = 16;
  acstrarray    = acstrarrtype['MANAGER','READ','WRITE',
			       'SEARCH','PURGELINK','CREATELINK'];
var
  typeoftoken   : tokentype;
  state         : statetype;
  sindx         : integer;
  delim         : char;
  ac            : ac_manager..ac_createlink;
  token         : string[16];
  ok            : boolean;

procedure getuntildelim(del1    : char;
			del2    : char);
var
  startindx     : integer;
begin
  delim         := chr(0);
  startindx     := sindx;
  while (sindx <= strlen(foptstring^)) and (delim = chr(0)) do
    if  (foptstring^[sindx] <> del1)
    and (foptstring^[sindx] <> del2) then
      sindx     := sindx + 1
    else
      delim     := foptstring^[sindx];
  if (sindx - startindx) <= tokenlen then
    token := str(foptstring^,startindx,sindx - startindx)
  else
    setioresult(ord(ibadvalue));
  if sindx <= strlen(foptstring^) then
    sindx     := sindx + 1;
end;

begin   {parseoptparm}
  sharemode     := exclusive_share_code;
  lockable      := false;
  state         := needmodeorpass;
  nps           := 0;
  sindx         := 1;
  if foptstring <> nil then
    while (sindx <= strlen(foptstring^)) and (ioresult = ord(inoerror)) do
      begin
	case state of
	  needmodeorpass:
			begin
			  getuntildelim(',', ':');
			  if delim = ':' then
			    begin
			      typeoftoken     := pass;
			      state           := needcap;
			    end
			  else
			    begin
			      typeoftoken     := mode;
			      state           := needpass;
			    end;
			  if modeonly then
			    sindx := strlen(foptstring^) + 1;
			end;
	  needpass    : begin
			  getuntildelim(':', ':');
			  if delim = ':' then
			    begin
			      typeoftoken     := pass;
			      state           := needcap;
			    end
			  else
			    setioresult(ord(ibadvalue));
			end;
	  needcap     : begin
			  getuntildelim(',', ';');
			  typeoftoken        := cap;
			  if delim = ',' then
			    state     := needcap
			  else if delim = ';' then
			    state     := needpass;
			end;
	end;    {case}
	if ioresult = ord(inoerror) then
	  case typeoftoken of
	    mode  : begin
		      upc(token);
		      if token = 'EXCLUSIVE' then
			sharemode := exclusive_share_code
		      else if token = 'SHARED' then
			sharemode := shared_share_code
		      else if token = 'LOCKABLE' then
			begin
			  sharemode := shared_share_code;
			  lockable  := true;
			end
		      else
			setioresult(ord(ibadvalue));
		    end;
	    pass  : begin
		      nps := nps + 1;
		      with psa[nps] do
			begin
			  strtopaoc16(token,password);
			  capabilities := nocapabilities;
			end;
		    end;
	    cap   : begin
		      upc(token);
		      ok := false;
		      with psa[nps] do
			if token = 'ALL' then
			  begin
			    capabilities := allcapabilities;
			    ok := true;
			  end
			else
			  for ac := ac_manager to ac_createlink do
			    if token = acstrarray[ac] then
			      begin
				capabilities[ac] := true;
				ok := true;
			      end;
		      if not ok then
			setioresult(ord(ibadvalue));
		    end;
	  end;
      end;
end;

(****************************************************************************)
procedure srm_close_fileid(unum         : unitnum;
			   var fileid   : integer);
begin
  if fileid = 0 then
    fileid    := -1
  else
    if (fileid > 0) and (fileid <> unitable^[unum].dvrtemp) then
      with packet_ptr.rhead^ do
	begin
	  closepack(unum,fileid);
	  if status = 0 then
	    fileid := -1;
	end;
end;

(****************************************************************************)
procedure srm_close_pathid(unum         : unitnum;
			   var pathid   : integer;
			   savepathid   : boolean);
begin
  if not savepathid then
    srm_close_fileid(unum,pathid);
end;

(****************************************************************************)
procedure translatedate(var srmdate     : date_type;
			var systemdate  : daterec;
			var systemtime  : timerec);
var
  time          : integer;
begin
  with srmdate do
    begin
      with systemdate do
	begin
	  month         := date.month;
	  day           := date.day;
	  year          := date.year;
	  {RDQ 21MAR88 map 0..27 to 100..127}
	  if year < 28 then year := year + 100;
	end;
      with systemtime do
	begin
	  time          := seconds_since_midnight;
	  hour          := time div 3600;
	  minute        := (time-(hour*3600)) div 60;
	  centisecond   := (time mod 60) * 100;
	end;
    end;
end;

(****************************************************************************)
procedure srm_get_dir_info(anyvar dircatentry   : catentry;
			      var dirid         : integer;
				  unum          : unitnum;
				  long          : boolean;
				  dir_is_dvrtemp: boolean);
const
  zerodate      = daterec[year:0,day:0,month:0];
  zerotime      = timerec[hour:0,minute:0,centisecond:0];
var
  n             : integer;
  tempioresult  : integer;
begin
  with dircatentry, unitable^[unum] do
    begin
      setstrlen(cname,0);
      volpack(unum);
      with packet_ptr.rvol^, packet_ptr.rhead^ do
	begin
	  if status = 0 then
	    if not exist { .value } then { Changed for SRM-UX }
	      setioresult(ord(ilostunit))  {set ioresult to no volume}
	    else
	      begin
		paoc16tostr(volume_name,cname);
		cextra1         := -1;  {max_file_size div 32}
		cpsize          := -1;
		clsize          := -1;
		cextra2         := interleave;
		cstart          := -1;
		cblocksize      := 1;
		ccreatedate     := zerodate;
		ccreatetime     := zerotime;
		clastdate       := zerodate;
		clasttime       := zerotime;
		setstrlen(cinfo,0);
		tempioresult    := ioresult;
		{ Changed for SRM-UX : }
{INTERNAL ONLY BEGIN}
		if is_srmux_unit(unum) then
		  strwrite(cinfo,1,n,'SRM/UX ',sc:1,',',ba:1,',',du:1)
		else
{INTERNAL ONLY END}
		  strwrite(cinfo,1,n,'SRM  ',sc:1,',',ba:1,',',du:1);
		ioresult        := tempioresult;
		if dirid > 0 then
		  begin
		    fileinfopack(unum,dirid);
		    with packet_ptr.rfileinfo^, file_info do
		      if status <> 0 then
			begin
			  ioresult := tempioresult;
			  if dir_is_dvrtemp then
			    dirid := 0;
			end
		      else
			begin
			  if file_name <> ' ' then
			    paoc16tostr(file_name,cname);
			  if long then
			    begin
			      translatedate(creation_date,ccreatedate,ccreatetime);
			      translatedate(last_access_date,clastdate,clasttime);
			    end;
			end;
		  end;
	      end;
	end;
    end;
end;

(****************************************************************************)
procedure srm_get_vol_name(anyvar f     : vid;
				  unum  : unitnum);
var
  dircatentry   : catentry;
begin
  srm_get_dir_info(dircatentry,unitable^[unum].dvrtemp,unum,false,true);
  f := dircatentry.cname;
end;

(****************************************************************************)
procedure srm_set_pass(anyvar f         : fib;
			      unum      : unitnum);
type
  catarray      = array[0..maxint] of passentry;
  catarrayptr   = ^catarray;
var
  volpass       : name_type;
  fns           : file_name_set;
  nps           : integer;
  done          : boolean;
  i             : integer;
  j             : integer;
  catindx       : integer;
  catentryindx  : integer;
  tempcapbits   : record case boolean of
		    true  : (i  : integer);
		    false : (b  : access_capabilities);
		  end;
  psa           : protectcode_set_array;
begin
  with f do
    begin
      setup_fns(f,fns);
      if ioresult = ord(inoerror) then
	begin
	  for i := 1 to fpeof do
	    with psa[i], catarrayptr(fwindow)^[i-1] do
	      begin
		strtopaoc16(pword,password);
		tempcapbits.i   := pbits;
		capabilities    := tempcapbits.b;
		nps             := i;
	      end;
	  strtopaoc16(fvid,volpass);
	  check_protectcode_set_array(nps,psa);
	  if ioresult = ord(inoerror) then
	    changeprotectpack(unum,1,addr(fns),start_alternate,pathid,
			      volpass,nps,addr(psa));
	end;
    end;
end;

(****************************************************************************)
procedure srm_cat_pass(anyvar f         : fib;
			      unum      : unitnum);
type
  catarray      = array[0..maxint] of passentry;
  catarrayptr   = ^catarray;
var
  volpass       : name_type;
  fns           : file_name_set;
  done          : boolean;
  i             : integer;
  j             : integer;
  catindx       : integer;
  catentryindx  : integer;
  tempcapbits   : record case boolean of
		    true  : (i  : integer);
		    false : (b  : access_capabilities);
		  end;
begin
  catentryindx  := 0;
  done  := false;
  with f, packet_ptr.rcatpass^ do
    begin
      setup_fns(f, fns);
      if ioresult = ord(inoerror) then
	begin
	  strtopaoc16(fvid,volpass);
	  foptstring    := anyptr(passwordarrayptr);
	  catindx   := fpos + 1;
	  while (catentryindx < fpeof) and (not done) and (ioresult = ord(inoerror)) do
	    begin
	      catpasspack(unum,1,addr(fns),start_alternate,
			  pathid,volpass,24,catindx);
	      if ioresult = ord(inoerror) then
		begin
		  i   := 1;
		  if actual_num_passwords < 24 then
		    done      := true;
		  while i <= actual_num_passwords do
		    if catentryindx < fpeof then
		      begin
			with password_info[i], catarrayptr(fwindow)^[catentryindx] do
			  begin
			    paoc16tostr(password,pword);
			    tempcapbits.b   := capabilities;
			    pbits           := tempcapbits.i;
			  end;
			i             := i + 1;
			catentryindx  := catentryindx + 1;
		      end
		    else
		      begin
			i       := 25;
			done    := true;
		      end;
		  catindx     := catindx + 24;
		end;
	    end;
	end;
      fpeof := catentryindx;
    end;
end;

(****************************************************************************)
procedure srm_catalog(anyvar f      : fib;
			 unum   : unitnum);
type
  catarray      = array[0..maxint] of catentry;
  catarrayptr   = ^catarray;
  ac_char_arr   = array [ac_manager..ac_createlink] of char;
const
  ac_chars      = ac_char_arr['M','R','W','S','P','C'];
var
  volpass       : name_type;
  fns           : file_name_set;
  done          : boolean;
  i             : integer;
  j             : integer;
  catindx       : integer;
  catentryindx  : integer;
  ac            : access_code_type;
  temp_num      : integer; { Added for SRM-UX }
  leading       : boolean;
begin
  catentryindx  := 0;
  done  := false;
  with f, packet_ptr.rcat^ do
    begin
      strtopaoc16(fvid,volpass);
      catindx   := fpos + 1;
      while (catentryindx < fpeof) and not done do
	begin
	  catpack(unum,0,addr(fns),start_alternate,
		  pathid,volpass,7,catindx);
	  if ioresult <> ord(inoerror) then
	    done      := true
	  else
	    begin
	      i   := 1;
	      if actual_num_files < 7 then
		done      := true;
	      while i <= actual_num_files do
		if catentryindx < fpeof then
		  begin
		    with cat_info[i], catarrayptr(fwindow)^[catentryindx] do
		      begin
			paoc16tostr(file_name,cname);
	     {=============================================================}
			if is_srmux_unit(unum) then
			 begin
			  ceft      := file_code.si2;
			  ckind     := srmux_mapfkind(file_code);
			 end
	     {=============================================================}
			else { same as before }
			 begin
			  ceft      := file_code.si2;
			  ckind     := mapfkind(file_code);
			 end;
			cpsize    := physical_size;
			clsize    := logical_eof;
			cstart    := -1;
			translatedate(creation_date,ccreatedate,ccreatetime);
			translatedate(last_access_date,clastdate,clasttime);
			cblocksize:= -1;
			cextra1   := -1;
			cextra2   := -1;
			if not is_srmux_unit(unum) then
			 begin
			  setstrlen(cinfo,ord(ac_createlink)+1);
			  for ac := ac_manager to ac_createlink do
			    if capabilities[ac] then
			      cinfo[ord(ac) + 1] := ac_chars[ac]
			    else
			      cinfo[ord(ac) + 1] := ' ';
			   case share_code of
			    exclusive_share_code  : cinfo := cinfo + ' EXCLUSIVE';
			    shared_share_code     : cinfo := cinfo + ' SHARED';
			    {
			    closed_share_code     : cinfo := cinfo + ' CLOSED';
			    }
			    corrupt_share_code    : cinfo := cinfo + ' CORRUPT';
			    otherwise               cinfo := cinfo + ' CLOSED';
			  end; { CASE }
			end { Not an SRM-UX unit }
			 else
			  begin { Is an SRM-UX unit }
			  setstrlen(cinfo,17); { SRM-UX size needed }

			  { Initialize to no permissions : }
			  cinfo[1] := ' '; { for now }
			  if ckind = untypedfile then
			    cinfo[1] := 'd'; { for now }

			  cinfo[2] := '0'; cinfo[3] := '0'; cinfo[4] := '0';
			  cinfo[5] := 'm';

{===========================================================================}
{ Handle the special Hp-ux files that could show up for an SRM/UX user :    }
{ Put an appropriate character in front of the mode, set the type and       }
{ kind to 0. This is what the HFSDAM does now when we encounter a file of   }
{ one of these types on an HFS disk shared with HP/UX.                      }

			  case ckind of
			     fkind9 : begin
				       cinfo[1] := 'p'; { Pipe }
				       ceft := 0;
				       ckind := fkind8; { 0 }
				      end;
			     fkind10 : begin
					cinfo[1] := 'b'; { Bdev }
					ceft := 0;
					ckind := fkind8; { 0 }
				       end;
			     fkind11 : begin
					cinfo[1] := 'c'; { Cdev }
					ceft := 0;
					ckind := fkind8; { 0 }
				       end;
			     fkind12 : begin
					cinfo[1] := 'o'; { Other }
					ceft := 0;
					ckind := fkind8; { 0 }
				       end;
			     fkind13 : begin
					cinfo[1] := 'n'; { Network }
					ceft := 0;
					ckind := fkind8; { 0 }
				       end;
			     fkind14 : begin
					cinfo[1] := 's'; { Socket }
					ceft := 0;
					ckind := fkind8; { 0 }
				       end;
			     otherwise ; { do nothing }
			  end; { case }
{===========================================================================}


			  { Just set the darn things brute force,
			    there is no need to be cute : }

			  temp_num := 0;
			  if capabilities[ac_owner_r] then
			  temp_num := temp_num + 4;
			  if capabilities[ac_owner_w] then
			  temp_num := temp_num + 2;
			  if capabilities[ac_owner_x] then
			  temp_num := temp_num + 1;
			  if temp_num > 0 then
			     cinfo[2] := chr(ord('0') + temp_num);

			  temp_num := 0;
			  if capabilities[ac_group_r] then
			  temp_num := temp_num + 4;
			  if capabilities[ac_group_w] then
			  temp_num := temp_num + 2;
			  if capabilities[ac_group_x] then
			  temp_num := temp_num + 1;
			  if temp_num > 0 then
			     cinfo[3] := chr(ord('0') + temp_num);

			  temp_num := 0;
			  if capabilities[ac_other_r] then
			  temp_num := temp_num + 4;
			  if capabilities[ac_other_w] then
			  temp_num := temp_num + 2;
			  if capabilities[ac_other_x] then
			  temp_num := temp_num + 1;
			  if temp_num > 0 then
			     cinfo[4] := chr(ord('0') + temp_num);

			   { Keep filling in cinfo fields ... : }

			  temp_num := creation_date.id; { has uid now }
			  leading := true;
			  cinfo[6] := chr(ord('0') + temp_num div 10000);
			  if (cinfo[6] = '0') then
			     cinfo[6] := ' '
			  else
			     leading := false;
			  cinfo[7] := chr(ord('0') +
					  (temp_num div 1000) mod 10);
			  if ((cinfo[7] = '0') and leading) then
			     cinfo[7] := ' '
			  else
			     leading := false;
			  cinfo[8] := chr(ord('0') +
					  (temp_num div 100) mod 10);
			  if ((cinfo[8] = '0') and leading) then
			     cinfo[8] := ' '
			  else
			     leading := false;
			  cinfo[9] := chr(ord('0') +
					  (temp_num div 10) mod 10);
			  if ((cinfo[9] = '0') and leading) then
			     cinfo[9] := ' '
			  else
			     leading := false;
			  cinfo[10] := chr(ord('0') +
					  temp_num mod 10);
			  cinfo[11] := 'u';

			  temp_num := last_access_date.id; { has gid now }
			  leading := true;
			  cinfo[12] := chr(ord('0') + temp_num div 10000);
			  if (cinfo[12] = '0') then
			     cinfo[12] := ' '
			  else
			     leading := false;
			  cinfo[13] := chr(ord('0') +
					  (temp_num div 1000) mod 10);
			  if ((cinfo[13] = '0') and leading) then
			     cinfo[13] := ' '
			  else
			     leading := false;
			  cinfo[14] := chr(ord('0') +
					  (temp_num div 100) mod 10);
			  if ((cinfo[14] = '0') and leading) then
			     cinfo[14] := ' '
			  else
			     leading := false;
			  cinfo[15] := chr(ord('0') +
					  (temp_num div 10) mod 10);
			  if ((cinfo[15] = '0') and leading) then
			     cinfo[15] := ' '
			  else
			     leading := false;
			  cinfo[16] := chr(ord('0') +
					  temp_num mod 10);
			  cinfo[17] := 'g';

			   case share_code of
			    exclusive_share_code  : cinfo := cinfo + ' EX';
			    shared_share_code     : cinfo := cinfo + ' SH';
			    corrupt_share_code    : cinfo := cinfo + ' CO';
			    otherwise               cinfo := cinfo + ' CL';
			  end; { CASE }
			end; { Is an SRM-UX unit }
		      end;
		    i := i + 1;
		    catentryindx := catentryindx + 1;
		  end
		else
		  begin
		    i       := 8;
		    done    := true;
		  end;
	      catindx     := catindx + 7;
	    end;
	end;
      fpeof := catentryindx;
    end;
end;  { srm_catalog }
(****************************************************************************)
procedure srm_open_dir(anyvar f         : fib;
			      unum      : unitnum;
			      opentype  : gang_open_type;
			      openparent:boolean);
var
  volpass       : name_type;
  lentitle      : integer;
  sindx         : integer;
  pindx         : integer;
  nindx         : integer;
  i             : integer;
  path          : path_start_type;
  saveid        : file_id_type;
  origpathid    : file_id_type;
  last          : boolean;
  alreadyopen   : boolean;
  nfns          : integer;
  nsa           : name_set_array;

procedure getpaoc(anyvar paoc   : name_type;
			 del1   : char;
			 del2   : char);
var
  done  : boolean;
begin
  with f do
    begin
      done  := false;
      while (sindx <= lentitle) and (pindx <= name_type_len) and (not done) do
	if  (ftitle[sindx] = del1) or (ftitle[sindx] = del2) then
	  done            := true
	else
	  begin
	    paoc[pindx]   := ftitle[sindx];
	    pindx         := pindx + 1;
	    sindx         := sindx + 1;
	  end;
      if (sindx > lentitle) then
	begin
	  if del1 = '>' then
	    ioresult := ord(ibadpass);
	end
      else
	begin
	  if  (ftitle[sindx] <> del1) and (ftitle[sindx] <> del2) then
	    begin
	      if del1 = '>' then
		ioresult := ord(ibadpass)
	      else
		ioresult := ord(ibadtitle);
	    end
	  else
	    if (del1 = '>') then
	      if (ftitle[sindx] <> '>') then
		ioresult := ord(ibadpass);
	end;
    end;
end;



begin
  last          := false;
  alreadyopen   := false;
  sindx         := 1;

  with f do
    begin
      origpathid        := pathid;
      lentitle          := strlen(ftitle);
      setstrlen(ftid,0);
      if pathid = -1 then
	begin
	  setstrlen(fvid,0);
	  setstrlen(ffpw,0);
	end;
      if (sindx <= lentitle) then
	if ftitle[sindx] = '<' then       {get volume password}
	  begin
	    sindx   := sindx + 1;
	    pindx   := 1;
	    volpass := ' ';
	    getpaoc(volpass,'>','>');
	    paoc16tostr(volpass,fvid);
	    sindx   := sindx + 1;
	  end;

      path := start_alternate;
      if ioresult = ord(inoerror) then
	if (sindx <= lentitle) then
	  if ftitle[sindx] = '/' then
	    begin
	      path  := start_root;
	      sindx := sindx + 1;
	    end;
      if pathid = -1 then
	if path = start_root then
	  pathid := 0
	else
	  pathid := unitable^[unum].dvrtemp;

      if sindx > lentitle then
	begin
	  last      := true;
	  setstrlen(ftitle,0);
	end
      else
	if (ftitle[lentitle] = '/') then
	  setioresult(ord(ibadtitle));

      with packet_ptr.ropen^ do
	while (not last) and (ioresult = ord(inoerror)) do
	  begin
	    nfns        := 0;
	    while (sindx <= lentitle) and (nfns < 6) and (ioresult = ord(inoerror)) do
	      begin
		with nsa[nfns+1] do
		  begin
		    if (ftitle[sindx] = '/') then
		      ioresult      := ord(ibadtitle)
		    else
		      begin
			file_name       := ' ';
			password        := ' ';
			pindx           := 1;
			getpaoc(file_name,'<','/');
			nindx           := pindx;
			if ioresult = ord(inoerror) then
			  if (sindx <= lentitle) then
			    if (ftitle[sindx] = '<') then
			      begin
				sindx   := sindx + 1;
				pindx   := 1;
				getpaoc(password,'>','>');
				sindx   := sindx + 1;
				if sindx <= lentitle then
				  if ftitle[sindx] <> '/' then
				    if nindx > lentitle then
				      ioresult := ord(ibadtitle)
				    else
				      begin
					pindx := nindx;
					getpaoc(file_name,'/','/');
				      end;
			      end;
			if ioresult = ord(inoerror) then
			  if (sindx > lentitle) then
			    begin
			      last    := true;
			      setstrlen(ftitle,0);
			    end;
		      end;
		  end;
		if ioresult = ord(inoerror) then
		  nfns := nfns + 1;
		sindx   := sindx + 1;
	      end;

	    if ioresult = ord(inoerror) then
	      begin
		if not (last and openparent) then
		  begin
		    openpack(unum,nfns,addr(nsa),path,
			     pathid,volpass,shared_share_code,opentype);
		    if ioresult <> ord(inoerror) then
		      begin
			if last then
			  begin
			    ioresult := ord(inoerror);
			    openparent := true;
			  end;
		      end
		    else
		      begin
			saveid        := file_id;
			if alreadyopen then
			  srm_close_pathid(unum,pathid,false)
			else
			  alreadyopen := true;
			pathid        := saveid;
			path          := start_alternate;
		      end;
		  end;
		if ioresult = ord(inoerror) then
		  begin
		    if last and openparent then
		      begin
			if (nfns <= 1) then
			  begin
			    if pathid = -1 then
			      setioresult(ord(inodirectory));
			  end
			else
			  begin
			    openpack(unum,nfns-1,addr(nsa),path,
				     pathid,volpass,shared_share_code,opentype);
			    if ioresult <> ord(inoerror) then
			      begin
				if alreadyopen then
				  srm_close_pathid(unum,pathid,false);
			      end
			    else
			      begin
				saveid        := file_id;
				if alreadyopen then
				  srm_close_pathid(unum,pathid,false);
				pathid        := saveid;
			      end;
			  end;
			if ioresult = ord(inoerror) then
			  with nsa[nfns] do
			    begin
			      paoc16tostr(file_name,ftid);
			      ftitle      := ftid;
			      if password <> ' ' then
				paoc16tostr(password,ffpw);
			    end;
		      end;
		  end;
	      end;
	  end;
      if ((origpathid <> -1) and (origpathid = pathid))
      or (pathid = unitable^[unum].dvrtemp) then
	fsavepathid     := true
      else
	fsavepathid     := false;
    end;
end;

(****************************************************************************)
procedure srm_set_unit_prefix(anyvar f  : fib;
			      unum      : unitnum);
var
  savpathid     : integer;
begin
  with f, unitable^[unum] do
    begin
      srm_open_dir(f,unum,open_protected_directory,false);
      if ioresult = ord(inoerror) then
	begin
	  if strlen(ftitle) > 0 then
	    setioresult(ord(inounit))
	  else
	    begin
	      savpathid := pathid;
	      pathid    := dvrtemp;
	      dvrtemp   := savpathid;
	    end;
	  srm_close_pathid(unum,pathid,false);
	end;
      srm_get_vol_name(uvid,unum);
    end;
end;

(****************************************************************************)
procedure doopenpack(unum       : unitnum;
		     var f      : fib;
		     nfns       : integer;
		     anyvar nsa : name_set_array;
		     path       : path_start_type;
		     volpass    : name_type;
		     sharecode  : integer;
		     lockable   : boolean);
type
  trickrec      = record case boolean of
		    true  :(i   : integer);
		    false :(chs : packed array [1..2] of char;
			    si2 : shortint);
		  end;
var
  temprec       : trickrec;
begin
      with f, packet_ptr.ropen^ do
	begin
	  if lockable and fistextvar then
	    setioresult(ord(inotlockable))
	  else
	    openpack(unum,nfns,addr(nsa),path,pathid,volpass,
			       sharecode,open_data);
	  if ioresult = ord(inoerror) then
	    if file_code.si2 = 3 then   {directory}
	      begin
		setioresult(ord(inotondir));
		closepack(unum,file_id);
	      end
	    else
	      begin
		fileid        := file_id;
		fpeof         := open_logical_eof;
		fleof         := open_logical_eof;
		feft          := file_code.si2;
		fkind         := mapfkind(file_code);
		flockable     := lockable;
		flocked       := not lockable;  {default to locked unless lockable}
		if (feft = BDATTYPE)            {BDAT file}
		or (feft = BDATTYPE_500)        {fix for BDAT 500 file}
		or (feft = BASICBINTYPE)        {BIN  file}
		or (feft = BASICPROGTYPE) then  {PROG file}
		  begin
		    temprec.chs   := '  ';
		    temprec.si2   := max_record_size div 2;
		    fstartaddress := temprec.i;
		  end
		else
		  fstartaddress   := boot_start_address;
		if not fbuffered   then     am := amtable^[untypedfile]
		else if fistextvar then     am := amtable^[fkind]
		else                        am := amtable^[datafile];
	      end;
	end;
end;

(****************************************************************************)
procedure srm_open_file(anyvar f        : fib;
			       unum     : unitnum);
type
  trickrec      = record case boolean of
		    true  :(i   : integer);
		    false :(si1 : shortint;
			    si2 : shortint);
		  end;
var
  volpass       : name_type;
  fns           : file_name_set;
  temprec       : trickrec;
  sharemode     : integer;
  nps           : integer;
  psa           : protectcode_set_array;
  lockable      : boolean;
begin
  with f do
    begin
      setup_fns(f, fns);
      parseoptparm(foptstring,sharemode,lockable,nps,psa,true);
      if ioresult = ord(inoerror) then
	begin
	  strtopaoc16(fvid,volpass);
	  doopenpack(unum,f,1,fns,start_alternate,volpass,sharemode,lockable);
	end;
    end;
end;

(****************************************************************************)
procedure srm_create_dir (anyvar f      : fib;
				 unum   : unitnum);
type
  catentryptr   = ^catentry;
const
  dirfilecode   = gang_file_codes[i:3];
var
  volpass       : name_type;
  fns           : file_name_set;
begin
  with f, catentryptr(fwindow)^ do
    if strlen(cname) = 0 then
      setioresult(ord(ibadtitle))
    else
      begin
	with fns do
	  begin
	    password      := ' ';
	    strtopaoc16(cname,file_name);
	  end;
	strtopaoc16(fvid,volpass);
	createpack(unum,1,addr(fns),start_alternate,pathid,volpass,0,nil,
		   dirfilecode,directory_records,0,0,0,0);
      end;
end;

(****************************************************************************)
procedure srm_create_file(anyvar f      : fib;
				 unum   : unitnum);
const
  dirfilecode   = gang_file_codes[i:3];
type
  trickrec      = record case boolean of
		    true  :(i   : integer);
		    false :(si1 : shortint;
			    si2 : shortint);
		  end;
var
  volpass       : name_type;
  nsa           : name_set_array_three;
  ext1          : integer;
  temprec       : trickrec;
  sharemode     : integer;
  maxrec        : integer;
  nps           : integer;
  usefeft       : gang_file_codes;
  psa           : protectcode_set_array;
  i             : integer;
  ac            : ac_manager..ac_purgelink;
  lockable      : boolean;

begin
  with f, nsa[3] do
    begin
      strtopaoc16(fvid,volpass);
      repeat
	ioresult        := ord(inoerror);
	fanonctr        := tempcounter;
	tempcounter     := tempcounter + 1;
	usefeft.i       := feft;

	{BDAT file} {fix for BDAT 500 file}
	if (feft = BDATTYPE) or (feft = BDATTYPE_500) then
	  begin
	    temprec.i       := fstartaddress;
	    maxrec          := temprec.si2 * 2;
	    if maxrec < 1 then
	      maxrec := 1;
	  end
	else
	  maxrec    := 256;
	if fpos > 0 then
	  ext1 := fpos
	else
	  ext1 := extentsize;
	parseoptparm(foptstring,sharemode,lockable,nps,psa,false);
	check_protectcode_set_array(nps,psa);
	if (nps > 0) and (nps < 24) and (ioresult = ord(inoerror)) then
	  begin
	    nps := nps + 1;
	    with psa[nps] do
	      begin
		password        := temp_file_pass;
		capabilities    := nocapabilities;
		if nps > 1 then
		  for i := 1 to nps-1 do
		    for ac := ac_manager to ac_purgelink do
		      if psa[i].capabilities[ac] then
			capabilities[ac] := true;
	      end;
	  end;

	if (not fanonymous) and (ioresult = ord(inoerror)) then
	  begin
	    setup_fns(f,nsa);
	    foldfileid := -1;
	    openpack(unum,1,addr(nsa),start_alternate,pathid,volpass,sharemode,open_data);
	    if ioresult = ord(inofile) then
	      begin
		ioresult := ord(inoerror);
		nsa[1].password := ' ';
		createpack(unum,1,addr(nsa),start_alternate,pathid,volpass,
			   nps,addr(psa),usefeft,data_records,
			   maxrec,ext1,extentsize,fstartaddress);
		if ioresult = ord(inoerror) then
		  if feft <> SYSTMTYPE then
		    fnosrmtemp := true
		  else
		    begin               {SYSTM files must go through temp first}
		      nsa[1].password := temp_file_pass;
		      openpack(unum,1,addr(nsa),start_alternate,pathid,
			       volpass,sharemode,open_data);
		    end;
	      end;
	    if (ioresult = ord(inoerror)) and (not fnosrmtemp) then
	      begin
		foldfileid := packet_ptr.ropen^.file_id;
		fileinfopack(unum,foldfileid);
		with packet_ptr.rfileinfo^.file_info do
		  begin
		    if  (not capabilities[ac_manager])
		    and (not capabilities[ac_purgelink]) then
		      setioresult(ord(ibadpass))   {won't be able to purge old}
		    else           {this test added in version 2.2 on 4-May-83}
		      if file_code.si2 = 3 then {disallow rewrite on directory}
			setioresult(ord(inotondir));
		    if ioresult <> ord(inoerror) then
		      srm_close_fileid(unum,foldfileid);
		  end;
	      end;
	  end;

	if (ioresult = ord(inoerror)) and (not fnosrmtemp) then
	  begin
	    setup_fns3(f,nsa);
	    if ioresult = ord(inoerror) then
	      begin
		password        := ' ';
		createpack(unum,3,addr(nsa),start_root,pathid,volpass,
			   nps,addr(psa),usefeft,data_records,
			   maxrec,ext1,extentsize,fstartaddress);
		if ioresult = ord(inofile) then
		  begin
		    ioresult := ord(inoerror);
		    createpack(unum,2,addr(nsa),start_root,pathid,volpass,
			       0,nil,dirfilecode,directory_records,0,0,0,0);
		    if ioresult <> ord(inoerror) then
		      ioresult := ord(ineedtempdir)
		    else
		      createpack(unum,3,addr(nsa),start_root,pathid,volpass,
				 nps,addr(psa),usefeft,data_records,
				 maxrec,ext1,extentsize,fstartaddress);
		  end
		else
		  if ioresult = ord(idupfile) then
		    begin
		      ioresult := ord(inoerror);
		      password := temp_file_pass;
		      purgepack(unum,3,addr(nsa),start_root,pathid,volpass);
		      ioresult := ord(inoerror);
		      password := ' ';
		      createpack(unum,3,addr(nsa),start_root,pathid,volpass,
				 nps,addr(psa),usefeft,data_records,
				 maxrec,ext1,extentsize,fstartaddress);
		    end;
	      end;
	  end;
      until (ioresult <> ord(idupfile));
      if ioresult <> ord(inoerror) then
	srm_close_fileid(unum,foldfileid)
      else
	if fnosrmtemp then
	  begin
	    nsa[1].password := temp_file_pass;
	    doopenpack(unum,f,1,nsa,start_alternate,volpass,sharemode,lockable);
	  end
	else
	  begin
	    password := temp_file_pass;
	    doopenpack(unum,f,3,nsa,start_root,volpass,exclusive_share_code,lockable);
	  end;
    end;
end;

(****************************************************************************)
procedure srm_change_name(anyvar f      : fib;
				 unum   : unitnum);
type
  fidptr        = ^fid;
var
  volpass       : name_type;
  path1         : path_start_type;
  nfns1         : integer;
  fns1          : file_name_set;
  path2         : path_start_type;
  nfns2         : integer;
  fns2          : file_name_set;
begin
  with f, unitable^[unum] do
    begin
      srm_open_dir(f,unum,open_directory,true);
      if ioresult = ord(inoerror) then
	setup_fns(f, fns1);
      if ioresult = ord(inoerror) then
	with fns2 do
	  begin
	    file_name   := ' ';
	    password    := ' ';
	    if strpos('/',fidptr(fwindow)^) = 0 then
	      if (strpos('<',fidptr(fwindow)^) = 0) then
		strtopaoc16(fidptr(fwindow)^,file_name);
	    if file_name = ' ' then
	      setioresult(ord(ibadtitle));
	  end;
      if ioresult = ord(inoerror) then
	begin
	  strtopaoc16(fvid,volpass);
	  createlinkpack(unum,1,addr(fns1),start_alternate,pathid,volpass,
			 1,addr(fns2),start_alternate,pathid,volpass,true);
	end;
      srm_close_pathid(unum,pathid,fsavepathid);
    end;
end;

(****************************************************************************)
procedure srm_dup_link(anyvar f         : fib;
			      unum      : unitnum);
var
  volpass       : name_type;
  volpass2      : name_type;
  path1         : path_start_type;
  nfns1         : integer;
  fns1          : file_name_set;
  path2         : path_start_type;
  nfns2         : integer;
  fns2          : file_name_set;
begin
  with f, unitable^[unum] do
    begin
      srm_open_dir(f,unum,open_directory,true);
      if ioresult = ord(inoerror) then
	setup_fns(f, fns1);
      if ioresult = ord(inoerror) then
	srm_open_dir(fibp(fwindow)^,unum,open_directory,true);
      if ioresult = ord(inoerror) then
	setup_fns(fibp(fwindow)^, fns2);
      if ioresult = ord(inoerror) then
	begin
	  strtopaoc16(fvid,volpass);
	  strtopaoc16(fibp(fwindow)^.fvid,volpass2);
	  createlinkpack(unum,1,addr(fns1),start_alternate,pathid,volpass,
	      1,addr(fns2),start_alternate,fibp(fwindow)^.pathid,volpass2,
	      fpurgeoldlink);
	end;
      srm_close_pathid(unum,pathid,fsavepathid);
      srm_close_pathid(unum,fibp(fwindow)^.pathid,fibp(fwindow)^.fsavepathid);
    end;
end;

(****************************************************************************)
procedure srm_purge_name(anyvar f       : fib;
				unum    : unitnum);
var
  volpass       : name_type;
  fns           : file_name_set;
begin
  with f do
      begin
	setup_fns(f, fns);
	if ioresult = ord(inoerror) then
	  begin
	    strtopaoc16(fvid,volpass);
	    purgepack(unum,1,addr(fns),start_alternate,pathid,volpass);
	  end;
      end;
end;

(****************************************************************************)
procedure srm_purge_file(anyvar f       : fib;
				unum    : unitnum);
var
  volpass       : name_type;
  path          : path_start_type;
  nfns          : integer;
  nsa           : name_set_array_three;
begin
  with f do
    if (strlen(ftid) = 0) and not fisnew then
      setioresult(ord(ibadtitle))
    else
      begin
	if fmodified then
	  if not (flockable and not flocked) then
	    begin
	      seteofpack(funit,fileid,false,fleof);
	      if ioresult = ord(ilostfile) then
		fileid := -1;
	    end;
	if fisnew and (not fanonymous) and (not fnosrmtemp) then
	  srm_close_fileid(unum,foldfileid);
	srm_close_fileid(unum,fileid);
	setup_fns3(f,nsa);
	if ioresult <> ord(ibadtitle) then
	  begin
	    if (fisnew) and (not fnosrmtemp) then
	      begin
		path        := start_root;
		nfns        := 3;
	      end
	    else
	      begin
		path        := start_alternate;
		nfns        := 1;
	      end;
	    strtopaoc16(fvid,volpass);
	    if fisnew then
	      nsa[nfns].password := temp_file_pass;
	    purgepack(unum,nfns,addr(nsa),path,pathid,volpass);
	  end;
	if not (fisnew and fanonymous) then
	  srm_close_pathid(unum,pathid,fsavepathid);
      end;
end;

(****************************************************************************)
procedure srm_stretch(anyvar f          : fib;
			     unum       : unitnum);
var
  volpass       : name_type;
  neweof        : integer;
begin
  with f do
    begin
      neweof            := ((fpos div extentsize) + 1) * extentsize;
      seteofpack(funit,fileid,false,neweof);
      if ioresult = ord(inoerror) then
	begin
	  fpeof         := neweof;
	  fmodified     := true;
	end;
    end;
end;

(****************************************************************************)
procedure srm_close_file(anyvar f       : fib;
				unum    : unitnum);
var
  volpass       : name_type;
  nsa1          : name_set_array_three;
  fns           : file_name_set;
  tempioresult  : integer;
  ext1          : integer;
  saveleof      : integer;
  savefileid    : file_id_type;
  usefeft       : gang_file_codes;
  pcs           : protect_code_set;
begin
  with f do
    begin
      if fmodified then
	if not (flockable and not flocked) then
	  begin
	    seteofpack(funit,fileid,false,fleof);
	    if ioresult = ord(ilostfile) then
	      fileid := -1;
	  end;
      if not fisnew then
	srm_close_fileid(unum,fileid)
      else
	if ioresult <> ord(inoerror) then
	  srm_purge_file(f,unum)
	else
	  begin
	    strtopaoc16(fvid,volpass);
	    setup_fns3(f,nsa1);
	    setup_fns(f,fns);
	    if (ioresult = ord(inoerror)) and (not fnosrmtemp) then
	      if not foverwritten then
		begin
		  if not fanonymous then
		    begin
		      srm_close_fileid(unum,foldfileid);
		      purgepack(unum,1,addr(fns),start_alternate,pathid,volpass);
		    end;
		  if ioresult = ord(inofile) then
		    ioresult := ord(inoerror);
		  if ioresult <> ord(inoerror) then
		    srm_purge_file(f,unum);
		end
	      else
		begin
		  if foldfileid < 0 then
		    foverwritten := false
		  else
		    begin
		      exchangepack(unum,foldfileid,fileid);
		      srm_close_fileid(unum,foldfileid);
		      srm_close_pathid(unum,pathid,fsavepathid);
		    end;
		  srm_purge_file(f,unum);
		end;
	    if (ioresult = ord(inoerror)) and (not foverwritten) then
	      if feft <> SYSTMTYPE then   {not SYSTM file}
		begin
		  srm_close_fileid(unum,fileid);
		  if (ioresult = ord(inoerror)) and (not fnosrmtemp) then
		    createlinkpack(unum,3,addr(nsa1),start_root,pathid,volpass,
				   1,addr(fns),start_alternate,pathid,volpass,true);
		  if ioresult <> ord(inoerror) then
		    srm_purge_file(f,unum)
		  else
		    begin
		      fns.password := temp_file_pass;
		      with pcs do
			begin
			  password        := temp_file_pass;
			  capabilities    := nocapabilities;
			end;
		      tempioresult := ioresult;
		      changeprotectpack(unum,1,addr(fns),start_alternate,
					pathid,volpass,1,addr(pcs));
		      ioresult := tempioresult;
		    end;
		end
	      else
		begin                 {SYSTM file}
		  savefileid  := fileid;
		  saveleof    := fleof;
		  fpos        := saveleof;
		  if fpos > 0 then
		    ext1 := fpos
		  else
		    ext1 := extentsize;
		  usefeft.i   := feft;
		  fns.password := ' ';
		  createpack(unum,1,addr(fns),start_alternate,pathid,
			     volpass,0,nil,usefeft,data_records,
			     256,ext1,extentsize,fstartaddress);
		  if ioresult = ord(inoerror) then
		    doopenpack(unum,f,1,fns,start_alternate,volpass,exclusive_share_code,false);
		  if ioresult = ord(inoerror) then
		    copypack(unum,savefileid,0,fileid,0,saveleof);
		  srm_close_fileid(unum,fileid);
		  srm_close_pathid(unum,pathid,fsavepathid);
		  fileid      := savefileid;
		  srm_purge_file(f,unum);
		end;
	  end;
      srm_close_pathid(unum,pathid,fsavepathid);
    end;
end;
(****************************************************************************)
procedure srm_get_vol_date(anyvar f     : datetimerec;
				  unum  : unitnum);
type
  fibptr        = ^fib;
var
  tempfibspace  : packed array [1..sizeof(fib,0)] of char;
begin
  with fibptr(addr(tempfibspace))^, packet_ptr.rfileinfo^.file_info do
    begin
      funit     := unum;
      pathid    := -1;
      fileid    := -1;
      fpos      := 0;
      fkind     := datafile;
      feft      := DATATYPE;
      fisnew    := true;
      fanonymous:= true;
      fmodified := false;
      foptstring:= nil;
      fnosrmtemp:= false;
      setstrlen(ftid,0);
      srm_create_file(fibptr(addr(tempfibspace))^,unum);
      if ioresult = ord(inoerror) then
	begin
	  fileinfopack(unum,fileid);
	  if ioresult = ord(inoerror) then
	    with f do
	      translatedate(creation_date,date,time);
	  srm_purge_file(fibptr(addr(tempfibspace))^,unum);
	end;
    end;
end;

(****************************************************************************)
procedure srm_lock_file(anyvar f        : fib;
			       unum     : unitnum);
begin
  with f, packet_ptr.rlock^ do
    begin
      lockpack(unum,fileid,fwaitonlock);
      if ioresult = ord(inoerror) then
	if not success.value then
	  setioresult(ord(ifilelocked))
	else
	  begin
	    fileinfopack(unum,fileid);
	    if ioresult = ord(inoerror) then
	      with packet_ptr.rfileinfo^.file_info do
		begin
		  fpeof         := logical_eof;
		  fleof         := logical_eof;
		  flocked       := true;
		end;
	  end;
    end;
end;

(****************************************************************************)
procedure srm_unlock_file(anyvar f      : fib;
				 unum   : unitnum);
begin
  with f do
    begin
      if ioresult = ord(inoerror) then
	begin
	  call(am,addr(f),flush,f,0,0);
	  flastpos := -1;
	  if ioresult = ord(inoerror) then
	    begin
	      if fmodified then
		seteofpack(unum,fileid,false,fleof);
	      if ioresult = ord(inoerror) then
		unlockpack(unum,fileid);
	      if ioresult = ord(inoerror) then
		flocked := false;
	    end;
	end;
    end;
end;

(****************************************************************************)
procedure srm_strip(anyvar f : fib);
var
  s             : string[255];
  findx         : integer;
  sindx         : integer;
  namelen       : integer;
  passlen       : integer;
  i             : integer;
  ch            : char;
  skip          : boolean;
  inpass        : boolean;
  nopassyet     : boolean;
begin
  namelen       := 0;
  passlen       := 0;
  findx         := 1;
  sindx         := 0;
  setstrlen(s,255);
  inpass        := false;
  nopassyet     := true;
  with f do
    begin
      if ftitle[1] = '<' then   {skip over volume password}
	repeat
	  findx := findx + 1;
	  if (findx > name_type_len + 3) or (findx > strlen(ftitle)) then
	    setioresult(ord(ibadpass));
	until (ftitle[findx-1] = '>') or (ioresult <> ord(inoerror));

      while (findx <= strlen(ftitle)) and (ioresult = ord(inoerror)) do
	begin
	  skip    := false;
	  ch      := ftitle[findx];

	  if inpass then
	    begin
	      skip        := true;
	      if ch = '>' then
		inpass    := false
	      else
		passlen   := passlen + 1;
	    end
	  else if ch = '/' then
	    begin
	      nopassyet := true;
	      inpass    := false;
	      namelen   := 0;
	      passlen   := 0;
	    end
	  else if ch = '<' then
	    if nopassyet then
	      begin
		nopassyet := false;
		inpass    := true;
		skip      := true;
	      end;

	  if not skip then
	    begin
	      if ch = '/' then
		begin
		  if s[sindx] = '/' then
		    setioresult(ord(ibadtitle));
		end
	      else
		namelen   := namelen + 1;
	      sindx       := sindx + 1;
	      s[sindx]    := ch;
	    end;

	  findx           := findx + 1;

	  if (namelen > name_type_len) then
	    setioresult(ord(ibadtitle))
	  else if (passlen > name_type_len) then
	    setioresult(ord(ibadpass));
	end;

    if ioresult = ord(inoerror) then
      begin
	setstrlen(s,sindx);
	i := 0;
	while (s[sindx-i] <> '/') and (i < sindx) do
	  i       := i + 1;
	if i = 0 then
	  setioresult(ord(ibadtitle))
	else
	  begin
	    setstrlen(ftid,0);
	    strmove(i,s,sindx-i+1,ftid,1);
	    setstrlen(ftitle,0);
	    strmove(sindx-i,s,1,ftitle,1);
	  end;
      end;
    end;
end;

{****************************************************************************}

{INTERNAL ONLY BEGIN}
procedure pipe_am(fp      : fibp;
		  request : amrequesttype;
	   anyvar buffer  : window;
		  bufsize : integer;
		  position: integer);
  LABEL 1;
  const
    lf = 10;
    cr = 13;
    wbsize = 512;
    rbase  = 256;
    rbsize = 256;
  var i       : integer;
      eolchar : char;
      done    : boolean;

  { freptcnt = # of bytes in write part of fbuffer }
  procedure flushdata;
    begin
      with fp^, unitable^[funit] do
      begin
	if freptcnt>0 then call(tm,fp,writebytes,fbuffer,freptcnt,0);
	freptcnt := 0;
      end;
    end; { flushdata }

  { freptcnt = # of bytes in write part of fbuffer }
  procedure writedata(anyvar buffer : window; size : integer);
    begin
      with fp^, unitable^[funit] do
      begin
	if (freptcnt+size)>wbsize then flushdata;
	if ioresult=ord(inoerror) then
	begin
	  if size>=wbsize then
	    call(tm,fp,writebytes,buffer,size,0)
	  else
	  begin
	    moveleft(buffer,fbuffer[freptcnt],size);
	    freptcnt := freptcnt + size;
	  end;
	end;
      end;
    end; { writedata }

  { flastpos is # of bytes in read part of fbuffer.
    fstartaddress is index of next byte in read part of fbuffer.
    expects that the TM may not transfer all the requested data
    and that it will report the actual # of bytes in FLASTPOS .
    IMPLIED in the logic of this code is the expectation that
    the a call to the TM will result in at least one byte of
    data OR an error.
  }
  procedure readdata(anyvar buffer : window; size : integer);
    LABEL  2;
    var
      move     : integer;
      bindex   : integer;
    begin
      bindex   := 0;
      with fp^, unitable^[funit] do
      while (size>0) and (ioresult=ord(inoerror)) do
      begin
	if flastpos>0 then
	begin
	  if size=1 then { special case size 1 for speed }
	  begin
	    buffer[bindex] := fbuffer[fstartaddress];
	    size := 0;
	    fstartaddress := fstartaddress + 1;
	    flastpos := flastpos - 1;
	    GOTO 2;
	  end
	  else
	  begin
	    if flastpos>=size then move := size
			      else move := flastpos;
	    moveleft(fbuffer[fstartaddress],buffer[bindex],move);
	    bindex := bindex + move;
	    size   := size - move;
	    fstartaddress := fstartaddress + move;
	    flastpos      := flastpos - move;
	  end;
	end;

	if (size>=rbsize) then
	begin
	 { the SIZE of data requested won't fit in the read
	   part of fbuffer so request 512 or SIZE which ever
	   is smaller to be placed directly in the callers buffer
	   .... the TM can't accurately handle partial reads unless
	   .... the request to it is for 512 bytes or less.
	 }
	  if size > 512 then move := 512
			else move := rbsize;
	  call(tm,fp,readbytes,buffer[bindex],move,0);
	  { accept what shows up }
	  size := size - flastpos;
	  bindex := bindex + flastpos;
	  flastpos := 0; { show no data in fbuffer }
	end
	else
	if size>0 then
	begin
	  { SIZE requested will fit in read part of fbuffer
	    so try to fill the read part of fbuffer
	  }
	  call(tm,fp,readbytes,fbuffer[rbase],rbsize,0);
	  fstartaddress := rbase;
	end;
      end;
      2:
    end; { readdata }

  begin { pipe_am }
    with fp^, unitable^[funit] do
    begin
      if feft=uxfile_eft then eolchar:=chr(lf)  { eol for ux files }
			 else eolchar:=chr(cr); { Normal eol for data file}
      case request of
	flush      : begin
		       flushdata;
		       if ioresult=ord(inoerror) then
			 call(tm,fp,flush,buffer,bufsize,position);
		     end;
	writeeol   : writedata(eolchar,1);
	writebytes : writedata(buffer,bufsize);
	readbytes  : begin
		       flushdata;        { ensure all outbound data is gone }
		       readdata(buffer,bufsize);
		       if ioresult<>ord(inoerror) then GOTO 1;
		       if fistextvar then
		       begin
			 feoln := buffer[bufsize-1] = eolchar;
			 for i := 0 to bufsize - 1 do
			   if buffer[i]=eolchar then buffer[i] := ' ';
		       end;
		     end;
	readtoeol  : begin
		       flushdata;        { ensure all outbound data is gone }
		       if ioresult<>ord(inoerror) then GOTO 1;
		       feoln := false; done := false; i := 0;
		       repeat
			 i := i + 1;
			 readdata(buffer[i],1);
			 if ioresult<>ord(inoerror) then
			 begin
			   i := i - 1; done := true;
			 end
			 else
			 if (buffer[i]=eolchar) then
			 begin
			   i := i - 1; done := true;
			   fstartaddress := fstartaddress - 1;
			   flastpos := flastpos + 1;
			 end
			 else done := i=bufsize;
		       until done;
		       buffer[0]:=chr(i);
		     end;
	otherwise
	  call(tm, fp, request, buffer, bufsize, position);
      end; { case }
    end;
    1:
  end; { pipe_am }

{****************************************************************************}

function rmt_exec(anyvar f       : fib;
			 unum    : unitnum;
			 request : damrequesttype):boolean;
  var
    volpass : name_type;
    slen,
    sindx   : integer;

    procedure getvolpass;
      var
	vsize : integer;
	i     : integer;
      begin
	with f do
	begin
	  vsize   := 0;
	  i       := 2;
	  while ftitle[i]<>'>' do
	  begin
	    vsize := vsize + 1;
	    volpass[vsize] := ftitle[i];
	    i := i + 1;
	  end;
	end;
      end; { getvolpass }

  begin { rmt_exec }
    rmt_exec := false;
    with f do
    begin
      sindx := strpos('//',ftitle);
      if sindx>1 then
	if (ftitle[sindx-1]<>'>') or
	   (ftitle[1]<>'<') or
	   (sindx>(passleng+3)) then sindx := 0;

      if sindx>0 then
      begin
	sindx := strpos('//',lastfid^);
	if sindx>0 then
	begin
	  slen    := strlen(lastfid^);
	  volpass := ' ';
	  if ftitle[1]='<' then getvolpass;
	  with packet_ptr.rrmtexec^ do
	  begin
	    rmt_exec := true;
	    pathid := unitable^[unum].dvrtemp;
	    rmtexecpack(unum,start_alternate,pathid,volpass,
			addr(lastfid^[sindx+2]),slen-sindx-1);
	    if ioresult=ord(inoerror) then
	    begin
	      fileid := file_id;
	      fpeof  := minint;
	      fleof  := maxint;
	      feft   := uxfile_eft;
	      fkind  := uxfile;
	      flockable := false;
	      flocked   := true;
	      fstartaddress := 0;
	      freptcnt      := 0;
	      fnosrmtemp    := true;
	      fisnew := false; { to keep close simple }
	      am := pipe_am {amtable^[fkind]} ;
	      ffpw := '>remote execute<';
	      ftid := '<remote execute>';
	    end;
	  end; { with }
	end; { if sindx }
      end; { if sindx }
    end; { with f }
  end; { rmt_exec }
{INTERNAL ONLY END}
(****************************************************************************)
procedure srmdaminit;
{INTERNAL ONLY BEGIN}
var i : integer;
{INTERNAL ONLY END}
begin
  srm_init;
  passwordarrayptr := addr(constpassarray);
{INTERNAL ONLY BEGIN}
{ Not sure this is needed ; also done in INIT in Kernel. JWH 8/10/90 }
  for i := 1 to 50 do
    srmux_on[i] := false;
{INTERNAL ONLY END}
end;

{INTERNAL ONLY BEGIN}
{ Added for SRM-UX : }
{ This routine calls chmodpack, chownpack or chgrppack to carry out }
{ the requested command. These commands may only be requested from }
{ the FILER. Note that the name srmux_change_mode is a misnomer, }
{ 'cause it handles chown and chgrp requests as well. }
{ JWH 6/22/90.        }

procedure srmux_change_mode(f : fib;
			    unum : unitnum);
type
  command_array = array[0..maxint] of h_setpasswd_entry;
  command_arrayptr = ^command_array;

var nsa : name_set_array;
begin
  with f do
   begin
     with command_arrayptr(fwindow)^[0] do
      begin
       { writeln(new_value);
       writeln(command); }
       setup_fns(f,nsa);
       case command of
	 hfs_chmod : chmodpack(funit,
				   1, { nfns }
				addr(nsa),
				start_alternate,
				pathid,
				fileid,
				' ',
				new_value);
	hfs_chown : chownpack(funit,
				   1, { nfns }
				addr(nsa),
				start_alternate,
				pathid,
				fileid,
				' ',
				new_value);
	hfs_chgrp : chgrppack(funit,
				   1, { nfns }
				addr(nsa),
				start_alternate,
				pathid,
				fileid,
				' ',
				new_value);
	otherwise ;
      end; { case }
    end;
   end;

  { with  packet_ptr.rchmod^ do
   begin
     writeln('Status is : ',return_mess_header.status); end;
  writeln('leaving change mode'); }
end;
{INTERNAL ONLY END}
(****************************************************************************)
{INTERNAL ONLY BEGIN}
procedure srm_srmdam(anyvar f       : fib;
			    unum    : unitnum;
			    request : damrequesttype);
var
  holdpathid            : integer;
  savepathid            : integer;
  savefileid            : integer;
  saveftid              : tid;
  saveffpw              : passtype;
  savefvid              : vid;
  saveftitle            : fid;
  savefsavepathid       : boolean;
  fisafib               : boolean;
begin
  ioresult      := ord(inoerror);
  srmsavesc     := 0;
  lockup;
  fisafib       := false;
  try
    with f, unitable^[unum] do
      if offline then
	ioresult        := ord(znodevice)
      else
	begin
	  if request in [opendirectory,
			 openparentdir,
			 closedirectory,
			 catalog,
			 catpasswords,
			 setpasswords,
			 openfile,
			 createfile,
			 overwritefile,
			 makedirectory,
			 closefile,
			 changename,
			 duplicatelink,
			 purgename,
			 lockfile,
			 unlockfile,
			 purgefile,
			 setunitprefix,
			 stretchit              ] then          {f is a fib}
	    begin
	      fisafib   := true;
	      if strlen(ftid) > tidleng then    {fix uninitialized fib strings}
		setstrlen(ftid,0);
	      if strlen(ffpw) > passleng then
		setstrlen(ffpw,0);
	      if strlen(fvid) > vidleng then
		setstrlen(fvid,0);

	      savepathid        := pathid;    {save fib fields to be restored on error}
	      savefileid        := fileid;
	      savefsavepathid   := fsavepathid;
	      saveftid          := ftid;
	      saveffpw          := ffpw;
	      savefvid          := fvid;
	      if strlen(ftitle) > fidleng then
		setstrlen(saveftitle,0)
	      else
		saveftitle      := ftitle;
	    end;

 { TESTING ONLY !!!!!!!!!! }
 { if is_srmux_unit(unum) then
     log_srmdam_request(request); }

	  case request of
	    opendirectory,
	    openparentdir : begin
			      srm_open_dir(f,unum,open_directory,request = openparentdir);
			      if ioresult = ord(inoerror) then
				srm_get_dir_info(fwindow^,pathid,unum,true,false);
			    end;

	    closedirectory : begin
			       fsavepathid        := false;
			       srm_close_pathid(unum,pathid,false);
			     end;

	    catalog       : srm_catalog(f,unum);

	    catpasswords  : begin
			      srm_open_dir(f,unum,open_directory,true);
			      if ioresult = ord(inoerror) then
				begin
				  srm_cat_pass(f,unum);
				  srm_close_pathid(unum,pathid,fsavepathid);
				end;
			    end;

	    setpasswords  : { Changed for SRM-UX : }
			   if not is_srmux_unit(unum) then
			    begin
			      srm_open_dir(f,unum,open_directory,true);
			      if ioresult = ord(inoerror) then
				begin
				  srm_set_pass(f,unum);
				  srm_close_pathid(unum,pathid,fsavepathid);
				end;
			    end
			    else
			     begin { they want us to change mode, etc. }
			       { It's the FILER calling from the
				 hfs_access routine  }
			       srm_open_dir(f,unum,open_directory,true);
			       if ioresult = ord(inoerror) then
				begin
				  srmux_change_mode(f,unum);
				  srm_close_pathid(unum,pathid,fsavepathid);
				end;
				{ else
				 writeln('the opendir thing did not work'); }
			     end; { is SRM-UX request }

	    openfile      : if not rmt_exec(f,unum,request) then
			    begin
			      fisnew            := false;
			      fnosrmtemp        := true;      {default case}
			      srm_open_dir(f,unum,open_directory,true );
			      if ioresult = ord(inoerror) then
				begin
				  srm_open_file(f,unum);
				  if ioresult <> ord(inoerror) then
				    srm_close_pathid(unum,pathid,fsavepathid);
				end;
			    end;

	    createfile,
	    overwritefile : if not rmt_exec(f,unum,request) then
			    begin
			      fisnew            := true;
			      fnosrmtemp        := false;
			      foverwritten      := request = overwritefile;
			      if not fanonymous then
				srm_open_dir(f,unum,open_directory,true );
			      if ioresult = ord(inoerror) then
				begin
				  srm_create_file(f,unum);
				  if ioresult <> ord(inoerror) then
				    if not fanonymous then
				      srm_close_pathid(unum,pathid,fsavepathid);
				end;
			    end;

	    makedirectory : begin
			      holdpathid  := pathid;
			      srm_open_dir(f,unum,open_directory,false);
			      if ioresult = ord(inoerror) then
				begin
				  srm_create_dir (f,unum);
				  srm_close_pathid(unum,pathid,fsavepathid);
				end;
			      pathid      := holdpathid;
			    end;

	    closefile     : if (fisnew and fanonymous) then
			      srm_purge_file(f,unum)
			    else
			      srm_close_file(f,unum);

	    changename    : srm_change_name(f,unum);

	    duplicatelink : srm_dup_link(f,unum);

	    purgename     : begin
			      holdpathid  := pathid;
			      srm_open_dir(f,unum,open_directory,true);
			      if ioresult = ord(inoerror) then
				begin
				  srm_purge_name(f,unum);
				  srm_close_pathid(unum,pathid,fsavepathid);
				end;
			      pathid      := holdpathid;
			    end;

	    lockfile      : srm_lock_file(f,unum);

	    unlockfile    : srm_unlock_file(f,unum);

	    purgefile     : srm_purge_file(f,unum);

	    setunitprefix : srm_set_unit_prefix(f,unum);

	    stretchit     : srm_stretch(f,unum);

	    getvolumename : srm_get_vol_name(f,unum);

	    getvolumedate : srm_get_vol_date(f,unum);

	    setvolumedate,
	    crunch        : {do nothing, but no error};

	    stripname     : srm_strip(f);

	    { Used by the FILER to distinguish SRM and SRM/UX }
	    { Added for 3.23+ and 3.24 JWH 11/12/90 }

	    setvolumename : begin
			     if is_srmux_unit(unum) then
			       setioresult(ord(ibadvalue))
			     else
			       setioresult(ord(ibadrequest));
			    end;

	    otherwise       setioresult(ord(ibadrequest));
	  end;

	  if (ioresult <> ord(inoerror)) and fisafib then {restore fib for subsequent calls}
	    begin
	      pathid        := savepathid;
	      fileid        := savefileid;
	      fsavepathid   := savefsavepathid;
	      ftid          := saveftid;
	      ffpw          := saveffpw;
	      fvid          := savefvid;
	      if strlen(saveftitle) > 0 then
		ftitle      := saveftitle;
	    end;
	  if ioresult = ord(isrmcatchall) then
	    if srmsavesc <> 0 then
	      escape(srmsavesc);
	end;
  recover
    begin
      if escapecode = ioescapecode then
	setioresult(ord(isrmcatchall))
      else
	begin
	  lockdown;
	  escape(escapecode);
	end;
    end;
  lockdown;
end; {srm_srmdam}

procedure lan_srmdam(anyvar f       : fib;
			    unum    : unitnum;
			    request : damrequesttype);
  begin
    lastunit := unum;
    lastsc   := unitable^[lastunit].sc;
    lansrm_reset(lastsc);
    with lsrm_unit_table^[lastunit] do
    begin
      srm_srmdam(f,unum,request);
    end;
  end;

procedure srmdam(anyvar f       : fib;
			unum    : unitnum;
			request : damrequesttype);
  {decide which dam should be installed}
    begin
    ioresult    := 0;
    with f, unitable^[unum] do
      if offline then ioresult := ord(znodevice)
      else
      begin
	if iompx_info = nil then
	  begin
	    dam := srm_srmdam;
	    volpack(unum);
	    with packet_ptr.rvol^ do
	     begin
	      if srm_ux_flag then
		srmux_on[unum] := true
	      else
		srmux_on[unum] := false;
	     end;
	   end
	  else
	begin
	  if (isc_table[sc].card_id = hp98643) then
	  begin
	    if iompx_info^.isc_iompx_table[sc].capable then
	    begin
	      if pad=0 then lansrm_init_unit(unum);
	      pad := 1; { shadow unit has been reset }
	      dam := lan_srmdam;
	      srmux_on[unum] := true; { Only possibility }
	    end
	    else ioresult := ord(znodevice);
	  end
	  else
	    begin
	     dam := srm_srmdam;
	     volpack(unum);
	     with packet_ptr.rvol^ do
	      begin
	       if srm_ux_flag then
		srmux_on[unum] := true
	       else
		srmux_on[unum] := false;
	      end;
	    end;
	end;
	{ complete the call }
	call(dam,f,unum,request);
      end;
  end; {srmdam}
{INTERNAL ONLY END}
end; {srmdammodule}

import
  srmdammodule;
begin   {program init_srm}
  srmdaminit;
end.

@


55.1
log
@Automatic bump of revision number for PWS version 3.25A
@
text
@@


54.3
log
@
pws2rcs automatic delta on Wed Aug 21 12:27:56 MDT 1991
@
text
@@


54.2
log
@
pws2rcs automatic delta on Wed Aug 21 09:35:48 MDT 1991
@
text
@d1 2525
@


54.1
log
@Automatic bump of revision number for PWS version 3.24
@
text
@a0 2525
					       (*

 (c) Copyright Hewlett-Packard Company, 1983.
All rights are reserved.  Copying or other
reproduction of this program except for archival
purposes is prohibited without the prior
written consent of Hewlett-Packard Company.


	    RESTRICTED RIGHTS LEGEND

Use, duplication, or disclosure by the Government
is subject to restrictions as set forth in
paragraph (b) (3) (B) of the Rights in Technical
Data and Computer Software clause in
DAR 7-104.9(a).

HEWLETT-PACKARD COMPANY
Fort Collins, Colorado                         *)


$copyright 'COPYRIGHT (C) 1983 BY HEWLETT-PACKARD COMPANY'$
$range off$
$debug off$
$modcal$
$ALLOW_PACKED ON$  { JWS 4/10/85 }

program init_srm
{INTERNAL ONLY BEGIN}
	 (INPUT,OUTPUT)
{INTERNAL ONLY END}
	  ;

module srmdammodule;

{}
$SEARCH 'SRM_DRV',
	 'IOLIB:KERNEL'
{INTERNAL ONLY BEGIN}
	 ,'LANSRM','IOLIB:LANDECS'
{INTERNAL ONLY END}
	 $
{{
$SEARCH 'SRM_DRV',
	'LANSRM','LANDECS'$
{}
import
  sysglobals,
  misc,
  bootdammodule,
  iodeclarations,
{INTERNAL ONLY BEGIN}
  lansrm,
  landecs,
{INTERNAL ONLY END}
  srm
{INTERNAL ONLY BEGIN}
  ,asm
{INTERNAL ONLY END}
   ;

export

procedure srmdaminit;

procedure srmdam(anyvar f       : fib;
			unum    : unitnum;
			request : damrequesttype);


{ SRM/UX TESTING ONLY !!! }
{ procedure reset_counters;
  procedure show_counter_values;
  function srmux_mapfkind(ftype : gang_file_codes) : filekind; }

implement

type
  passarray     = array[1..8] of passentry;

const
  extentsize    = 8*512;   {arbitrary choice -- multiple of common block sizes}
  constpassarray= passarray[
			   passentry[pbits:hex('80000000'),pword:'MANAGER'   ],
			   passentry[pbits:hex('40000000'),pword:'READ'      ],
			   passentry[pbits:hex('20000000'),pword:'WRITE'     ],
			   passentry[pbits:hex('10000000'),pword:'SEARCH'    ],
			   passentry[pbits:hex('08000000'),pword:'PURGELINK' ],
			   passentry[pbits:hex('04000000'),pword:'CREATELINK'],
			   passentry[pbits:hex('FFFFFFFF'),pword:'ALL'       ],
			   passentry[pbits:hex('00000000'),pword:'NONE'      ]
			   ];
  allcapabilities = access_capabilities[32 of true];
  nocapabilities  = access_capabilities[32 of false];
  temp_file_pass  = '>TEMP_FILE_PASS<';         {password on temporary files}
  BDATTYPE      = -5791;
  BDATTYPE_500  = -5663;    { fix for BDAT 500 file }
  BASICBINTYPE  = -5775;
  BASICPROGTYPE = -5808;
  SYSTMTYPE     = -5822;
  DATATYPE      = -5622;
  CODETYPE      = -5582;
  TEXTTYPE      = -5570;
{INTERNAL ONLY BEGIN}
{ Added for SRM/UX : }
  PIPETYPE      = -5812;
  BDEVTYPE      = -5811;
  CDEVTYPE      = -5810;
  MISCTYPE      = -5809;
  NETTYPE       = -5806;
  SOCKTYPE      = -5805;
{INTERNAL ONLY END}
var
  passwordarrayptr      : ^passarray;
  tempcounter           : shortint;


{=================================================}
{ TESTING ONLY !!!!!!!!!! }
{ procedure reset_counters;
var i : damrequesttype;
begin
 for i := getvolumename to openunit do
   usage_array[i] := 0;
end;
procedure show_counter_values;
var i : damrequesttype;
var c : char;
begin
 for i := getvolumename to openunit do
   begin
    writeln(i,' request made ',usage_array[i] : 6,' times.');
    if i = closefile then read(c);
    if i = catalog then read(c);
   end;
end;
procedure log_srmdam_request(req : damrequesttype);
begin
  usage_array[req] := usage_array[req] + 1;
end; }
{=================================================}

(****************************************************************************)
procedure setioresult(result    : integer);
begin
  if ioresult = ord(inoerror) then
    ioresult := result;
end;

(****************************************************************************)
function mapfkind(ftype : gang_file_codes) : filekind;
var
  fk: filekind;
begin
  mapfkind      := datafile;
  for fk := lastfkind downto untypedfile do
    if efttable^[fk] = ftype.si2 then
      mapfkind := fk;
end;
(****************************************************************************)
function srmux_mapfkind(ftype : gang_file_codes) : filekind;
LABEL 1;
var
  fk: filekind;
  assigned : boolean;
  what : shortint;
begin
  srmux_mapfkind      := datafile;
  assigned := false;
  for fk := lastfkind downto untypedfile do
    if efttable^[fk] = ftype.si2 then
     begin
      srmux_mapfkind := fk;
      assigned := true;
     end;
  if not assigned then { just defaulted to datafile - do something ! }
    begin
      what := ftype.si2;
      { Pipetype : }
      if what = -5812 then begin srmux_mapfkind := fkind9; GOTO 1; end;
      { Bdevtype : }
      if what = -5811 then begin srmux_mapfkind := fkind10; GOTO 1; end;
      { Cdevtype : }
      if what = -5810 then begin srmux_mapfkind := fkind11; GOTO 1; end;
      { Othertype : }
      if what = -5809 then begin srmux_mapfkind := fkind12; GOTO 1; end;
      { Nettype : }
      if what = -5806 then begin srmux_mapfkind := fkind13; GOTO 1; end;
      { Socktype : }
      if what = -5805 then begin srmux_mapfkind := fkind14; GOTO 1; end;
      { Otherwise just leave it alone }
    end;
1:
end;

(****************************************************************************)
procedure paoc16tostr(anyvar paoc       : name_type;
		      anyvar strng      : string255);
var
  i     : shortint;
begin
  i     := sizeof(paoc);
  while (paoc[i] = ' ') and (i > 0) do
    i   := i - 1;
  setstrlen(strng,0);
  strmove(i,paoc,1,strng,1);
end;

(****************************************************************************)
procedure strtopaoc16(anyvar strng      : string255;
		      anyvar paoc       : name_type);
begin
  paoc  := ' ';
  if strlen(strng) < 17 then
    strmove(strlen(strng),strng,1,paoc,1);
end;

(****************************************************************************)
procedure setup_fns(var f       : fib;
		    anyvar fns  : file_name_set);
begin
  with f, fns do
    if strlen(ftid) = 0 then
      setioresult(ord(ibadtitle))
    else
      begin
	strtopaoc16(ftid,file_name);
	strtopaoc16(ffpw,password)
      end;
end;

(****************************************************************************)
procedure setup_fns3(var f      : fib;
		  anyvar nsa    : name_set_array_three);
var
  n             : integer;
  tempioresult  : integer;
  tempstr       : string[16];
begin
  with f do
    if (not fisnew) or fnosrmtemp then
      setup_fns(f,nsa)
    else
      if (strlen(ftid) = 0) and (not fanonymous) then
	setioresult(ord(ibadtitle))
      else
	begin
	  with nsa[1] do
	    begin
	      password  := ' ';
	      file_name := 'WORKSTATIONS';
	    end;
	  with nsa[2] do
	    begin
	      password  := ' ';
	      file_name := 'TEMP_FILES';
	    end;
	  with nsa[3] do
	    begin
	      password          := temp_file_pass;
	      setstrlen(tempstr,0);
	      tempioresult      := ioresult;
	      strwrite(tempstr,1,n,srmnode(unitable^[funit].sc),'_',fanonctr:1);
	      ioresult          := tempioresult;
	      strtopaoc16(tempstr,file_name);
	    end;
	end;
end;

(****************************************************************************)
procedure check_protectcode_set_array(    nps   : integer;
				      var psa   : protectcode_set_array);
{
9-May-1983 RAM
This routine has been added to check for right angle brackets ('>') in
passwords.  If any are found, ioresult is set to ord(ibadpass).  This
is because the parsing routines normally used with file opens terminate
passwords at the first '>', therefore it is not possible to use them in
passwords in normal operation.  If they are really desired, they can still be
created by calling the lower level packet routines directly.
Note that temporary files still have an "illegal" password.
This routine is called from srm_create_file and from srm_set_pass.
}
var     n       : integer;
	i       : integer;
begin
  for n := 1 to nps do
    for i := 1 to name_type_len do
      if psa[n].password[i] = '>' then
	setioresult(ord(ibadpass));
end;

(****************************************************************************)
procedure parseoptparm(    foptstring   : string255ptr;
		       var sharemode    : integer;
		       var lockable     : boolean;
		       var nps          : integer;
		       var psa          : protectcode_set_array;
			   modeonly     : boolean);
type
  tokentype     = (none,mode,pass,cap);
  statetype     = (needmodeorpass,needpass,needcap);
  acstrarrtype  = array [ac_manager .. ac_createlink] of string[10];
const
  tokenlen      = 16;
  acstrarray    = acstrarrtype['MANAGER','READ','WRITE',
			       'SEARCH','PURGELINK','CREATELINK'];
var
  typeoftoken   : tokentype;
  state         : statetype;
  sindx         : integer;
  delim         : char;
  ac            : ac_manager..ac_createlink;
  token         : string[16];
  ok            : boolean;

procedure getuntildelim(del1    : char;
			del2    : char);
var
  startindx     : integer;
begin
  delim         := chr(0);
  startindx     := sindx;
  while (sindx <= strlen(foptstring^)) and (delim = chr(0)) do
    if  (foptstring^[sindx] <> del1)
    and (foptstring^[sindx] <> del2) then
      sindx     := sindx + 1
    else
      delim     := foptstring^[sindx];
  if (sindx - startindx) <= tokenlen then
    token := str(foptstring^,startindx,sindx - startindx)
  else
    setioresult(ord(ibadvalue));
  if sindx <= strlen(foptstring^) then
    sindx     := sindx + 1;
end;

begin   {parseoptparm}
  sharemode     := exclusive_share_code;
  lockable      := false;
  state         := needmodeorpass;
  nps           := 0;
  sindx         := 1;
  if foptstring <> nil then
    while (sindx <= strlen(foptstring^)) and (ioresult = ord(inoerror)) do
      begin
	case state of
	  needmodeorpass:
			begin
			  getuntildelim(',', ':');
			  if delim = ':' then
			    begin
			      typeoftoken     := pass;
			      state           := needcap;
			    end
			  else
			    begin
			      typeoftoken     := mode;
			      state           := needpass;
			    end;
			  if modeonly then
			    sindx := strlen(foptstring^) + 1;
			end;
	  needpass    : begin
			  getuntildelim(':', ':');
			  if delim = ':' then
			    begin
			      typeoftoken     := pass;
			      state           := needcap;
			    end
			  else
			    setioresult(ord(ibadvalue));
			end;
	  needcap     : begin
			  getuntildelim(',', ';');
			  typeoftoken        := cap;
			  if delim = ',' then
			    state     := needcap
			  else if delim = ';' then
			    state     := needpass;
			end;
	end;    {case}
	if ioresult = ord(inoerror) then
	  case typeoftoken of
	    mode  : begin
		      upc(token);
		      if token = 'EXCLUSIVE' then
			sharemode := exclusive_share_code
		      else if token = 'SHARED' then
			sharemode := shared_share_code
		      else if token = 'LOCKABLE' then
			begin
			  sharemode := shared_share_code;
			  lockable  := true;
			end
		      else
			setioresult(ord(ibadvalue));
		    end;
	    pass  : begin
		      nps := nps + 1;
		      with psa[nps] do
			begin
			  strtopaoc16(token,password);
			  capabilities := nocapabilities;
			end;
		    end;
	    cap   : begin
		      upc(token);
		      ok := false;
		      with psa[nps] do
			if token = 'ALL' then
			  begin
			    capabilities := allcapabilities;
			    ok := true;
			  end
			else
			  for ac := ac_manager to ac_createlink do
			    if token = acstrarray[ac] then
			      begin
				capabilities[ac] := true;
				ok := true;
			      end;
		      if not ok then
			setioresult(ord(ibadvalue));
		    end;
	  end;
      end;
end;

(****************************************************************************)
procedure srm_close_fileid(unum         : unitnum;
			   var fileid   : integer);
begin
  if fileid = 0 then
    fileid    := -1
  else
    if (fileid > 0) and (fileid <> unitable^[unum].dvrtemp) then
      with packet_ptr.rhead^ do
	begin
	  closepack(unum,fileid);
	  if status = 0 then
	    fileid := -1;
	end;
end;

(****************************************************************************)
procedure srm_close_pathid(unum         : unitnum;
			   var pathid   : integer;
			   savepathid   : boolean);
begin
  if not savepathid then
    srm_close_fileid(unum,pathid);
end;

(****************************************************************************)
procedure translatedate(var srmdate     : date_type;
			var systemdate  : daterec;
			var systemtime  : timerec);
var
  time          : integer;
begin
  with srmdate do
    begin
      with systemdate do
	begin
	  month         := date.month;
	  day           := date.day;
	  year          := date.year;
	  {RDQ 21MAR88 map 0..27 to 100..127}
	  if year < 28 then year := year + 100;
	end;
      with systemtime do
	begin
	  time          := seconds_since_midnight;
	  hour          := time div 3600;
	  minute        := (time-(hour*3600)) div 60;
	  centisecond   := (time mod 60) * 100;
	end;
    end;
end;

(****************************************************************************)
procedure srm_get_dir_info(anyvar dircatentry   : catentry;
			      var dirid         : integer;
				  unum          : unitnum;
				  long          : boolean;
				  dir_is_dvrtemp: boolean);
const
  zerodate      = daterec[year:0,day:0,month:0];
  zerotime      = timerec[hour:0,minute:0,centisecond:0];
var
  n             : integer;
  tempioresult  : integer;
begin
  with dircatentry, unitable^[unum] do
    begin
      setstrlen(cname,0);
      volpack(unum);
      with packet_ptr.rvol^, packet_ptr.rhead^ do
	begin
	  if status = 0 then
	    if not exist { .value } then { Changed for SRM-UX }
	      setioresult(ord(ilostunit))  {set ioresult to no volume}
	    else
	      begin
		paoc16tostr(volume_name,cname);
		cextra1         := -1;  {max_file_size div 32}
		cpsize          := -1;
		clsize          := -1;
		cextra2         := interleave;
		cstart          := -1;
		cblocksize      := 1;
		ccreatedate     := zerodate;
		ccreatetime     := zerotime;
		clastdate       := zerodate;
		clasttime       := zerotime;
		setstrlen(cinfo,0);
		tempioresult    := ioresult;
		{ Changed for SRM-UX : }
{INTERNAL ONLY BEGIN}
		if is_srmux_unit(unum) then
		  strwrite(cinfo,1,n,'SRM/UX ',sc:1,',',ba:1,',',du:1)
		else
{INTERNAL ONLY END}
		  strwrite(cinfo,1,n,'SRM  ',sc:1,',',ba:1,',',du:1);
		ioresult        := tempioresult;
		if dirid > 0 then
		  begin
		    fileinfopack(unum,dirid);
		    with packet_ptr.rfileinfo^, file_info do
		      if status <> 0 then
			begin
			  ioresult := tempioresult;
			  if dir_is_dvrtemp then
			    dirid := 0;
			end
		      else
			begin
			  if file_name <> ' ' then
			    paoc16tostr(file_name,cname);
			  if long then
			    begin
			      translatedate(creation_date,ccreatedate,ccreatetime);
			      translatedate(last_access_date,clastdate,clasttime);
			    end;
			end;
		  end;
	      end;
	end;
    end;
end;

(****************************************************************************)
procedure srm_get_vol_name(anyvar f     : vid;
				  unum  : unitnum);
var
  dircatentry   : catentry;
begin
  srm_get_dir_info(dircatentry,unitable^[unum].dvrtemp,unum,false,true);
  f := dircatentry.cname;
end;

(****************************************************************************)
procedure srm_set_pass(anyvar f         : fib;
			      unum      : unitnum);
type
  catarray      = array[0..maxint] of passentry;
  catarrayptr   = ^catarray;
var
  volpass       : name_type;
  fns           : file_name_set;
  nps           : integer;
  done          : boolean;
  i             : integer;
  j             : integer;
  catindx       : integer;
  catentryindx  : integer;
  tempcapbits   : record case boolean of
		    true  : (i  : integer);
		    false : (b  : access_capabilities);
		  end;
  psa           : protectcode_set_array;
begin
  with f do
    begin
      setup_fns(f,fns);
      if ioresult = ord(inoerror) then
	begin
	  for i := 1 to fpeof do
	    with psa[i], catarrayptr(fwindow)^[i-1] do
	      begin
		strtopaoc16(pword,password);
		tempcapbits.i   := pbits;
		capabilities    := tempcapbits.b;
		nps             := i;
	      end;
	  strtopaoc16(fvid,volpass);
	  check_protectcode_set_array(nps,psa);
	  if ioresult = ord(inoerror) then
	    changeprotectpack(unum,1,addr(fns),start_alternate,pathid,
			      volpass,nps,addr(psa));
	end;
    end;
end;

(****************************************************************************)
procedure srm_cat_pass(anyvar f         : fib;
			      unum      : unitnum);
type
  catarray      = array[0..maxint] of passentry;
  catarrayptr   = ^catarray;
var
  volpass       : name_type;
  fns           : file_name_set;
  done          : boolean;
  i             : integer;
  j             : integer;
  catindx       : integer;
  catentryindx  : integer;
  tempcapbits   : record case boolean of
		    true  : (i  : integer);
		    false : (b  : access_capabilities);
		  end;
begin
  catentryindx  := 0;
  done  := false;
  with f, packet_ptr.rcatpass^ do
    begin
      setup_fns(f, fns);
      if ioresult = ord(inoerror) then
	begin
	  strtopaoc16(fvid,volpass);
	  foptstring    := anyptr(passwordarrayptr);
	  catindx   := fpos + 1;
	  while (catentryindx < fpeof) and (not done) and (ioresult = ord(inoerror)) do
	    begin
	      catpasspack(unum,1,addr(fns),start_alternate,
			  pathid,volpass,24,catindx);
	      if ioresult = ord(inoerror) then
		begin
		  i   := 1;
		  if actual_num_passwords < 24 then
		    done      := true;
		  while i <= actual_num_passwords do
		    if catentryindx < fpeof then
		      begin
			with password_info[i], catarrayptr(fwindow)^[catentryindx] do
			  begin
			    paoc16tostr(password,pword);
			    tempcapbits.b   := capabilities;
			    pbits           := tempcapbits.i;
			  end;
			i             := i + 1;
			catentryindx  := catentryindx + 1;
		      end
		    else
		      begin
			i       := 25;
			done    := true;
		      end;
		  catindx     := catindx + 24;
		end;
	    end;
	end;
      fpeof := catentryindx;
    end;
end;

(****************************************************************************)
procedure srm_catalog(anyvar f      : fib;
			 unum   : unitnum);
type
  catarray      = array[0..maxint] of catentry;
  catarrayptr   = ^catarray;
  ac_char_arr   = array [ac_manager..ac_createlink] of char;
const
  ac_chars      = ac_char_arr['M','R','W','S','P','C'];
var
  volpass       : name_type;
  fns           : file_name_set;
  done          : boolean;
  i             : integer;
  j             : integer;
  catindx       : integer;
  catentryindx  : integer;
  ac            : access_code_type;
  temp_num      : integer; { Added for SRM-UX }
  leading       : boolean;
begin
  catentryindx  := 0;
  done  := false;
  with f, packet_ptr.rcat^ do
    begin
      strtopaoc16(fvid,volpass);
      catindx   := fpos + 1;
      while (catentryindx < fpeof) and not done do
	begin
	  catpack(unum,0,addr(fns),start_alternate,
		  pathid,volpass,7,catindx);
	  if ioresult <> ord(inoerror) then
	    done      := true
	  else
	    begin
	      i   := 1;
	      if actual_num_files < 7 then
		done      := true;
	      while i <= actual_num_files do
		if catentryindx < fpeof then
		  begin
		    with cat_info[i], catarrayptr(fwindow)^[catentryindx] do
		      begin
			paoc16tostr(file_name,cname);
	     {=============================================================}
			if is_srmux_unit(unum) then
			 begin
			  ceft      := file_code.si2;
			  ckind     := srmux_mapfkind(file_code);
			 end
	     {=============================================================}
			else { same as before }
			 begin
			  ceft      := file_code.si2;
			  ckind     := mapfkind(file_code);
			 end;
			cpsize    := physical_size;
			clsize    := logical_eof;
			cstart    := -1;
			translatedate(creation_date,ccreatedate,ccreatetime);
			translatedate(last_access_date,clastdate,clasttime);
			cblocksize:= -1;
			cextra1   := -1;
			cextra2   := -1;
			if not is_srmux_unit(unum) then
			 begin
			  setstrlen(cinfo,ord(ac_createlink)+1);
			  for ac := ac_manager to ac_createlink do
			    if capabilities[ac] then
			      cinfo[ord(ac) + 1] := ac_chars[ac]
			    else
			      cinfo[ord(ac) + 1] := ' ';
			   case share_code of
			    exclusive_share_code  : cinfo := cinfo + ' EXCLUSIVE';
			    shared_share_code     : cinfo := cinfo + ' SHARED';
			    {
			    closed_share_code     : cinfo := cinfo + ' CLOSED';
			    }
			    corrupt_share_code    : cinfo := cinfo + ' CORRUPT';
			    otherwise               cinfo := cinfo + ' CLOSED';
			  end; { CASE }
			end { Not an SRM-UX unit }
			 else
			  begin { Is an SRM-UX unit }
			  setstrlen(cinfo,17); { SRM-UX size needed }

			  { Initialize to no permissions : }
			  cinfo[1] := ' '; { for now }
			  if ckind = untypedfile then
			    cinfo[1] := 'd'; { for now }

			  cinfo[2] := '0'; cinfo[3] := '0'; cinfo[4] := '0';
			  cinfo[5] := 'm';

{===========================================================================}
{ Handle the special Hp-ux files that could show up for an SRM/UX user :    }
{ Put an appropriate character in front of the mode, set the type and       }
{ kind to 0. This is what the HFSDAM does now when we encounter a file of   }
{ one of these types on an HFS disk shared with HP/UX.                      }

			  case ckind of
			     fkind9 : begin
				       cinfo[1] := 'p'; { Pipe }
				       ceft := 0;
				       ckind := fkind8; { 0 }
				      end;
			     fkind10 : begin
					cinfo[1] := 'b'; { Bdev }
					ceft := 0;
					ckind := fkind8; { 0 }
				       end;
			     fkind11 : begin
					cinfo[1] := 'c'; { Cdev }
					ceft := 0;
					ckind := fkind8; { 0 }
				       end;
			     fkind12 : begin
					cinfo[1] := 'o'; { Other }
					ceft := 0;
					ckind := fkind8; { 0 }
				       end;
			     fkind13 : begin
					cinfo[1] := 'n'; { Network }
					ceft := 0;
					ckind := fkind8; { 0 }
				       end;
			     fkind14 : begin
					cinfo[1] := 's'; { Socket }
					ceft := 0;
					ckind := fkind8; { 0 }
				       end;
			     otherwise ; { do nothing }
			  end; { case }
{===========================================================================}


			  { Just set the darn things brute force,
			    there is no need to be cute : }

			  temp_num := 0;
			  if capabilities[ac_owner_r] then
			  temp_num := temp_num + 4;
			  if capabilities[ac_owner_w] then
			  temp_num := temp_num + 2;
			  if capabilities[ac_owner_x] then
			  temp_num := temp_num + 1;
			  if temp_num > 0 then
			     cinfo[2] := chr(ord('0') + temp_num);

			  temp_num := 0;
			  if capabilities[ac_group_r] then
			  temp_num := temp_num + 4;
			  if capabilities[ac_group_w] then
			  temp_num := temp_num + 2;
			  if capabilities[ac_group_x] then
			  temp_num := temp_num + 1;
			  if temp_num > 0 then
			     cinfo[3] := chr(ord('0') + temp_num);

			  temp_num := 0;
			  if capabilities[ac_other_r] then
			  temp_num := temp_num + 4;
			  if capabilities[ac_other_w] then
			  temp_num := temp_num + 2;
			  if capabilities[ac_other_x] then
			  temp_num := temp_num + 1;
			  if temp_num > 0 then
			     cinfo[4] := chr(ord('0') + temp_num);

			   { Keep filling in cinfo fields ... : }

			  temp_num := creation_date.id; { has uid now }
			  leading := true;
			  cinfo[6] := chr(ord('0') + temp_num div 10000);
			  if (cinfo[6] = '0') then
			     cinfo[6] := ' '
			  else
			     leading := false;
			  cinfo[7] := chr(ord('0') +
					  (temp_num div 1000) mod 10);
			  if ((cinfo[7] = '0') and leading) then
			     cinfo[7] := ' '
			  else
			     leading := false;
			  cinfo[8] := chr(ord('0') +
					  (temp_num div 100) mod 10);
			  if ((cinfo[8] = '0') and leading) then
			     cinfo[8] := ' '
			  else
			     leading := false;
			  cinfo[9] := chr(ord('0') +
					  (temp_num div 10) mod 10);
			  if ((cinfo[9] = '0') and leading) then
			     cinfo[9] := ' '
			  else
			     leading := false;
			  cinfo[10] := chr(ord('0') +
					  temp_num mod 10);
			  cinfo[11] := 'u';

			  temp_num := last_access_date.id; { has gid now }
			  leading := true;
			  cinfo[12] := chr(ord('0') + temp_num div 10000);
			  if (cinfo[12] = '0') then
			     cinfo[12] := ' '
			  else
			     leading := false;
			  cinfo[13] := chr(ord('0') +
					  (temp_num div 1000) mod 10);
			  if ((cinfo[13] = '0') and leading) then
			     cinfo[13] := ' '
			  else
			     leading := false;
			  cinfo[14] := chr(ord('0') +
					  (temp_num div 100) mod 10);
			  if ((cinfo[14] = '0') and leading) then
			     cinfo[14] := ' '
			  else
			     leading := false;
			  cinfo[15] := chr(ord('0') +
					  (temp_num div 10) mod 10);
			  if ((cinfo[15] = '0') and leading) then
			     cinfo[15] := ' '
			  else
			     leading := false;
			  cinfo[16] := chr(ord('0') +
					  temp_num mod 10);
			  cinfo[17] := 'g';

			   case share_code of
			    exclusive_share_code  : cinfo := cinfo + ' EX';
			    shared_share_code     : cinfo := cinfo + ' SH';
			    corrupt_share_code    : cinfo := cinfo + ' CO';
			    otherwise               cinfo := cinfo + ' CL';
			  end; { CASE }
			end; { Is an SRM-UX unit }
		      end;
		    i := i + 1;
		    catentryindx := catentryindx + 1;
		  end
		else
		  begin
		    i       := 8;
		    done    := true;
		  end;
	      catindx     := catindx + 7;
	    end;
	end;
      fpeof := catentryindx;
    end;
end;  { srm_catalog }
(****************************************************************************)
procedure srm_open_dir(anyvar f         : fib;
			      unum      : unitnum;
			      opentype  : gang_open_type;
			      openparent:boolean);
var
  volpass       : name_type;
  lentitle      : integer;
  sindx         : integer;
  pindx         : integer;
  nindx         : integer;
  i             : integer;
  path          : path_start_type;
  saveid        : file_id_type;
  origpathid    : file_id_type;
  last          : boolean;
  alreadyopen   : boolean;
  nfns          : integer;
  nsa           : name_set_array;

procedure getpaoc(anyvar paoc   : name_type;
			 del1   : char;
			 del2   : char);
var
  done  : boolean;
begin
  with f do
    begin
      done  := false;
      while (sindx <= lentitle) and (pindx <= name_type_len) and (not done) do
	if  (ftitle[sindx] = del1) or (ftitle[sindx] = del2) then
	  done            := true
	else
	  begin
	    paoc[pindx]   := ftitle[sindx];
	    pindx         := pindx + 1;
	    sindx         := sindx + 1;
	  end;
      if (sindx > lentitle) then
	begin
	  if del1 = '>' then
	    ioresult := ord(ibadpass);
	end
      else
	begin
	  if  (ftitle[sindx] <> del1) and (ftitle[sindx] <> del2) then
	    begin
	      if del1 = '>' then
		ioresult := ord(ibadpass)
	      else
		ioresult := ord(ibadtitle);
	    end
	  else
	    if (del1 = '>') then
	      if (ftitle[sindx] <> '>') then
		ioresult := ord(ibadpass);
	end;
    end;
end;



begin
  last          := false;
  alreadyopen   := false;
  sindx         := 1;

  with f do
    begin
      origpathid        := pathid;
      lentitle          := strlen(ftitle);
      setstrlen(ftid,0);
      if pathid = -1 then
	begin
	  setstrlen(fvid,0);
	  setstrlen(ffpw,0);
	end;
      if (sindx <= lentitle) then
	if ftitle[sindx] = '<' then       {get volume password}
	  begin
	    sindx   := sindx + 1;
	    pindx   := 1;
	    volpass := ' ';
	    getpaoc(volpass,'>','>');
	    paoc16tostr(volpass,fvid);
	    sindx   := sindx + 1;
	  end;

      path := start_alternate;
      if ioresult = ord(inoerror) then
	if (sindx <= lentitle) then
	  if ftitle[sindx] = '/' then
	    begin
	      path  := start_root;
	      sindx := sindx + 1;
	    end;
      if pathid = -1 then
	if path = start_root then
	  pathid := 0
	else
	  pathid := unitable^[unum].dvrtemp;

      if sindx > lentitle then
	begin
	  last      := true;
	  setstrlen(ftitle,0);
	end
      else
	if (ftitle[lentitle] = '/') then
	  setioresult(ord(ibadtitle));

      with packet_ptr.ropen^ do
	while (not last) and (ioresult = ord(inoerror)) do
	  begin
	    nfns        := 0;
	    while (sindx <= lentitle) and (nfns < 6) and (ioresult = ord(inoerror)) do
	      begin
		with nsa[nfns+1] do
		  begin
		    if (ftitle[sindx] = '/') then
		      ioresult      := ord(ibadtitle)
		    else
		      begin
			file_name       := ' ';
			password        := ' ';
			pindx           := 1;
			getpaoc(file_name,'<','/');
			nindx           := pindx;
			if ioresult = ord(inoerror) then
			  if (sindx <= lentitle) then
			    if (ftitle[sindx] = '<') then
			      begin
				sindx   := sindx + 1;
				pindx   := 1;
				getpaoc(password,'>','>');
				sindx   := sindx + 1;
				if sindx <= lentitle then
				  if ftitle[sindx] <> '/' then
				    if nindx > lentitle then
				      ioresult := ord(ibadtitle)
				    else
				      begin
					pindx := nindx;
					getpaoc(file_name,'/','/');
				      end;
			      end;
			if ioresult = ord(inoerror) then
			  if (sindx > lentitle) then
			    begin
			      last    := true;
			      setstrlen(ftitle,0);
			    end;
		      end;
		  end;
		if ioresult = ord(inoerror) then
		  nfns := nfns + 1;
		sindx   := sindx + 1;
	      end;

	    if ioresult = ord(inoerror) then
	      begin
		if not (last and openparent) then
		  begin
		    openpack(unum,nfns,addr(nsa),path,
			     pathid,volpass,shared_share_code,opentype);
		    if ioresult <> ord(inoerror) then
		      begin
			if last then
			  begin
			    ioresult := ord(inoerror);
			    openparent := true;
			  end;
		      end
		    else
		      begin
			saveid        := file_id;
			if alreadyopen then
			  srm_close_pathid(unum,pathid,false)
			else
			  alreadyopen := true;
			pathid        := saveid;
			path          := start_alternate;
		      end;
		  end;
		if ioresult = ord(inoerror) then
		  begin
		    if last and openparent then
		      begin
			if (nfns <= 1) then
			  begin
			    if pathid = -1 then
			      setioresult(ord(inodirectory));
			  end
			else
			  begin
			    openpack(unum,nfns-1,addr(nsa),path,
				     pathid,volpass,shared_share_code,opentype);
			    if ioresult <> ord(inoerror) then
			      begin
				if alreadyopen then
				  srm_close_pathid(unum,pathid,false);
			      end
			    else
			      begin
				saveid        := file_id;
				if alreadyopen then
				  srm_close_pathid(unum,pathid,false);
				pathid        := saveid;
			      end;
			  end;
			if ioresult = ord(inoerror) then
			  with nsa[nfns] do
			    begin
			      paoc16tostr(file_name,ftid);
			      ftitle      := ftid;
			      if password <> ' ' then
				paoc16tostr(password,ffpw);
			    end;
		      end;
		  end;
	      end;
	  end;
      if ((origpathid <> -1) and (origpathid = pathid))
      or (pathid = unitable^[unum].dvrtemp) then
	fsavepathid     := true
      else
	fsavepathid     := false;
    end;
end;

(****************************************************************************)
procedure srm_set_unit_prefix(anyvar f  : fib;
			      unum      : unitnum);
var
  savpathid     : integer;
begin
  with f, unitable^[unum] do
    begin
      srm_open_dir(f,unum,open_protected_directory,false);
      if ioresult = ord(inoerror) then
	begin
	  if strlen(ftitle) > 0 then
	    setioresult(ord(inounit))
	  else
	    begin
	      savpathid := pathid;
	      pathid    := dvrtemp;
	      dvrtemp   := savpathid;
	    end;
	  srm_close_pathid(unum,pathid,false);
	end;
      srm_get_vol_name(uvid,unum);
    end;
end;

(****************************************************************************)
procedure doopenpack(unum       : unitnum;
		     var f      : fib;
		     nfns       : integer;
		     anyvar nsa : name_set_array;
		     path       : path_start_type;
		     volpass    : name_type;
		     sharecode  : integer;
		     lockable   : boolean);
type
  trickrec      = record case boolean of
		    true  :(i   : integer);
		    false :(chs : packed array [1..2] of char;
			    si2 : shortint);
		  end;
var
  temprec       : trickrec;
begin
      with f, packet_ptr.ropen^ do
	begin
	  if lockable and fistextvar then
	    setioresult(ord(inotlockable))
	  else
	    openpack(unum,nfns,addr(nsa),path,pathid,volpass,
			       sharecode,open_data);
	  if ioresult = ord(inoerror) then
	    if file_code.si2 = 3 then   {directory}
	      begin
		setioresult(ord(inotondir));
		closepack(unum,file_id);
	      end
	    else
	      begin
		fileid        := file_id;
		fpeof         := open_logical_eof;
		fleof         := open_logical_eof;
		feft          := file_code.si2;
		fkind         := mapfkind(file_code);
		flockable     := lockable;
		flocked       := not lockable;  {default to locked unless lockable}
		if (feft = BDATTYPE)            {BDAT file}
		or (feft = BDATTYPE_500)        {fix for BDAT 500 file}
		or (feft = BASICBINTYPE)        {BIN  file}
		or (feft = BASICPROGTYPE) then  {PROG file}
		  begin
		    temprec.chs   := '  ';
		    temprec.si2   := max_record_size div 2;
		    fstartaddress := temprec.i;
		  end
		else
		  fstartaddress   := boot_start_address;
		if not fbuffered   then     am := amtable^[untypedfile]
		else if fistextvar then     am := amtable^[fkind]
		else                        am := amtable^[datafile];
	      end;
	end;
end;

(****************************************************************************)
procedure srm_open_file(anyvar f        : fib;
			       unum     : unitnum);
type
  trickrec      = record case boolean of
		    true  :(i   : integer);
		    false :(si1 : shortint;
			    si2 : shortint);
		  end;
var
  volpass       : name_type;
  fns           : file_name_set;
  temprec       : trickrec;
  sharemode     : integer;
  nps           : integer;
  psa           : protectcode_set_array;
  lockable      : boolean;
begin
  with f do
    begin
      setup_fns(f, fns);
      parseoptparm(foptstring,sharemode,lockable,nps,psa,true);
      if ioresult = ord(inoerror) then
	begin
	  strtopaoc16(fvid,volpass);
	  doopenpack(unum,f,1,fns,start_alternate,volpass,sharemode,lockable);
	end;
    end;
end;

(****************************************************************************)
procedure srm_create_dir (anyvar f      : fib;
				 unum   : unitnum);
type
  catentryptr   = ^catentry;
const
  dirfilecode   = gang_file_codes[i:3];
var
  volpass       : name_type;
  fns           : file_name_set;
begin
  with f, catentryptr(fwindow)^ do
    if strlen(cname) = 0 then
      setioresult(ord(ibadtitle))
    else
      begin
	with fns do
	  begin
	    password      := ' ';
	    strtopaoc16(cname,file_name);
	  end;
	strtopaoc16(fvid,volpass);
	createpack(unum,1,addr(fns),start_alternate,pathid,volpass,0,nil,
		   dirfilecode,directory_records,0,0,0,0);
      end;
end;

(****************************************************************************)
procedure srm_create_file(anyvar f      : fib;
				 unum   : unitnum);
const
  dirfilecode   = gang_file_codes[i:3];
type
  trickrec      = record case boolean of
		    true  :(i   : integer);
		    false :(si1 : shortint;
			    si2 : shortint);
		  end;
var
  volpass       : name_type;
  nsa           : name_set_array_three;
  ext1          : integer;
  temprec       : trickrec;
  sharemode     : integer;
  maxrec        : integer;
  nps           : integer;
  usefeft       : gang_file_codes;
  psa           : protectcode_set_array;
  i             : integer;
  ac            : ac_manager..ac_purgelink;
  lockable      : boolean;

begin
  with f, nsa[3] do
    begin
      strtopaoc16(fvid,volpass);
      repeat
	ioresult        := ord(inoerror);
	fanonctr        := tempcounter;
	tempcounter     := tempcounter + 1;
	usefeft.i       := feft;

	{BDAT file} {fix for BDAT 500 file}
	if (feft = BDATTYPE) or (feft = BDATTYPE_500) then
	  begin
	    temprec.i       := fstartaddress;
	    maxrec          := temprec.si2 * 2;
	    if maxrec < 1 then
	      maxrec := 1;
	  end
	else
	  maxrec    := 256;
	if fpos > 0 then
	  ext1 := fpos
	else
	  ext1 := extentsize;
	parseoptparm(foptstring,sharemode,lockable,nps,psa,false);
	check_protectcode_set_array(nps,psa);
	if (nps > 0) and (nps < 24) and (ioresult = ord(inoerror)) then
	  begin
	    nps := nps + 1;
	    with psa[nps] do
	      begin
		password        := temp_file_pass;
		capabilities    := nocapabilities;
		if nps > 1 then
		  for i := 1 to nps-1 do
		    for ac := ac_manager to ac_purgelink do
		      if psa[i].capabilities[ac] then
			capabilities[ac] := true;
	      end;
	  end;

	if (not fanonymous) and (ioresult = ord(inoerror)) then
	  begin
	    setup_fns(f,nsa);
	    foldfileid := -1;
	    openpack(unum,1,addr(nsa),start_alternate,pathid,volpass,sharemode,open_data);
	    if ioresult = ord(inofile) then
	      begin
		ioresult := ord(inoerror);
		nsa[1].password := ' ';
		createpack(unum,1,addr(nsa),start_alternate,pathid,volpass,
			   nps,addr(psa),usefeft,data_records,
			   maxrec,ext1,extentsize,fstartaddress);
		if ioresult = ord(inoerror) then
		  if feft <> SYSTMTYPE then
		    fnosrmtemp := true
		  else
		    begin               {SYSTM files must go through temp first}
		      nsa[1].password := temp_file_pass;
		      openpack(unum,1,addr(nsa),start_alternate,pathid,
			       volpass,sharemode,open_data);
		    end;
	      end;
	    if (ioresult = ord(inoerror)) and (not fnosrmtemp) then
	      begin
		foldfileid := packet_ptr.ropen^.file_id;
		fileinfopack(unum,foldfileid);
		with packet_ptr.rfileinfo^.file_info do
		  begin
		    if  (not capabilities[ac_manager])
		    and (not capabilities[ac_purgelink]) then
		      setioresult(ord(ibadpass))   {won't be able to purge old}
		    else           {this test added in version 2.2 on 4-May-83}
		      if file_code.si2 = 3 then {disallow rewrite on directory}
			setioresult(ord(inotondir));
		    if ioresult <> ord(inoerror) then
		      srm_close_fileid(unum,foldfileid);
		  end;
	      end;
	  end;

	if (ioresult = ord(inoerror)) and (not fnosrmtemp) then
	  begin
	    setup_fns3(f,nsa);
	    if ioresult = ord(inoerror) then
	      begin
		password        := ' ';
		createpack(unum,3,addr(nsa),start_root,pathid,volpass,
			   nps,addr(psa),usefeft,data_records,
			   maxrec,ext1,extentsize,fstartaddress);
		if ioresult = ord(inofile) then
		  begin
		    ioresult := ord(inoerror);
		    createpack(unum,2,addr(nsa),start_root,pathid,volpass,
			       0,nil,dirfilecode,directory_records,0,0,0,0);
		    if ioresult <> ord(inoerror) then
		      ioresult := ord(ineedtempdir)
		    else
		      createpack(unum,3,addr(nsa),start_root,pathid,volpass,
				 nps,addr(psa),usefeft,data_records,
				 maxrec,ext1,extentsize,fstartaddress);
		  end
		else
		  if ioresult = ord(idupfile) then
		    begin
		      ioresult := ord(inoerror);
		      password := temp_file_pass;
		      purgepack(unum,3,addr(nsa),start_root,pathid,volpass);
		      ioresult := ord(inoerror);
		      password := ' ';
		      createpack(unum,3,addr(nsa),start_root,pathid,volpass,
				 nps,addr(psa),usefeft,data_records,
				 maxrec,ext1,extentsize,fstartaddress);
		    end;
	      end;
	  end;
      until (ioresult <> ord(idupfile));
      if ioresult <> ord(inoerror) then
	srm_close_fileid(unum,foldfileid)
      else
	if fnosrmtemp then
	  begin
	    nsa[1].password := temp_file_pass;
	    doopenpack(unum,f,1,nsa,start_alternate,volpass,sharemode,lockable);
	  end
	else
	  begin
	    password := temp_file_pass;
	    doopenpack(unum,f,3,nsa,start_root,volpass,exclusive_share_code,lockable);
	  end;
    end;
end;

(****************************************************************************)
procedure srm_change_name(anyvar f      : fib;
				 unum   : unitnum);
type
  fidptr        = ^fid;
var
  volpass       : name_type;
  path1         : path_start_type;
  nfns1         : integer;
  fns1          : file_name_set;
  path2         : path_start_type;
  nfns2         : integer;
  fns2          : file_name_set;
begin
  with f, unitable^[unum] do
    begin
      srm_open_dir(f,unum,open_directory,true);
      if ioresult = ord(inoerror) then
	setup_fns(f, fns1);
      if ioresult = ord(inoerror) then
	with fns2 do
	  begin
	    file_name   := ' ';
	    password    := ' ';
	    if strpos('/',fidptr(fwindow)^) = 0 then
	      if (strpos('<',fidptr(fwindow)^) = 0) then
		strtopaoc16(fidptr(fwindow)^,file_name);
	    if file_name = ' ' then
	      setioresult(ord(ibadtitle));
	  end;
      if ioresult = ord(inoerror) then
	begin
	  strtopaoc16(fvid,volpass);
	  createlinkpack(unum,1,addr(fns1),start_alternate,pathid,volpass,
			 1,addr(fns2),start_alternate,pathid,volpass,true);
	end;
      srm_close_pathid(unum,pathid,fsavepathid);
    end;
end;

(****************************************************************************)
procedure srm_dup_link(anyvar f         : fib;
			      unum      : unitnum);
var
  volpass       : name_type;
  volpass2      : name_type;
  path1         : path_start_type;
  nfns1         : integer;
  fns1          : file_name_set;
  path2         : path_start_type;
  nfns2         : integer;
  fns2          : file_name_set;
begin
  with f, unitable^[unum] do
    begin
      srm_open_dir(f,unum,open_directory,true);
      if ioresult = ord(inoerror) then
	setup_fns(f, fns1);
      if ioresult = ord(inoerror) then
	srm_open_dir(fibp(fwindow)^,unum,open_directory,true);
      if ioresult = ord(inoerror) then
	setup_fns(fibp(fwindow)^, fns2);
      if ioresult = ord(inoerror) then
	begin
	  strtopaoc16(fvid,volpass);
	  strtopaoc16(fibp(fwindow)^.fvid,volpass2);
	  createlinkpack(unum,1,addr(fns1),start_alternate,pathid,volpass,
	      1,addr(fns2),start_alternate,fibp(fwindow)^.pathid,volpass2,
	      fpurgeoldlink);
	end;
      srm_close_pathid(unum,pathid,fsavepathid);
      srm_close_pathid(unum,fibp(fwindow)^.pathid,fibp(fwindow)^.fsavepathid);
    end;
end;

(****************************************************************************)
procedure srm_purge_name(anyvar f       : fib;
				unum    : unitnum);
var
  volpass       : name_type;
  fns           : file_name_set;
begin
  with f do
      begin
	setup_fns(f, fns);
	if ioresult = ord(inoerror) then
	  begin
	    strtopaoc16(fvid,volpass);
	    purgepack(unum,1,addr(fns),start_alternate,pathid,volpass);
	  end;
      end;
end;

(****************************************************************************)
procedure srm_purge_file(anyvar f       : fib;
				unum    : unitnum);
var
  volpass       : name_type;
  path          : path_start_type;
  nfns          : integer;
  nsa           : name_set_array_three;
begin
  with f do
    if (strlen(ftid) = 0) and not fisnew then
      setioresult(ord(ibadtitle))
    else
      begin
	if fmodified then
	  if not (flockable and not flocked) then
	    begin
	      seteofpack(funit,fileid,false,fleof);
	      if ioresult = ord(ilostfile) then
		fileid := -1;
	    end;
	if fisnew and (not fanonymous) and (not fnosrmtemp) then
	  srm_close_fileid(unum,foldfileid);
	srm_close_fileid(unum,fileid);
	setup_fns3(f,nsa);
	if ioresult <> ord(ibadtitle) then
	  begin
	    if (fisnew) and (not fnosrmtemp) then
	      begin
		path        := start_root;
		nfns        := 3;
	      end
	    else
	      begin
		path        := start_alternate;
		nfns        := 1;
	      end;
	    strtopaoc16(fvid,volpass);
	    if fisnew then
	      nsa[nfns].password := temp_file_pass;
	    purgepack(unum,nfns,addr(nsa),path,pathid,volpass);
	  end;
	if not (fisnew and fanonymous) then
	  srm_close_pathid(unum,pathid,fsavepathid);
      end;
end;

(****************************************************************************)
procedure srm_stretch(anyvar f          : fib;
			     unum       : unitnum);
var
  volpass       : name_type;
  neweof        : integer;
begin
  with f do
    begin
      neweof            := ((fpos div extentsize) + 1) * extentsize;
      seteofpack(funit,fileid,false,neweof);
      if ioresult = ord(inoerror) then
	begin
	  fpeof         := neweof;
	  fmodified     := true;
	end;
    end;
end;

(****************************************************************************)
procedure srm_close_file(anyvar f       : fib;
				unum    : unitnum);
var
  volpass       : name_type;
  nsa1          : name_set_array_three;
  fns           : file_name_set;
  tempioresult  : integer;
  ext1          : integer;
  saveleof      : integer;
  savefileid    : file_id_type;
  usefeft       : gang_file_codes;
  pcs           : protect_code_set;
begin
  with f do
    begin
      if fmodified then
	if not (flockable and not flocked) then
	  begin
	    seteofpack(funit,fileid,false,fleof);
	    if ioresult = ord(ilostfile) then
	      fileid := -1;
	  end;
      if not fisnew then
	srm_close_fileid(unum,fileid)
      else
	if ioresult <> ord(inoerror) then
	  srm_purge_file(f,unum)
	else
	  begin
	    strtopaoc16(fvid,volpass);
	    setup_fns3(f,nsa1);
	    setup_fns(f,fns);
	    if (ioresult = ord(inoerror)) and (not fnosrmtemp) then
	      if not foverwritten then
		begin
		  if not fanonymous then
		    begin
		      srm_close_fileid(unum,foldfileid);
		      purgepack(unum,1,addr(fns),start_alternate,pathid,volpass);
		    end;
		  if ioresult = ord(inofile) then
		    ioresult := ord(inoerror);
		  if ioresult <> ord(inoerror) then
		    srm_purge_file(f,unum);
		end
	      else
		begin
		  if foldfileid < 0 then
		    foverwritten := false
		  else
		    begin
		      exchangepack(unum,foldfileid,fileid);
		      srm_close_fileid(unum,foldfileid);
		      srm_close_pathid(unum,pathid,fsavepathid);
		    end;
		  srm_purge_file(f,unum);
		end;
	    if (ioresult = ord(inoerror)) and (not foverwritten) then
	      if feft <> SYSTMTYPE then   {not SYSTM file}
		begin
		  srm_close_fileid(unum,fileid);
		  if (ioresult = ord(inoerror)) and (not fnosrmtemp) then
		    createlinkpack(unum,3,addr(nsa1),start_root,pathid,volpass,
				   1,addr(fns),start_alternate,pathid,volpass,true);
		  if ioresult <> ord(inoerror) then
		    srm_purge_file(f,unum)
		  else
		    begin
		      fns.password := temp_file_pass;
		      with pcs do
			begin
			  password        := temp_file_pass;
			  capabilities    := nocapabilities;
			end;
		      tempioresult := ioresult;
		      changeprotectpack(unum,1,addr(fns),start_alternate,
					pathid,volpass,1,addr(pcs));
		      ioresult := tempioresult;
		    end;
		end
	      else
		begin                 {SYSTM file}
		  savefileid  := fileid;
		  saveleof    := fleof;
		  fpos        := saveleof;
		  if fpos > 0 then
		    ext1 := fpos
		  else
		    ext1 := extentsize;
		  usefeft.i   := feft;
		  fns.password := ' ';
		  createpack(unum,1,addr(fns),start_alternate,pathid,
			     volpass,0,nil,usefeft,data_records,
			     256,ext1,extentsize,fstartaddress);
		  if ioresult = ord(inoerror) then
		    doopenpack(unum,f,1,fns,start_alternate,volpass,exclusive_share_code,false);
		  if ioresult = ord(inoerror) then
		    copypack(unum,savefileid,0,fileid,0,saveleof);
		  srm_close_fileid(unum,fileid);
		  srm_close_pathid(unum,pathid,fsavepathid);
		  fileid      := savefileid;
		  srm_purge_file(f,unum);
		end;
	  end;
      srm_close_pathid(unum,pathid,fsavepathid);
    end;
end;
(****************************************************************************)
procedure srm_get_vol_date(anyvar f     : datetimerec;
				  unum  : unitnum);
type
  fibptr        = ^fib;
var
  tempfibspace  : packed array [1..sizeof(fib,0)] of char;
begin
  with fibptr(addr(tempfibspace))^, packet_ptr.rfileinfo^.file_info do
    begin
      funit     := unum;
      pathid    := -1;
      fileid    := -1;
      fpos      := 0;
      fkind     := datafile;
      feft      := DATATYPE;
      fisnew    := true;
      fanonymous:= true;
      fmodified := false;
      foptstring:= nil;
      fnosrmtemp:= false;
      setstrlen(ftid,0);
      srm_create_file(fibptr(addr(tempfibspace))^,unum);
      if ioresult = ord(inoerror) then
	begin
	  fileinfopack(unum,fileid);
	  if ioresult = ord(inoerror) then
	    with f do
	      translatedate(creation_date,date,time);
	  srm_purge_file(fibptr(addr(tempfibspace))^,unum);
	end;
    end;
end;

(****************************************************************************)
procedure srm_lock_file(anyvar f        : fib;
			       unum     : unitnum);
begin
  with f, packet_ptr.rlock^ do
    begin
      lockpack(unum,fileid,fwaitonlock);
      if ioresult = ord(inoerror) then
	if not success.value then
	  setioresult(ord(ifilelocked))
	else
	  begin
	    fileinfopack(unum,fileid);
	    if ioresult = ord(inoerror) then
	      with packet_ptr.rfileinfo^.file_info do
		begin
		  fpeof         := logical_eof;
		  fleof         := logical_eof;
		  flocked       := true;
		end;
	  end;
    end;
end;

(****************************************************************************)
procedure srm_unlock_file(anyvar f      : fib;
				 unum   : unitnum);
begin
  with f do
    begin
      if ioresult = ord(inoerror) then
	begin
	  call(am,addr(f),flush,f,0,0);
	  flastpos := -1;
	  if ioresult = ord(inoerror) then
	    begin
	      if fmodified then
		seteofpack(unum,fileid,false,fleof);
	      if ioresult = ord(inoerror) then
		unlockpack(unum,fileid);
	      if ioresult = ord(inoerror) then
		flocked := false;
	    end;
	end;
    end;
end;

(****************************************************************************)
procedure srm_strip(anyvar f : fib);
var
  s             : string[255];
  findx         : integer;
  sindx         : integer;
  namelen       : integer;
  passlen       : integer;
  i             : integer;
  ch            : char;
  skip          : boolean;
  inpass        : boolean;
  nopassyet     : boolean;
begin
  namelen       := 0;
  passlen       := 0;
  findx         := 1;
  sindx         := 0;
  setstrlen(s,255);
  inpass        := false;
  nopassyet     := true;
  with f do
    begin
      if ftitle[1] = '<' then   {skip over volume password}
	repeat
	  findx := findx + 1;
	  if (findx > name_type_len + 3) or (findx > strlen(ftitle)) then
	    setioresult(ord(ibadpass));
	until (ftitle[findx-1] = '>') or (ioresult <> ord(inoerror));

      while (findx <= strlen(ftitle)) and (ioresult = ord(inoerror)) do
	begin
	  skip    := false;
	  ch      := ftitle[findx];

	  if inpass then
	    begin
	      skip        := true;
	      if ch = '>' then
		inpass    := false
	      else
		passlen   := passlen + 1;
	    end
	  else if ch = '/' then
	    begin
	      nopassyet := true;
	      inpass    := false;
	      namelen   := 0;
	      passlen   := 0;
	    end
	  else if ch = '<' then
	    if nopassyet then
	      begin
		nopassyet := false;
		inpass    := true;
		skip      := true;
	      end;

	  if not skip then
	    begin
	      if ch = '/' then
		begin
		  if s[sindx] = '/' then
		    setioresult(ord(ibadtitle));
		end
	      else
		namelen   := namelen + 1;
	      sindx       := sindx + 1;
	      s[sindx]    := ch;
	    end;

	  findx           := findx + 1;

	  if (namelen > name_type_len) then
	    setioresult(ord(ibadtitle))
	  else if (passlen > name_type_len) then
	    setioresult(ord(ibadpass));
	end;

    if ioresult = ord(inoerror) then
      begin
	setstrlen(s,sindx);
	i := 0;
	while (s[sindx-i] <> '/') and (i < sindx) do
	  i       := i + 1;
	if i = 0 then
	  setioresult(ord(ibadtitle))
	else
	  begin
	    setstrlen(ftid,0);
	    strmove(i,s,sindx-i+1,ftid,1);
	    setstrlen(ftitle,0);
	    strmove(sindx-i,s,1,ftitle,1);
	  end;
      end;
    end;
end;

{****************************************************************************}

{INTERNAL ONLY BEGIN}
procedure pipe_am(fp      : fibp;
		  request : amrequesttype;
	   anyvar buffer  : window;
		  bufsize : integer;
		  position: integer);
  LABEL 1;
  const
    lf = 10;
    cr = 13;
    wbsize = 512;
    rbase  = 256;
    rbsize = 256;
  var i       : integer;
      eolchar : char;
      done    : boolean;

  { freptcnt = # of bytes in write part of fbuffer }
  procedure flushdata;
    begin
      with fp^, unitable^[funit] do
      begin
	if freptcnt>0 then call(tm,fp,writebytes,fbuffer,freptcnt,0);
	freptcnt := 0;
      end;
    end; { flushdata }

  { freptcnt = # of bytes in write part of fbuffer }
  procedure writedata(anyvar buffer : window; size : integer);
    begin
      with fp^, unitable^[funit] do
      begin
	if (freptcnt+size)>wbsize then flushdata;
	if ioresult=ord(inoerror) then
	begin
	  if size>=wbsize then
	    call(tm,fp,writebytes,buffer,size,0)
	  else
	  begin
	    moveleft(buffer,fbuffer[freptcnt],size);
	    freptcnt := freptcnt + size;
	  end;
	end;
      end;
    end; { writedata }

  { flastpos is # of bytes in read part of fbuffer.
    fstartaddress is index of next byte in read part of fbuffer.
    expects that the TM may not transfer all the requested data
    and that it will report the actual # of bytes in FLASTPOS .
    IMPLIED in the logic of this code is the expectation that
    the a call to the TM will result in at least one byte of
    data OR an error.
  }
  procedure readdata(anyvar buffer : window; size : integer);
    LABEL  2;
    var
      move     : integer;
      bindex   : integer;
    begin
      bindex   := 0;
      with fp^, unitable^[funit] do
      while (size>0) and (ioresult=ord(inoerror)) do
      begin
	if flastpos>0 then
	begin
	  if size=1 then { special case size 1 for speed }
	  begin
	    buffer[bindex] := fbuffer[fstartaddress];
	    size := 0;
	    fstartaddress := fstartaddress + 1;
	    flastpos := flastpos - 1;
	    GOTO 2;
	  end
	  else
	  begin
	    if flastpos>=size then move := size
			      else move := flastpos;
	    moveleft(fbuffer[fstartaddress],buffer[bindex],move);
	    bindex := bindex + move;
	    size   := size - move;
	    fstartaddress := fstartaddress + move;
	    flastpos      := flastpos - move;
	  end;
	end;

	if (size>=rbsize) then
	begin
	 { the SIZE of data requested won't fit in the read
	   part of fbuffer so request 512 or SIZE which ever
	   is smaller to be placed directly in the callers buffer
	   .... the TM can't accurately handle partial reads unless
	   .... the request to it is for 512 bytes or less.
	 }
	  if size > 512 then move := 512
			else move := rbsize;
	  call(tm,fp,readbytes,buffer[bindex],move,0);
	  { accept what shows up }
	  size := size - flastpos;
	  bindex := bindex + flastpos;
	  flastpos := 0; { show no data in fbuffer }
	end
	else
	if size>0 then
	begin
	  { SIZE requested will fit in read part of fbuffer
	    so try to fill the read part of fbuffer
	  }
	  call(tm,fp,readbytes,fbuffer[rbase],rbsize,0);
	  fstartaddress := rbase;
	end;
      end;
      2:
    end; { readdata }

  begin { pipe_am }
    with fp^, unitable^[funit] do
    begin
      if feft=uxfile_eft then eolchar:=chr(lf)  { eol for ux files }
			 else eolchar:=chr(cr); { Normal eol for data file}
      case request of
	flush      : begin
		       flushdata;
		       if ioresult=ord(inoerror) then
			 call(tm,fp,flush,buffer,bufsize,position);
		     end;
	writeeol   : writedata(eolchar,1);
	writebytes : writedata(buffer,bufsize);
	readbytes  : begin
		       flushdata;        { ensure all outbound data is gone }
		       readdata(buffer,bufsize);
		       if ioresult<>ord(inoerror) then GOTO 1;
		       if fistextvar then
		       begin
			 feoln := buffer[bufsize-1] = eolchar;
			 for i := 0 to bufsize - 1 do
			   if buffer[i]=eolchar then buffer[i] := ' ';
		       end;
		     end;
	readtoeol  : begin
		       flushdata;        { ensure all outbound data is gone }
		       if ioresult<>ord(inoerror) then GOTO 1;
		       feoln := false; done := false; i := 0;
		       repeat
			 i := i + 1;
			 readdata(buffer[i],1);
			 if ioresult<>ord(inoerror) then
			 begin
			   i := i - 1; done := true;
			 end
			 else
			 if (buffer[i]=eolchar) then
			 begin
			   i := i - 1; done := true;
			   fstartaddress := fstartaddress - 1;
			   flastpos := flastpos + 1;
			 end
			 else done := i=bufsize;
		       until done;
		       buffer[0]:=chr(i);
		     end;
	otherwise
	  call(tm, fp, request, buffer, bufsize, position);
      end; { case }
    end;
    1:
  end; { pipe_am }

{****************************************************************************}

function rmt_exec(anyvar f       : fib;
			 unum    : unitnum;
			 request : damrequesttype):boolean;
  var
    volpass : name_type;
    slen,
    sindx   : integer;

    procedure getvolpass;
      var
	vsize : integer;
	i     : integer;
      begin
	with f do
	begin
	  vsize   := 0;
	  i       := 2;
	  while ftitle[i]<>'>' do
	  begin
	    vsize := vsize + 1;
	    volpass[vsize] := ftitle[i];
	    i := i + 1;
	  end;
	end;
      end; { getvolpass }

  begin { rmt_exec }
    rmt_exec := false;
    with f do
    begin
      sindx := strpos('//',ftitle);
      if sindx>1 then
	if (ftitle[sindx-1]<>'>') or
	   (ftitle[1]<>'<') or
	   (sindx>(passleng+3)) then sindx := 0;

      if sindx>0 then
      begin
	sindx := strpos('//',lastfid^);
	if sindx>0 then
	begin
	  slen    := strlen(lastfid^);
	  volpass := ' ';
	  if ftitle[1]='<' then getvolpass;
	  with packet_ptr.rrmtexec^ do
	  begin
	    rmt_exec := true;
	    pathid := unitable^[unum].dvrtemp;
	    rmtexecpack(unum,start_alternate,pathid,volpass,
			addr(lastfid^[sindx+2]),slen-sindx-1);
	    if ioresult=ord(inoerror) then
	    begin
	      fileid := file_id;
	      fpeof  := minint;
	      fleof  := maxint;
	      feft   := uxfile_eft;
	      fkind  := uxfile;
	      flockable := false;
	      flocked   := true;
	      fstartaddress := 0;
	      freptcnt      := 0;
	      fnosrmtemp    := true;
	      fisnew := false; { to keep close simple }
	      am := pipe_am {amtable^[fkind]} ;
	      ffpw := '>remote execute<';
	      ftid := '<remote execute>';
	    end;
	  end; { with }
	end; { if sindx }
      end; { if sindx }
    end; { with f }
  end; { rmt_exec }
{INTERNAL ONLY END}
(****************************************************************************)
procedure srmdaminit;
{INTERNAL ONLY BEGIN}
var i : integer;
{INTERNAL ONLY END}
begin
  srm_init;
  passwordarrayptr := addr(constpassarray);
{INTERNAL ONLY BEGIN}
{ Not sure this is needed ; also done in INIT in Kernel. JWH 8/10/90 }
  for i := 1 to 50 do
    srmux_on[i] := false;
{INTERNAL ONLY END}
end;

{INTERNAL ONLY BEGIN}
{ Added for SRM-UX : }
{ This routine calls chmodpack, chownpack or chgrppack to carry out }
{ the requested command. These commands may only be requested from }
{ the FILER. Note that the name srmux_change_mode is a misnomer, }
{ 'cause it handles chown and chgrp requests as well. }
{ JWH 6/22/90.        }

procedure srmux_change_mode(f : fib;
			    unum : unitnum);
type
  command_array = array[0..maxint] of h_setpasswd_entry;
  command_arrayptr = ^command_array;

var nsa : name_set_array;
begin
  with f do
   begin
     with command_arrayptr(fwindow)^[0] do
      begin
       { writeln(new_value);
       writeln(command); }
       setup_fns(f,nsa);
       case command of
	 hfs_chmod : chmodpack(funit,
				   1, { nfns }
				addr(nsa),
				start_alternate,
				pathid,
				fileid,
				' ',
				new_value);
	hfs_chown : chownpack(funit,
				   1, { nfns }
				addr(nsa),
				start_alternate,
				pathid,
				fileid,
				' ',
				new_value);
	hfs_chgrp : chgrppack(funit,
				   1, { nfns }
				addr(nsa),
				start_alternate,
				pathid,
				fileid,
				' ',
				new_value);
	otherwise ;
      end; { case }
    end;
   end;

  { with  packet_ptr.rchmod^ do
   begin
     writeln('Status is : ',return_mess_header.status); end;
  writeln('leaving change mode'); }
end;
{INTERNAL ONLY END}
(****************************************************************************)
{INTERNAL ONLY BEGIN}
procedure srm_srmdam(anyvar f       : fib;
			    unum    : unitnum;
			    request : damrequesttype);
var
  holdpathid            : integer;
  savepathid            : integer;
  savefileid            : integer;
  saveftid              : tid;
  saveffpw              : passtype;
  savefvid              : vid;
  saveftitle            : fid;
  savefsavepathid       : boolean;
  fisafib               : boolean;
begin
  ioresult      := ord(inoerror);
  srmsavesc     := 0;
  lockup;
  fisafib       := false;
  try
    with f, unitable^[unum] do
      if offline then
	ioresult        := ord(znodevice)
      else
	begin
	  if request in [opendirectory,
			 openparentdir,
			 closedirectory,
			 catalog,
			 catpasswords,
			 setpasswords,
			 openfile,
			 createfile,
			 overwritefile,
			 makedirectory,
			 closefile,
			 changename,
			 duplicatelink,
			 purgename,
			 lockfile,
			 unlockfile,
			 purgefile,
			 setunitprefix,
			 stretchit              ] then          {f is a fib}
	    begin
	      fisafib   := true;
	      if strlen(ftid) > tidleng then    {fix uninitialized fib strings}
		setstrlen(ftid,0);
	      if strlen(ffpw) > passleng then
		setstrlen(ffpw,0);
	      if strlen(fvid) > vidleng then
		setstrlen(fvid,0);

	      savepathid        := pathid;    {save fib fields to be restored on error}
	      savefileid        := fileid;
	      savefsavepathid   := fsavepathid;
	      saveftid          := ftid;
	      saveffpw          := ffpw;
	      savefvid          := fvid;
	      if strlen(ftitle) > fidleng then
		setstrlen(saveftitle,0)
	      else
		saveftitle      := ftitle;
	    end;

 { TESTING ONLY !!!!!!!!!! }
 { if is_srmux_unit(unum) then
     log_srmdam_request(request); }

	  case request of
	    opendirectory,
	    openparentdir : begin
			      srm_open_dir(f,unum,open_directory,request = openparentdir);
			      if ioresult = ord(inoerror) then
				srm_get_dir_info(fwindow^,pathid,unum,true,false);
			    end;

	    closedirectory : begin
			       fsavepathid        := false;
			       srm_close_pathid(unum,pathid,false);
			     end;

	    catalog       : srm_catalog(f,unum);

	    catpasswords  : begin
			      srm_open_dir(f,unum,open_directory,true);
			      if ioresult = ord(inoerror) then
				begin
				  srm_cat_pass(f,unum);
				  srm_close_pathid(unum,pathid,fsavepathid);
				end;
			    end;

	    setpasswords  : { Changed for SRM-UX : }
			   if not is_srmux_unit(unum) then
			    begin
			      srm_open_dir(f,unum,open_directory,true);
			      if ioresult = ord(inoerror) then
				begin
				  srm_set_pass(f,unum);
				  srm_close_pathid(unum,pathid,fsavepathid);
				end;
			    end
			    else
			     begin { they want us to change mode, etc. }
			       { It's the FILER calling from the
				 hfs_access routine  }
			       srm_open_dir(f,unum,open_directory,true);
			       if ioresult = ord(inoerror) then
				begin
				  srmux_change_mode(f,unum);
				  srm_close_pathid(unum,pathid,fsavepathid);
				end;
				{ else
				 writeln('the opendir thing did not work'); }
			     end; { is SRM-UX request }

	    openfile      : if not rmt_exec(f,unum,request) then
			    begin
			      fisnew            := false;
			      fnosrmtemp        := true;      {default case}
			      srm_open_dir(f,unum,open_directory,true );
			      if ioresult = ord(inoerror) then
				begin
				  srm_open_file(f,unum);
				  if ioresult <> ord(inoerror) then
				    srm_close_pathid(unum,pathid,fsavepathid);
				end;
			    end;

	    createfile,
	    overwritefile : if not rmt_exec(f,unum,request) then
			    begin
			      fisnew            := true;
			      fnosrmtemp        := false;
			      foverwritten      := request = overwritefile;
			      if not fanonymous then
				srm_open_dir(f,unum,open_directory,true );
			      if ioresult = ord(inoerror) then
				begin
				  srm_create_file(f,unum);
				  if ioresult <> ord(inoerror) then
				    if not fanonymous then
				      srm_close_pathid(unum,pathid,fsavepathid);
				end;
			    end;

	    makedirectory : begin
			      holdpathid  := pathid;
			      srm_open_dir(f,unum,open_directory,false);
			      if ioresult = ord(inoerror) then
				begin
				  srm_create_dir (f,unum);
				  srm_close_pathid(unum,pathid,fsavepathid);
				end;
			      pathid      := holdpathid;
			    end;

	    closefile     : if (fisnew and fanonymous) then
			      srm_purge_file(f,unum)
			    else
			      srm_close_file(f,unum);

	    changename    : srm_change_name(f,unum);

	    duplicatelink : srm_dup_link(f,unum);

	    purgename     : begin
			      holdpathid  := pathid;
			      srm_open_dir(f,unum,open_directory,true);
			      if ioresult = ord(inoerror) then
				begin
				  srm_purge_name(f,unum);
				  srm_close_pathid(unum,pathid,fsavepathid);
				end;
			      pathid      := holdpathid;
			    end;

	    lockfile      : srm_lock_file(f,unum);

	    unlockfile    : srm_unlock_file(f,unum);

	    purgefile     : srm_purge_file(f,unum);

	    setunitprefix : srm_set_unit_prefix(f,unum);

	    stretchit     : srm_stretch(f,unum);

	    getvolumename : srm_get_vol_name(f,unum);

	    getvolumedate : srm_get_vol_date(f,unum);

	    setvolumedate,
	    crunch        : {do nothing, but no error};

	    stripname     : srm_strip(f);

	    { Used by the FILER to distinguish SRM and SRM/UX }
	    { Added for 3.23+ and 3.24 JWH 11/12/90 }

	    setvolumename : begin
			     if is_srmux_unit(unum) then
			       setioresult(ord(ibadvalue))
			     else
			       setioresult(ord(ibadrequest));
			    end;

	    otherwise       setioresult(ord(ibadrequest));
	  end;

	  if (ioresult <> ord(inoerror)) and fisafib then {restore fib for subsequent calls}
	    begin
	      pathid        := savepathid;
	      fileid        := savefileid;
	      fsavepathid   := savefsavepathid;
	      ftid          := saveftid;
	      ffpw          := saveffpw;
	      fvid          := savefvid;
	      if strlen(saveftitle) > 0 then
		ftitle      := saveftitle;
	    end;
	  if ioresult = ord(isrmcatchall) then
	    if srmsavesc <> 0 then
	      escape(srmsavesc);
	end;
  recover
    begin
      if escapecode = ioescapecode then
	setioresult(ord(isrmcatchall))
      else
	begin
	  lockdown;
	  escape(escapecode);
	end;
    end;
  lockdown;
end; {srm_srmdam}

procedure lan_srmdam(anyvar f       : fib;
			    unum    : unitnum;
			    request : damrequesttype);
  begin
    lastunit := unum;
    lastsc   := unitable^[lastunit].sc;
    lansrm_reset(lastsc);
    with lsrm_unit_table^[lastunit] do
    begin
      srm_srmdam(f,unum,request);
    end;
  end;

procedure srmdam(anyvar f       : fib;
			unum    : unitnum;
			request : damrequesttype);
  {decide which dam should be installed}
    begin
    ioresult    := 0;
    with f, unitable^[unum] do
      if offline then ioresult := ord(znodevice)
      else
      begin
	if iompx_info = nil then
	  begin
	    dam := srm_srmdam;
	    volpack(unum);
	    with packet_ptr.rvol^ do
	     begin
	      if srm_ux_flag then
		srmux_on[unum] := true
	      else
		srmux_on[unum] := false;
	     end;
	   end
	  else
	begin
	  if (isc_table[sc].card_id = hp98643) then
	  begin
	    if iompx_info^.isc_iompx_table[sc].capable then
	    begin
	      if pad=0 then lansrm_init_unit(unum);
	      pad := 1; { shadow unit has been reset }
	      dam := lan_srmdam;
	      srmux_on[unum] := true; { Only possibility }
	    end
	    else ioresult := ord(znodevice);
	  end
	  else
	    begin
	     dam := srm_srmdam;
	     volpack(unum);
	     with packet_ptr.rvol^ do
	      begin
	       if srm_ux_flag then
		srmux_on[unum] := true
	       else
		srmux_on[unum] := false;
	      end;
	    end;
	end;
	{ complete the call }
	call(dam,f,unum,request);
      end;
  end; {srmdam}
{INTERNAL ONLY END}
end; {srmdammodule}

import
  srmdammodule;
begin   {program init_srm}
  srmdaminit;
end.

@


53.1
log
@Automatic bump of revision number for PWS version 3.24B
@
text
@@


52.1
log
@Automatic bump of revision number for PWS version 3.24A
@
text
@@


51.1
log
@Automatic bump of revision number for PWS version 3.24d
@
text
@@


50.12
log
@Removed external version code. From now on all versions are SRM/UX
capable.
@
text
@@


50.11
log
@In routine srmux_mapfkind I changed a case statement to a series of IF
statements.
@
text
@a2517 206
{EXTERNAL ONLY BEGIN}
procedure srmdam(anyvar f       : fib;
			unum    : unitnum;
			request : damrequesttype);
var
  holdpathid            : integer;
  savepathid            : integer;
  savefileid            : integer;
  saveftid              : tid;
  saveffpw              : passtype;
  savefvid              : vid;
  saveftitle            : fid;
  savefsavepathid       : boolean;
  fisafib               : boolean;
begin
  ioresult      := ord(inoerror);
  srmsavesc     := 0;
  lockup;
  fisafib       := false;
  try
    with f, unitable^[unum] do
      if offline then
	ioresult        := ord(znodevice)
      else
	begin
	  if request in [opendirectory,
			 openparentdir,
			 closedirectory,
			 catalog,
			 catpasswords,
			 setpasswords,
			 openfile,
			 createfile,
			 overwritefile,
			 makedirectory,
			 closefile,
			 changename,
			 duplicatelink,
			 purgename,
			 lockfile,
			 unlockfile,
			 purgefile,
			 setunitprefix,
			 stretchit              ] then          {f is a fib}
	    begin
	      fisafib   := true;
	      if strlen(ftid) > tidleng then    {fix uninitialized fib strings}
		setstrlen(ftid,0);
	      if strlen(ffpw) > passleng then
		setstrlen(ffpw,0);
	      if strlen(fvid) > vidleng then
		setstrlen(fvid,0);

	      savepathid        := pathid;    {save fib fields to be restored on error}
	      savefileid        := fileid;
	      savefsavepathid   := fsavepathid;
	      saveftid          := ftid;
	      saveffpw          := ffpw;
	      savefvid          := fvid;
	      if strlen(ftitle) > fidleng then
		setstrlen(saveftitle,0)
	      else
		saveftitle      := ftitle;
	    end;
	  case request of
	    opendirectory,
	    openparentdir : begin
			      srm_open_dir(f,unum,open_directory,request = openparentdir);
			      if ioresult = ord(inoerror) then
				srm_get_dir_info(fwindow^,pathid,unum,true,false);
			    end;

	    closedirectory : begin
			       fsavepathid        := false;
			       srm_close_pathid(unum,pathid,false);
			     end;

	    catalog       : srm_catalog(f,unum);

	    catpasswords  : begin
			      srm_open_dir(f,unum,open_directory,true);
			      if ioresult = ord(inoerror) then
				begin
				  srm_cat_pass(f,unum);
				  srm_close_pathid(unum,pathid,fsavepathid);
				end;
			    end;

	    setpasswords  : begin
			      srm_open_dir(f,unum,open_directory,true);
			      if ioresult = ord(inoerror) then
				begin
				  srm_set_pass(f,unum);
				  srm_close_pathid(unum,pathid,fsavepathid);
				end;
			    end;

	    openfile      : begin
			      fisnew            := false;
			      fnosrmtemp        := true;      {default case}
			      srm_open_dir(f,unum,open_directory,true );
			      if ioresult = ord(inoerror) then
				begin
				  srm_open_file(f,unum);
				  if ioresult <> ord(inoerror) then
				    srm_close_pathid(unum,pathid,fsavepathid);
				end;
			    end;

	    createfile,
	    overwritefile : begin
			      fisnew            := true;
			      fnosrmtemp        := false;
			      foverwritten      := request = overwritefile;
			      if not fanonymous then
				srm_open_dir(f,unum,open_directory,true );
			      if ioresult = ord(inoerror) then
				begin
				  srm_create_file(f,unum);
				  if ioresult <> ord(inoerror) then
				    if not fanonymous then
				      srm_close_pathid(unum,pathid,fsavepathid);
				end;
			    end;

	    makedirectory : begin
			      holdpathid  := pathid;
			      srm_open_dir(f,unum,open_directory,false);
			      if ioresult = ord(inoerror) then
				begin
				  srm_create_dir (f,unum);
				  srm_close_pathid(unum,pathid,fsavepathid);
				end;
			      pathid      := holdpathid;
			    end;

	    closefile     : if (fisnew and fanonymous) then
			      srm_purge_file(f,unum)
			    else
			      srm_close_file(f,unum);

	    changename    : srm_change_name(f,unum);

	    duplicatelink : srm_dup_link(f,unum);

	    purgename     : begin
			      holdpathid  := pathid;
			      srm_open_dir(f,unum,open_directory,true);
			      if ioresult = ord(inoerror) then
				begin
				  srm_purge_name(f,unum);
				  srm_close_pathid(unum,pathid,fsavepathid);
				end;
			      pathid      := holdpathid;
			    end;

	    lockfile      : srm_lock_file(f,unum);

	    unlockfile    : srm_unlock_file(f,unum);

	    purgefile     : srm_purge_file(f,unum);

	    setunitprefix : srm_set_unit_prefix(f,unum);

	    stretchit     : srm_stretch(f,unum);

	    getvolumename : srm_get_vol_name(f,unum);

	    getvolumedate : srm_get_vol_date(f,unum);

	    setvolumedate,
	    crunch        : {do nothing, but no error};

	    stripname     : srm_strip(f);

	    otherwise       setioresult(ord(ibadrequest));
	  end;

	  if (ioresult <> ord(inoerror)) and fisafib then {restore fib for subsequent calls}
	    begin
	      pathid        := savepathid;
	      fileid        := savefileid;
	      fsavepathid   := savefsavepathid;
	      ftid          := saveftid;
	      ffpw          := saveffpw;
	      fvid          := savefvid;
	      if strlen(saveftitle) > 0 then
		ftitle      := saveftitle;
	    end;
	  if ioresult = ord(isrmcatchall) then
	    if srmsavesc <> 0 then
	      escape(srmsavesc);
	end;
  recover
    begin
      if escapecode = ioescapecode then
	setioresult(ord(isrmcatchall))
      else
	begin
	  lockdown;
	  escape(escapecode);
	end;
    end;
  lockdown;
end;
{EXTERNAL ONLY END}
@


50.10
log
@syncing up the source ...
@
text
@d73 2
a74 2
  procedure show_counter_values; }
  function srmux_mapfkind(ftype : gang_file_codes) : filekind;
d162 1
a162 4
type trick_rec = record  case boolean of
     FALSE: (i : integer);
     TRUE: (c : gang_file_codes);
     end; { trick_rec }
d166 1
a166 1
  doit : trick_rec;
d178 14
a191 14
      doit.c := ftype;
      case doit.i of
	-5791 : ; { BDATTYPE - do nothing, treat same as before }
	-5663 : ; { BDATTYPE_500 - do nothing, same as before }
	-5775 : ; { BASICBINTYPE - do nothing, same as before }
	-5808 : ; { BASICPROGTYPE - do nothing, same as before }
	-5812 : srmux_mapfkind := fkind9; { PIPETYPE }
	-5811 : srmux_mapfkind := fkind10; { BDEVTYPE }
	-5810 : srmux_mapfkind := fkind11; { CDEVTYPE }
	-5809 : srmux_mapfkind := fkind12; { OTHERTYPE }
	-5806 : srmux_mapfkind := fkind13; { NETTYPE }
	-5805 : srmux_mapfkind := fkind14; { SOCKTYPE }
      otherwise ; { just leave it datafile - as before }
      end; { case }
d193 1
@


50.9
log
@Restored the "old" version of the routine srm_close_file. This pretty
much ends my (failed) attempt to fix the srm/ux link problem. JWH.
@
text
@d38 1
a38 1
	'IOLIB:KERNEL'
d40 1
a40 1
	,'LANSRM','IOLIB:LANDECS'
d74 1
d106 6
a111 6
  PIPETYPE      = -5812;  { HP-UX PIPE }
  BDEVTYPE      = -5811;  { HP-UX Block Special Device File }
  CDEVTYPE      = -5810;  { HP-UX Character Special Device File }
  MISCTYPE      = -5809;  { HP-UX Other }
  NETTYPE       = -5806;  { HP-UX Network Special File }
  SOCKTYPE      = -5805;  { HP-UX Socket }
a112 1

d160 37
d524 1
a524 1
		  strwrite(cinfo,1,n,'SRM-UX  ',sc:1,',',ba:1,',',du:1)
d715 12
a726 2
			ceft      := file_code.si2;
			ckind     := mapfkind(file_code);
d765 42
d1200 2
a1201 1
	    openpack(unum,nfns,addr(nsa),path,pathid,volpass,sharecode,open_data);
@


50.8
log
@Added some type definitions for HP-UX file types that could be
encountered in an SRM/UX server's file system.
@
text
@a1521 5
type trickrec = record case boolean of
		 true :(i : integer);
		 false :(si1 : shortint;
			 si2 : shortint);
	      end; { trickrec }
a1531 2
  maxrec        : integer;
  temprec       : trickrec;
d1558 1
a1558 2
		      purgepack(unum,1,addr(fns),start_alternate,
				pathid,volpass);
d1580 1
a1580 4
		  { Keep it open just a bit longer JWH 10/25/90 : }
		  { SRM/UX only. SRM : do same as before }
		  if not is_srmux_unit(unum) then
		      srm_close_fileid(unum,fileid);
d1582 2
a1583 3
		    createlinkpack(unum,3,addr(nsa1),start_root,pathid,
				   volpass,1,addr(fns),start_alternate,
				   pathid,volpass,true);
d1585 2
a1586 54
		   begin
	 {============================================================}
	 { Added for the SRM/UX link problem JWH 10/25/90 :           }
	 { Code swiped from the SYSTM file case with the maxrec       }
	 { finesse for BDAT files stolen from srm_create_file.        }
	 { Note - we do this for SRM/UX units only.                   }
	 {============================================================}
		    if ((ioresult = 57) and is_srmux_unit(unum)) then
		     begin
		      ioresult := 0;
		      savefileid := fileid;
		      saveleof := fleof;
		      fpos     := saveleof;

		      { Set the value of maxrec. Handle special }
		      { case of BDAT files. Stolen from srm_create_file }

		      if (feft = BDATTYPE) or (feft = BDATTYPE_500) then
		       begin
			temprec.i := fstartaddress;
			maxrec    := temprec.si2 * 2;
			if maxrec < 1 then maxrec := 1;
		       end
		      else maxrec := 256; { The usual case }

		      if fpos > 0 then
			ext1 := fpos
		      else
			ext1 := extentsize;

		      usefeft.i := feft;

		      fns.password := ' '; { OK for SRM/UX files }

		      createpack(unum,1,addr(fns),start_alternate,
				 pathid,volpass,0,nil,usefeft,
				 data_records,maxrec,ext1,extentsize,
				 fstartaddress);

		      if ioresult = ord(inoerror) then
			doopenpack(unum,f,1,fns,start_alternate,volpass,
				   exclusive_share_code,false);

		      if ioresult = ord(inoerror) then
			copypack(unum,savefileid,0,fileid,0,
				 saveleof);

		      srm_close_fileid(unum,fileid);
		      srm_close_pathid(unum,pathid,fsavepathid);
		      fileid  := savefileid;

		      srm_purge_file(f,unum); { leave as before }
		    end
		   else  { wasn't our problem - do same as before }
a1587 10
		     if is_srmux_unit(unum) then
		       srm_close_fileid(unum,fileid);  { as before }
		     srm_purge_file(f,unum);           { as before }
		    end;
	 {============================================================}
		   end  { ioresult <> ord(inoerror) }
		  else
		    begin { no link error - same as before }
		      if is_srmux_unit(unum) then
			srm_close_fileid(unum,fileid); { Didn't need it }
d1615 1
a1615 2
		    doopenpack(unum,f,1,fns,start_alternate,
			       volpass,exclusive_share_code,false);
@


50.7
log
@Moved the setvolumedate processing (for 3.23+ and 3.24) to it's
proper place in srm_srmdam (internal only version).
@
text
@d103 9
@


50.6
log
@Added some commented out routines used for testing, and changed
the ioresult for setvolumename request to be different for SRM/UX
than what it was for SRM so that the FILER can tell SRM from SRM/UX.
@
text
@d2389 10
a2669 10

	    { Used by the FILER to distinguish SRM and SRM/UX }
	    { Added for 3.23+ and 3.24 JWH 11/12/90 }

	    setvolumename : begin
			     if is_srmux_unit(unum) then
			       setioresult(ord(ibadvalue))
			     else
			       setioresult(ord(ibadrequest));
			    end;
@


50.5
log
@Changes the link failure indicator looked for in srm_close_file
to 57 (from 58). This value is set by maptoioresult in SRM_DRV.
@
text
@d70 5
d109 25
d2256 5
d2660 10
@


50.4
log
@More small changes to srm_close_file.
@
text
@d1565 1
a1565 1
		    if ((ioresult = 58) and is_srmux_unit(unum)) then
@


50.3
log
@Small fix in srm_close_file.
@
text
@d1613 2
a1614 1
		     srm_close_fileid(unum,fileid);    { as before }
d1621 2
a1622 1
		      srm_close_fileid(unum,fileid); { Didn't need it }
@


50.2
log
@Modified srm_close_file so the refrain from closing a file
just before the call to createlinkpack applies to SRM/UX units
only. For SRM, do the same as before.
@
text
@d1551 1
a1551 1
		  if not is_srmux_unit then
@


50.1
log
@Automatic bump of revision number for PWS version 3.23c
@
text
@d1550 3
a1552 1
		  { srm_close_fileid(unum,fileid); }
@


49.3
log
@Minor fix to srm_close_file.
@
text
@@


49.2
log
@Updated srm_close_file for the SRM/UX link problem fix. JWH 10/25/90.
@
text
@d1596 1
a1596 1
			doopenpack(unum,1,fns,start_alternate,volpass,
@


49.1
log
@Automatic bump of revision number for PWS version 3.24b
@
text
@d1483 5
d1498 2
d1526 2
a1527 1
		      purgepack(unum,1,addr(fns),start_alternate,pathid,volpass);
d1549 2
a1550 1
		  srm_close_fileid(unum,fileid);
d1552 3
a1554 2
		    createlinkpack(unum,3,addr(nsa1),start_root,pathid,volpass,
				   1,addr(fns),start_alternate,pathid,volpass,true);
d1556 60
a1615 1
		    srm_purge_file(f,unum)
d1617 2
a1618 1
		    begin
d1646 2
a1647 1
		    doopenpack(unum,f,1,fns,start_alternate,volpass,exclusive_share_code,false);
a1658 1

@


48.2
log
@Just added a comment.
@
text
@@


48.1
log
@Automatic bump of revision number for PWS version 3.24a
@
text
@d2022 1
@


47.6
log
@Several changes for SRM-UX.
@
text
@@


47.5
log
@SRM-UX change.
@
text
@d613 2
d649 70
a718 4
			setstrlen(cinfo,ord(ac_createlink)+1);
			for ac := ac_manager to ac_createlink do
			  if capabilities[ac] then
			    cinfo[ord(ac) + 1] := ac_chars[ac]
d720 59
a778 10
			    cinfo[ord(ac) + 1] := ' ';
			case share_code of
			  exclusive_share_code  : cinfo := cinfo + ' EXCLUSIVE';
			  shared_share_code     : cinfo := cinfo + ' SHARED';
			  {
			  closed_share_code     : cinfo := cinfo + ' CLOSED';
			  }
			  corrupt_share_code    : cinfo := cinfo + ' CORRUPT';
			  otherwise               cinfo := cinfo + ' CLOSED';
			end;
d793 1
a793 2
end;

d2027 59
d2175 3
a2177 1
	    setpasswords  : begin
d2184 14
a2197 1
			    end;
@


47.4
log
@SRM-UX changes.
@
text
@d448 1
a448 1
		  strwrite(cinfo,1,n,'SRM-UX  ',sc:1,',',ba:1,',',du:1);
@


47.3
log
@SRM-UX changes.
@
text
@d445 7
a451 1
		strwrite(cinfo,1,n,'SRM  ',sc:1,',',ba:1,',',du:1);
@


47.2
log
@SRM-UX changes.
@
text
@d428 1
a428 1
	    if not exist.value then
@


47.1
log
@Automatic bump of revision number for PWS version 3.23
@
text
@d1893 3
d1899 4
d2140 8
a2147 4
	    areyoualivepack(unum);
	    if
	    (packet_ptr.rareyoualive^.return_mess_header.status = 17117191)
	       then ;
d2158 1
d2165 8
a2172 4
	     areyoualivepack(unum);
	     if
	    (packet_ptr.rareyoualive^.return_mess_header.status = 17117191)
	       then ;
@


46.1
log
@Automatic bump of revision number for PWS version 3.23
@
text
@@


45.1
log
@Automatic bump of revision number for PWS version 3.23C
@
text
@@


44.1
log
@Automatic bump of revision number for PWS version 3.23B
@
text
@@


43.1
log
@Automatic bump of revision number for PWS version 3.23aA
@
text
@@


42.1
log
@Automatic bump of revision number for PWS version 3.23e
@
text
@@


41.1
log
@Automatic bump of revision number for PWS version 3.23d
@
text
@@


40.1
log
@Automatic bump of revision number for PWS version 3.23c
@
text
@@


39.2
log
@
pws2rcs automatic delta on Thu Sep 28 17:16:32 MDT 1989
@
text
@@


39.1
log
@Automatic bump of revision number for PWS version 3.23b
@
text
@d38 1
a38 1
	'IOLIB:KERNEL',
d40 1
a40 1
	'LANSRM','IOLIB:LANDECS'
@


38.5
log
@
        SRM-UX source control hacking.
@
text
@@


38.4
log
@
   SRM-UX source control hacking.
@
text
@d56 1
a56 1
  srm,
d58 1
a58 1
  asm
@


38.3
log
@
      SRM-UX source control.
@
text
@d28 5
a32 1
program init_srm(INPUT,OUTPUT);
d39 4
a42 1
	'LANSRM','IOLIB:LANDECS'$
d52 1
d55 1
d57 4
a60 1
  asm;
a75 1
  SRMUX_ON = TRUE;
d1648 1
a1648 1
$IF SRMUX_ON$
d1890 1
a1890 1
$END$
d1899 1
a1899 1
$IF SRMUX_ON$
d2163 2
a2164 2
$END$
$IF NOT SRMUX_ON$
d2369 1
a2369 1
$END$
@


38.2
log
@ 
        SRM-UX source control.
@
text
@d64 1
d2153 52
d2206 153
@


38.1
log
@Automatic bump of revision number for PWS version 3.23a
@
text
@d1636 1
d1878 1
a1878 1

d1887 1
d2151 1
@


37.2
log
@

             Changes for SRM-UX.
@
text
@@


37.1
log
@Automatic bump of revision number for PWS version 3.3a
@
text
@d32 2
a33 1
$search 'SRM_DRV',
d36 4
d2110 1
a2110 1
  begin
d2116 9
a2124 2
	if iompx_info = nil then dam := srm_srmdam
	else
d2129 5
a2133 1
	      dam := lan_srmdam
d2136 8
a2143 1
	  else dam := srm_srmdam;
@


36.2
log
@Changes made to support SRM-UX and remote process execution/control
RDQ 9 may 89

@
text
@@


36.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@d28 1
a28 1
program init_srm;
d33 2
a34 1
	'IOLIB:KERNEL'$
d40 4
a43 1
  srm;
d57 1
d86 1
d1629 244
d1881 3
a1883 3
procedure srmdam(anyvar f       : fib;
			unum    : unitnum;
			request : damrequesttype);
d1977 2
a1978 1
	    openfile      : begin
d1991 2
a1992 1
	    overwritefile : begin
d2086 40
a2125 1
end;
@


35.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@@


34.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@@


33.1
log
@Automatic bump of revision number for PWS version 3.22D
@
text
@@


32.1
log
@Automatic bump of revision number for PWS version 3.22C
@
text
@@


31.1
log
@Automatic bump of revision number for PWS version 3.22B
@
text
@@


30.1
log
@Automatic bump of revision number for PWS version 3.22A
@
text
@@


29.1
log
@Automatic bump of revision number for PWS version 3.22b
@
text
@@


28.1
log
@Automatic bump of revision number for PWS version 3.3b
@
text
@@


27.1
log
@Automatic bump of revision number for PWS version 3.3a
@
text
@@


26.1
log
@Automatic bump of revision number for PWS version 3.3 Synch
@
text
@@


25.2
log
@fix in sysdate call
@
text
@@


25.1
log
@Automatic bump of revision number for PWS version 3.2Y
@
text
@d372 2
@


24.1
log
@Automatic bump of revision number for PWS version 3.2
@
text
@@


23.1
log
@Automatic bump of revision number for PWS version 3.2P
@
text
@@


22.1
log
@Automatic bump of revision number for PWS version 3.2N
@
text
@@


21.1
log
@Automatic bump of revision number for PWS version 3.2M
@
text
@@


20.1
log
@Automatic bump of revision number for PWS version 3.2L
@
text
@@


19.1
log
@Automatic bump of revision number for PWS version 3.2K
@
text
@@


18.1
log
@Automatic bump of revision number for PWS version 3.2J
@
text
@@


17.1
log
@Automatic bump of revision number for PWS version 3.2I+
@
text
@@


16.1
log
@Automatic bump of revision number for PWS version 3.2I
@
text
@@


15.1
log
@Automatic bump of revision number for PWS version 3.2H
@
text
@@


14.1
log
@Automatic bump of revision number for PWS version 3.2G
@
text
@@


13.1
log
@Automatic bump of revision number for PWS version 3.2F
@
text
@@


12.1
log
@Automatic bump of revision number for PWS version 3.2E
@
text
@@


11.1
log
@Automatic bump of revision number for PWS version 3.2D
@
text
@@


10.1
log
@Automatic bump of revision number for PWS version 3.2C
@
text
@@


9.1
log
@Automatic bump of revision number for PWS version 3.2B
@
text
@@


8.1
log
@Automatic bump of revision number for PWS version 3.2A
@
text
@@


7.1
log
@Automatic bump of revision number for PWS version 3.2l
@
text
@@


6.1
log
@Automatic bump of revision number for PWS version 3.2k
@
text
@@


5.2
log
@fixes so that paws can copy 500 BDAT files on the SRM
@
text
@@


5.1
log
@Automatic bump of revision number for PWS version 3.2j
@
text
@d69 1
d942 1
d1051 2
a1052 1
	if feft = BDATTYPE then        {BDAT file}
@


4.1
log
@Automatic bump of revision number for PWS version 3.2i
@
text
@@


3.1
log
@Automatic bump of revision number for PWS version 3.2h
@
text
@@


2.1
log
@Auto bump rev number to 2.1 for sys 3.2e.
@
text
@@


1.1
log
@Initial revision
@
text
@@
