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


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

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

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

55.1
date     91.08.25.10.14.22;  author jwh;  state Exp;
branches ;
next     54.1;

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

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

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

51.1
date     91.01.30.16.05.31;  author jwh;  state Exp;
branches ;
next     50.1;

50.1
date     90.10.29.16.20.58;  author jwh;  state Exp;
branches ;
next     49.1;

49.1
date     90.08.14.14.05.16;  author jwh;  state Exp;
branches ;
next     48.1;

48.1
date     90.07.26.11.11.02;  author jwh;  state Exp;
branches ;
next     47.1;

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

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

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

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

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

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

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

40.1
date     89.09.29.11.42.51;  author jwh;  state Exp;
branches ;
next     39.1;

39.1
date     89.09.26.16.28.14;  author dew;  state Exp;
branches ;
next     38.1;

38.1
date     89.08.29.11.18.58;  author jwh;  state Exp;
branches ;
next     37.1;

37.1
date     89.05.12.11.32.19;  author dew;  state Exp;
branches ;
next     36.1;

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

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

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

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

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

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

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

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

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

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

26.1
date     88.09.28.12.37.32;  author bayes;  state Exp;
branches ;
next     25.1;

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

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

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

22.1
date     87.08.17.10.45.30;  author bayes;  state Exp;
branches ;
next     21.2;

21.2
date     87.08.13.17.44.35;  author bayes;  state Exp;
branches ;
next     21.1;

21.1
date     87.08.12.13.31.55;  author bayes;  state Exp;
branches ;
next     20.2;

20.2
date     87.08.07.15.57.39;  author bayes;  state Exp;
branches ;
next     20.1;

20.1
date     87.07.30.10.43.50;  author bayes;  state Exp;
branches ;
next     19.2;

19.2
date     87.06.02.10.54.49;  author bayes;  state Exp;
branches ;
next     19.1;

19.1
date     87.06.01.08.01.31;  author jws;  state Exp;
branches ;
next     18.2;

18.2
date     87.05.26.15.32.22;  author bayes;  state Exp;
branches ;
next     18.1;

18.1
date     87.05.20.14.56.43;  author bayes;  state Exp;
branches ;
next     17.3;

17.3
date     87.05.14.15.34.01;  author bayes;  state Exp;
branches ;
next     17.2;

17.2
date     87.05.01.15.10.34;  author bayes;  state Exp;
branches ;
next     17.1;

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

16.1
date     87.04.26.15.26.44;  author jws;  state Exp;
branches ;
next     15.2;

15.2
date     87.04.15.14.07.11;  author bayes;  state Exp;
branches ;
next     15.1;

15.1
date     87.04.13.08.55.51;  author jws;  state Exp;
branches ;
next     14.2;

14.2
date     87.04.08.09.25.49;  author jws;  state Exp;
branches ;
next     14.1;

14.1
date     87.04.01.14.54.36;  author jws;  state Exp;
branches ;
next     13.2;

13.2
date     87.03.23.16.17.23;  author bayes;  state Exp;
branches ;
next     13.1;

13.1
date     87.02.28.18.14.14;  author jws;  state Exp;
branches ;
next     12.2;

12.2
date     87.02.24.16.25.20;  author bayes;  state Exp;
branches ;
next     12.1;

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

11.1
date     87.01.19.09.28.04;  author jws;  state Exp;
branches ;
next     10.4;

10.4
date     87.01.16.12.19.38;  author jws;  state Exp;
branches ;
next     10.3;

10.3
date     87.01.16.09.54.46;  author jws;  state Exp;
branches ;
next     10.2;

10.2
date     87.01.16.09.48.52;  author jws;  state Exp;
branches ;
next     10.1;

10.1
date     86.12.24.10.35.06;  author jws;  state Exp;
branches ;
next     9.2;

9.2
date     86.12.19.09.21.34;  author jws;  state Exp;
branches ;
next     9.1;

9.1
date     86.12.12.14.02.10;  author bayes;  state Exp;
branches ;
next     8.4;

8.4
date     86.12.08.19.05.39;  author jws;  state Exp;
branches ;
next     8.3;

8.3
date     86.12.04.16.04.51;  author jws;  state Exp;
branches ;
next     8.2;

8.2
date     86.12.04.15.58.27;  author jws;  state Exp;
branches ;
next     8.1;

8.1
date     86.11.27.11.32.24;  author jws;  state Exp;
branches ;
next     7.2;

7.2
date     86.11.21.15.21.42;  author hal;  state Exp;
branches ;
next     7.1;

7.1
date     86.11.20.13.21.04;  author hal;  state Exp;
branches ;
next     6.2;

6.2
date     86.11.06.12.40.49;  author hal;  state Exp;
branches ;
next     6.1;

6.1
date     86.11.04.17.25.29;  author paws;  state Exp;
branches ;
next     5.3;

5.3
date     86.10.31.14.09.35;  author hal;  state Exp;
branches ;
next     5.2;

5.2
date     86.10.29.13.04.08;  author hal;  state Exp;
branches ;
next     5.1;

5.1
date     86.10.28.16.09.46;  author hal;  state Exp;
branches ;
next     4.4;

4.4
date     86.10.20.14.45.03;  author hal;  state Exp;
branches ;
next     4.3;

4.3
date     86.10.09.13.13.16;  author hal;  state Exp;
branches ;
next     4.2;

4.2
date     86.10.08.10.07.44;  author hal;  state Exp;
branches ;
next     4.1;

4.1
date     86.09.30.19.24.40;  author hal;  state Exp;
branches ;
next     3.4;

3.4
date     86.09.16.15.18.20;  author hal;  state Exp;
branches ;
next     3.3;

3.3
date     86.09.13.13.28.57;  author hal;  state Exp;
branches ;
next     3.2;

3.2
date     86.09.04.17.45.17;  author hal;  state Exp;
branches ;
next     3.1;

3.1
date     86.09.01.11.34.19;  author hal;  state Exp;
branches ;
next     2.15;

2.15
date     86.08.27.12.32.03;  author hal;  state Exp;
branches ;
next     2.14;

2.14
date     86.08.26.16.29.30;  author hal;  state Exp;
branches ;
next     2.13;

2.13
date     86.08.25.10.59.26;  author hal;  state Exp;
branches ;
next     2.12;

2.12
date     86.08.25.10.23.01;  author hal;  state Exp;
branches ;
next     2.11;

2.11
date     86.08.25.10.10.24;  author hal;  state Exp;
branches ;
next     2.10;

2.10
date     86.08.20.16.11.16;  author hal;  state Exp;
branches ;
next     2.9;

2.9
date     86.08.19.15.22.52;  author hal;  state Exp;
branches ;
next     2.8;

2.8
date     86.08.19.13.58.08;  author geli;  state Exp;
branches ;
next     2.7;

2.7
date     86.08.19.11.41.11;  author danm;  state Exp;
branches ;
next     2.6;

2.6
date     86.08.18.12.37.07;  author hal;  state Exp;
branches ;
next     2.5;

2.5
date     86.08.15.16.09.08;  author geli;  state Exp;
branches ;
next     2.4;

2.4
date     86.08.15.11.01.00;  author geli;  state Exp;
branches ;
next     2.3;

2.3
date     86.07.31.16.12.00;  author geli;  state Exp;
branches ;
next     2.2;

2.2
date     86.07.30.18.16.02;  author hal;  state Exp;
branches ;
next     2.1;

2.1
date     86.07.30.14.25.10;  author hal;  state Exp;
branches ;
next     1.45;

1.45
date     86.07.29.12.48.40;  author hal;  state Exp;
branches ;
next     1.44;

1.44
date     86.07.28.18.19.53;  author hal;  state Exp;
branches ;
next     1.43;

1.43
date     86.07.28.17.44.16;  author hal;  state Exp;
branches ;
next     1.42;

1.42
date     86.07.28.16.40.14;  author hal;  state Exp;
branches ;
next     1.41;

1.41
date     86.07.28.16.16.13;  author geli;  state Exp;
branches ;
next     1.40;

1.40
date     86.07.28.15.54.08;  author geli;  state Exp;
branches ;
next     1.39;

1.39
date     86.07.28.08.56.59;  author hal;  state Exp;
branches ;
next     1.38;

1.38
date     86.07.22.16.26.32;  author hal;  state Exp;
branches ;
next     1.37;

1.37
date     86.07.21.17.03.20;  author hal;  state Exp;
branches ;
next     1.36;

1.36
date     86.07.18.14.32.20;  author hal;  state Exp;
branches ;
next     1.35;

1.35
date     86.07.17.17.29.31;  author hal;  state Exp;
branches ;
next     1.34;

1.34
date     86.07.17.08.39.57;  author hal;  state Exp;
branches ;
next     1.33;

1.33
date     86.07.16.12.49.12;  author hal;  state Exp;
branches ;
next     1.32;

1.32
date     86.07.16.12.28.21;  author hal;  state Exp;
branches ;
next     1.31;

1.31
date     86.07.16.10.45.42;  author hal;  state Exp;
branches ;
next     1.30;

1.30
date     86.07.15.17.03.52;  author geli;  state Exp;
branches ;
next     1.29;

1.29
date     86.07.14.13.38.55;  author hal;  state Exp;
branches ;
next     1.28;

1.28
date     86.07.14.12.50.19;  author geli;  state Exp;
branches ;
next     1.27;

1.27
date     86.07.14.11.13.56;  author geli;  state Exp;
branches ;
next     1.26;

1.26
date     86.07.14.10.49.52;  author geli;  state Exp;
branches ;
next     1.25;

1.25
date     86.07.14.09.05.47;  author hal;  state Exp;
branches ;
next     1.24;

1.24
date     86.07.11.15.11.46;  author hal;  state Exp;
branches ;
next     1.23;

1.23
date     86.07.11.14.42.44;  author hal;  state Exp;
branches ;
next     1.22;

1.22
date     86.07.09.10.05.29;  author geli;  state Exp;
branches ;
next     1.21;

1.21
date     86.07.09.09.40.23;  author geli;  state Exp;
branches ;
next     1.20;

1.20
date     86.07.09.08.38.59;  author hal;  state Exp;
branches ;
next     1.19;

1.19
date     86.07.08.19.35.53;  author hal;  state Exp;
branches ;
next     1.18;

1.18
date     86.07.08.19.19.15;  author hal;  state Exp;
branches ;
next     1.17;

1.17
date     86.07.08.19.09.23;  author hal;  state Exp;
branches ;
next     1.16;

1.16
date     86.07.08.15.57.07;  author geli;  state Exp;
branches ;
next     1.15;

1.15
date     86.07.08.13.36.29;  author hal;  state Exp;
branches ;
next     1.14;

1.14
date     86.07.08.09.02.26;  author hal;  state Exp;
branches ;
next     1.13;

1.13
date     86.07.08.08.57.24;  author hal;  state Exp;
branches ;
next     1.12;

1.12
date     86.07.04.12.53.48;  author hal;  state Exp;
branches ;
next     1.11;

1.11
date     86.07.04.11.32.03;  author hal;  state Exp;
branches ;
next     1.10;

1.10
date     86.07.04.09.36.47;  author bayes;  state Exp;
branches ;
next     1.9;

1.9
date     86.07.03.11.32.11;  author danm;  state Exp;
branches ;
next     1.8;

1.8
date     86.07.01.10.53.39;  author danm;  state Exp;
branches ;
next     1.7;

1.7
date     86.06.16.09.01.28;  author danm;  state Exp;
branches ;
next     1.6;

1.6
date     86.06.12.14.47.47;  author danm;  state Exp;
branches ;
next     1.5;

1.5
date     86.06.12.09.41.22;  author danm;  state Exp;
branches ;
next     1.4;

1.4
date     86.06.06.18.27.27;  author danm;  state Exp;
branches ;
next     1.3;

1.3
date     86.06.06.13.40.39;  author danm;  state Exp;
branches ;
next     1.2;

1.2
date     86.06.05.16.17.54;  author danm;  state Exp;
branches ;
next     1.1;

1.1
date     86.06.04.08.43.08;  author geli;  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
@$modcal$

$linenum 1000$
$lines 54$

$partial_eval on$
$allow_packed on$

$range off$
$ovflcheck off$
$debug off$


program hfs_dam_init(input, output);

module hfs_dam_module;


$search 'hfs'$
import
    hfstuff,
    hfsupport,
    hfsalloc,
    hfscalc,
    hfscache,
    iocomasm,
    sysglobals,
    sysdevs,
    misc,
    asm;

export

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

implement

const
    debug = false;

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

label
    1;

$include 'wsheader'$

type
    string20 = string[20];
    string3  = string[3];

const
    { MUST have superblock }
    needs_superblock = [setvolumename,
			changename,
			purgename,
			openfile,
			createfile,
			overwritefile,
			purgefile,
			stretchit,
			opendirectory,
			catalog,
			setunitprefix,
			duplicatelink,
			openparentdir,
			getvolumedate,
			setvolumedate,
			catpasswords,
			setpasswords];

      { wants superblock, but could do without it }
      wants_superblock = [closefile,
			  makedirectory];

      { default modes for creating files and directories }
      file_mode = octal('666');
      dir_mode  = octal('777');

  var
      superblock: super_block_ptr_type;
      junkdiroff: integer;

$include 'wsbody'$

{-------------------------------------------------------------}
{
{ get_wsheader
{ Read the ws hdr from the beginning of a file.
{ We just read the bytes, then call read_wsheader to interpret them.
{ Don't care if hdr not there.
}
procedure get_wsheader(inodep: inode_ptr_type;
		       var fileinfo: fileinfotype);
label
    999;
type
    eftheaderbuftype = packed array[0..wshdr_size-1] of char;
var
    headerbuf: eftheaderbuftype;
    bn: integer;
begin
$if debug$
    xreport('GET_WSHEADER');
$end$
    if inodep^.size.ls >= wshdr_size then begin
	bn := get_dbnum(inodep, 0, B_READ, wshdr_size);
	if (bn = BMAP_HOLE) or (bn = BMAP_ERROR) then
	    goto 999;
	get_bytes(f.funit, wshdr_size, data_start(superblock, bn),
		  addr(headerbuf));
	if read_wsheader(addr(headerbuf), fileinfo) then
	    ;
    end;
999:
end;

{--------------------------------------------------------------------------}
{
{ put_wsheader
{ given an inode and a fileinfo block, make a ws hdr and
{ write it to the given file.
{ Added protection against writing a wsheader to a corrupt file system.
{ Other writes are protected in hfstm, or by higher level caller. SFB
}
procedure put_wsheader(inodep: inode_ptr_type;
		       var fileinfo: fileinfotype);
label
    999;
type
    eftheaderbuftype = packed array[0..wshdr_size-1] of char;
var
    headerbuf: eftheaderbuftype;
    bn: integer;
begin
    if h_unitable^.tbl[h_unitable^.tbl[f.funit].base_unum].fs_corrupt then {SFB}
     begin
      ioresult := ord(icorrupt);
      goto 999;
     end;
    makews_header(addr(headerbuf), fileinfo);
    bn := get_dbnum(inodep, 0, B_WRITE, wshdr_size);
    if bn = BMAP_ERROR then
	goto 999;
    put_bytes(f.funit, wshdr_size, data_start(superblock, bn),
	      addr(headerbuf));
999:
end;

{------------------------------------------------------------------------}
{
{ bytes_claimed
{ tell how many bytes are claimed by an inode with this size
}
function bytes_claimed(size: integer): integer;
begin
    if lblkno(superblock, size) < NDADDR then
	bytes_claimed := roundup(size, superblock^.fsize)
    else
	bytes_claimed := roundup(size, superblock^.bsize)
end;

{--------------------------------------------------------------------}
{
{ create_ok
{ see if it's ok to create this file in this dir
{ parent_ip must be writeable directory
{ filename must not exist
{ true -> no problem
{ else ioresult already set
{ returns directory offset for use in creation
}
function create_ok(pdir: inode_ptr_type;
		   var fname: string255;
		   var diroff: integer): boolean;
var
    pathinfo: pathinfotype;
begin
    if itype(pdir) <> IFDIR then
	ioresult := ord(ifilenotdir)
    else
    if not permission(pdir, w_permission+x_permission) then
	{ ioresult already set to inopermission }
    else
    if foundname(fname, false, pdir, pathinfo) then
	ioresult := ord(idupfile);

    if ioresult = ord(inoerror) then begin
	create_ok := true;
	diroff := pathinfo.diroff;
    end
    else
	create_ok := false;
end;

{--------------------------------------------------------------------}
{
{ getfileinfo
{ takes inode
{ fills in fileinfo block describing the file
{ shortcut tells whether to skip reading the wsheader,
{ which makes file look like UX file, but is faster (short listings).
{ Note that filesize can be "wrong" (counts ws hdr size) if
{ shortcut is true.
}
procedure getfileinfo(inodep: inode_ptr_type;
		      var fileinfo: fileinfotype;
		      shortcut: boolean);
const
     hpux_fileinfo = fileinfotype [
	ikind        : untypedfile,  {reset according to inode}
	ieft         : 0,            {reset according to inode}
	ioffset      : 0,            {reset if LIFheader}
	ilogicalsize : 0,            {reset according to inode or LIFheader}
	istartaddress: 0             {reset if LIFheader}
	];
var
    iftype: integer;
begin
    { set up assuming shortcut true }
    fileinfo := hpux_fileinfo;
    iftype := itype(inodep);

    with fileinfo do begin
	ilogicalsize := inodep^.size.ls;

	if iftype = IFREG then begin
	    { HP-UX "regular" file }
	    ikind := uxfile;
	    ieft := uxfile_eft;
	    if not shortcut then
		{ LIF info requested, so read LIFheader if it's there }
		get_wsheader(inodep, fileinfo);
	end
	else
	if iftype = IFDIR then begin
	    { directory }
	    ieft   := 3;
	    ikind  := untypedfile;
	end
	else
	    { special file (fifo, char/block, etc) }
	    ikind := uxfile;
    end;
end;

{-----------------------------------------------------------------}
{
{ Find the starting inode for a relative path.  The bizarre rules,
{ deduced from the FILER (see the change name sequence, e.g.) are:
{ 1) if the FIB is open (pathid <> no_inode),
{            then start at that pathid
{ 2) if the FIB is closed,
{            then start at the unit prefix
}
function start_path: integer;
begin
    with f do
	if pathid = no_inode then
	    start_path := h_unitable^.tbl[funit].prefix
	else
	    start_path := pathid;
end;

{-------------------------------------------------------------------}
{
{ check for a good file name
{ cannot be too long for dir entry
{ cannot contain null or /
}
procedure good_file_name(var fname: string255);
begin
    if (strlen(fname) > MAXNAMLEN)
    or (strpos(#0, fname) <> 0)
    or (strpos('/', fname) <> 0) then begin
$if debug$
	xreport('good_file_name sees bad title');
$end$
	ioresult := ord(ibadtitle);
	escape(0);      {Because disc is not corrupt in this case. SFB}
    end;
end;

{-----------------------------------------------------------------------}
{
{ FOUNDINO
{ find inumber in directory pdir
{ returns true if found
{         name of file
}
function foundino(inumber: integer;
		  pdir: inode_ptr_type;
		  var name: string): boolean;
{--------------------}
procedure check_entry(dp: direntry_ptr_type;
		      offset: integer;
		      anyvar inumber: integer;
		      anyvar iname: string255;
		      var keep_going: boolean);
begin
    with dp^ do
	{ is this the entry we want? }
	if ino = inumber then begin
	    pac_to_string(name, namlen, iname);
	    keep_going := false;
	end;
end;
{--------------------}
begin {foundino}

    name := '';
    scan_dir(pdir, check_entry, inumber, name);

    foundino := (name <> '');

end;

{------------------------------------------------------------------------}
{
{ rootname
{ return the name of the root directory, which is
{ the volume name when the prefix is /.
{ We use the fname superblock field, unless it's null,
{ in which case we use 'hfs' + the unit number.
}
function rootname: vid;
const
    nilname = fs_name_type[#0#0#0#0#0#0];
var
    tempname: string[fs_name_len];
    i: integer;
begin
    with superblock^ do
	if fname = nilname then begin
	    setstrlen(tempname, 0);
	    strwrite(tempname, 1, i, 'hfs', h_unitable^.tbl[unum].base_unum:1);
	end
	else begin
	    setstrlen(tempname, fs_name_len);
	    i := 1;
	    while (i <= fs_name_len) and (fname[i-1] <> #0) do begin
		tempname[i] := fname[i-1];
		i := i + 1;
	    end;
	    setstrlen(tempname, i-1);
	end;
    rootname := tempname;
end;

{--------------------------------------------------------------}
{
{ Return inumber of parent
}
function parent_inode(inodep: inode_ptr_type): integer;
var
    dotdot: string[2];
    pathinfo: pathinfotype;
begin
$if debug$
    xreport('PARENT_INODE');
$end$
    dotdot := '..';
    if foundname(dotdot, true, inodep, pathinfo) then
	parent_inode := pathinfo.ino
    else begin
$if debug$
	xreport('parent_inode failed');
$end$
	ioresult := ord(ilostfile);
	escape(-10);    {Because we think disc must be corrupt. SFB}
    end;
end;



{-------------------------------------------------------------------}
{
{ dotname, dotdotname
{ return name of . or .. in given directory
{ also sets parent_ino if known, since we usually have it anyway
}
function dotname(inodep : inode_ptr_type;
		 var parent_ino: integer): string255;
var
    tempname     : string255;
    dotdotinode  : integer;
    dotdotinodep : inode_ptr_type;
    inodenum: integer;
begin
    inodenum := inumber(inodep);
    if inodenum = root_inode then begin
	 dotname := rootname;
	 parent_ino := root_inode;
    end
    else
    if inodenum = h_unitable^.tbl[unum].prefix then
	dotname := unitable^[unum].uvid
    else begin
$if debug$
	xreport('DOTNAME');
$end$
	{ no shortcut possible; must look through dirs }
	dotdotinode  := parent_inode(inodep);
	dotdotinodep := get_inode(dotdotinode);
	if foundino(inodenum, dotdotinodep, tempname) then begin
	    dotname := tempname;
	    parent_ino := dotdotinode;
	end
	else begin
$if debug$
	    xreport('dot not found');
$end$
	    ioresult := ord(ilostfile);
	    escape(-10);    {Because we think disc must be corrupt. SFB}
	end;
	put_inode(dotdotinodep, [release]);
    end;
end;

function dotdotname(inodep: inode_ptr_type;
		    var parent_ino: integer): string255;
var
    dotdotinodep: inode_ptr_type;
begin
    dotdotinodep := get_inode(parent_inode(inodep));
    dotdotname := dotname(dotdotinodep, parent_ino);
    put_inode(dotdotinodep, [release]);
end;


{-----------------------------------------------------------------------}
{
{ traverse_path
{ traverses a pathname to find named file
{ inodep is
{       on INPUT, where to start if pathname is relative
{       on OUTPUT, ptr to last inode found in path
{ dir_required means last cmpnt should be ignored if it's not a dir;
{       this is set by opendirectory and openparentdir.
{ returns bool showing success
{ gives extra info in pathinfo
{       ino -- inumber of inodep
{       diroff -- offset in directory of name found,
{                 or of free slot if name not found.
{                 "free slot" is one with ino 0, or one with
{                 reclen > entry size, or size of dir file if
{                 dir full.  Used by allocator routines.
{       basename -- name of file if found, or rest of path if not found.
{       parent_ino -- parent of file in inode_ptr.
{ The peculiar semantics (give back lots of info on "failure")
{ are due to FILER usage; it can pass wildcards as last component,
{ and thus we are expected to "fail", but give back enough info anyway.
{ Warning: callers check for ioresult = inofile and basename has no
{ slashes to detect case where all but last component is there.
}
function traverse_path(var path: string;
		       dir_required: boolean;
		       var inodep: inode_ptr_type;
		       var pathinfo: pathinfotype): boolean;
var
    atom     : string255;
    slashpos : shortint;
    inodenum : integer;
    oldatom, oldpath: string255;
    tmpioresult: integer;

{----------------------------}
{
{ Put next component of path into atom,
{ and update path.
}
procedure nextcmpnt;
var
    i: integer;
begin
    setstrlen(atom, 255);
    i := 1;
    { copy to initial / }
    while (i <= strlen(path)) and (path[i] <> '/') do begin
	atom[i] := path[i];
	i := i + 1;
    end;
    setstrlen(atom, i-1);

    { skip next /s }
    while (i <= strlen(path)) and (path[i] = '/') do
	i := i + 1;

    { put remainder into path }
    if i <= strlen(path) then
	path := str(path, i, strlen(path)-i+1)
    else
	path := '';
end;
{----------------------------}
begin {traverse_path}
$if debug$
    report('traverse_path ' + path);
$end$

    pathinfo.parent_ino := no_inode;

    { if path begins /, start at root inode, else start at inodep }
    if strpos('/', path) = 1 then begin
	put_inode(inodep, [release]);
	inodep := get_inode(root_inode);
	pathinfo.parent_ino := root_inode;
	{ lop off initial /s from path }
	repeat
	    path := str(path, 2, strlen(path)-1);
	    slashpos := strpos('/', path);
	until slashpos <> 1;
    end;

    pathinfo.ino := inumber(inodep);

    oldatom := '';
    oldpath := path;
    nextcmpnt;
    while (ioresult = ord(inoerror)) and (atom <> '') do begin
	{ check for dir type now to avoid permission error on non-dir }
	if itype(inodep) <> IFDIR then
	    ioresult := ord(ifilenotdir)
	else
	if permission(inodep, x_permission)
	and foundname(atom, dir_required and (path = ''),
		      inodep, pathinfo) then begin
	    { found, so move to next atom of path }
	    put_inode(inodep, [release]);
	    inodep := get_inode(pathinfo.ino);
	    oldatom := atom;
	    oldpath := path;
	    nextcmpnt;
	end
	else
	if ioresult = ord(inoerror) then
	    ioresult := ord(inofile);
    end;

    if oldpath <> '' then begin
	{ path not exhausted, so failed }
	pathinfo.basename := oldpath;
	traverse_path := false;
    end
    else begin
	{ success; make basename look reasonable }
	if (oldatom = '') or (oldatom = '.') then
	    pathinfo.basename := dotname(inodep, pathinfo.parent_ino)
	else
	if oldatom = '..' then begin
	    { parent inumber never correct in this case }
	    pathinfo.parent_ino := no_inode;
	    pathinfo.basename := dotname(inodep, pathinfo.parent_ino)
	end
	else
	    pathinfo.basename := oldatom;
	traverse_path := true;
    end;

    {
    { if no one has set parent_ino yet, do it explicitly
    { optimization: parent_ino already set if traverse_path
    { succeeded.  If it failed, then ONLY opendirectory and
    { openparentdir care about its value.
    }
    if (pathinfo.parent_ino = no_inode)
    and (request in [opendirectory, openparentdir]) then begin
	{ save ioresult so parent_inode will work }
	tmpioresult := ioresult;
	ioresult := ord(inoerror);
	pathinfo.parent_ino := parent_inode(inodep);
	if ioresult = ord(inoerror) then
	    ioresult := tmpioresult;
    end;

$if debug$
    reportn('traverse path ioresult', ioresult);
$end$
end;

{----------------------------------------------------------------------------}
{
{ We have a successful open/create of file ino.
{ Set up fib fields from fileinfo with info about this file.
{ pathid -- inumber of file
{ foldfileid -- parent inumber
{ fileid -- size of ws hdr (0 if not there)
{ fleof -- 0 if new, size of file if old
{ ftitle -- simple name of file
{ ftid + ffpw -- simple name of file (from ftitle)
{ feft
{ fkind
{ fmodified
{ fstartaddress
{ am
}
procedure finishfib(inodep: inode_ptr_type;
		    parent_ino: integer;
		    var name: string255;
		    var fileinfo: fileinfotype);
begin
    with f do begin
       {see LIFDAM finishfib to see where this was modified from}

       pathid := inumber(inodep);
       foldfileid := parent_ino;
       fmodified := fisnew;

       with fileinfo do begin
	   fileid        := ioffset;
	   feft          := ieft;
	   fkind         := ikind;
	   fstartaddress := istartaddress;
	   if fisnew then
	       fleof     := 0
	   else
	       fleof     := ilogicalsize;
       end;

       ftitle := name;
       if strlen(ftitle) <= tidleng then begin
	   ftid := ftitle;
	   ffpw := '';
       end
       else
       if strlen(ftitle) <= tidleng + passleng then begin
	   ftid := str(ftitle, 1, tidleng);
	   ffpw := str(ftitle, tidleng + 1, strlen(ftitle) - tidleng);
       end
       else begin
$if debug$
	   xreport('finishfib sees name too long');
$end$
	   ioresult := ord(ibadtitle);
	   escape(0);   {Because disc is not corrupt in this case. SFB}
       end;

       if not fbuffered then
	   am := amtable^[untypedfile]
       else
       if fistextvar then
	   am := amtable^[fkind]         {textfib}
       else
	   am := amtable^[datafile];      {not textfib}
    end;
end;


{------------------------------------------------------------------}
{
{ close_fib
{ resets fib values to show file now closed
{ Warning: FILER looks at fpeof AFTER closing fib.  Therefore, we
{ are conservative about resetting fields.
}
procedure close_fib;
begin
    with f do begin
	pathid := no_inode;
	freadable  := false;
	fwriteable := false;
	fmodified  := false;
	fisnew     := false;
    end;
end;

{--------------------------------------------------------------------------}
{
{ zerotimedate
{ set time and date to 1-MAR-0 0:0:0-- the "invalid" time and date
}
procedure zerotimedate(var time: timerec; var date: daterec);
begin
    with time, date do begin
	year        := 0;
	day         := 1;
	month       := 3;
	hour        := 0;
	minute      := 0;
	centisecond := 0;
    end;
end;

{------------------------------------------------------------------------}
{
{ convert a time_t to PWS timerec and daterec
}
procedure hfs_to_PWS_timedate(hfstime: integer;
			      var time: timerec; var date: daterec);
begin
    secs_to_timedate(hfstime - timezone, date, time);
end;


{-----------------------------------------------------------------------}
{
{ octalmode
{ convert a decimal number to a 0-padded 3-digit octal number
}
function octalmode(decmode: integer): string3;
var
    str: string3;
    i: integer;
begin
    setstrlen(str, 3);
    for i := 3 downto 1 do begin
	str[i] := chr(ord('0') + binand(decmode, 7));
	decmode := binlsr(decmode, 3);
    end;
    octalmode := str;
end;

{-------------------------------------------------------------------}
{
{ make_statrec
{ put a stat record into the given cinfo.
{ since the cinfo is really a string, we zero the string length
}
procedure make_statrec(ip: inode_ptr_type; anyvar info: string20);
type
    cinfo_statrec = packed record
	pad         : shortint;
	c_mode      : ushort;
	c_uid       : ushort;
	c_gid       : ushort;
	c_rdev      : integer;
	c_atime     : integer;
	c_ctime     : integer;
    end;
    cinfo_statrecp = ^cinfo_statrec;
var
    t: integer;
begin
    setstrlen(info,0);
    with cinfo_statrecp(addr(info))^, ip^ do begin
	c_mode  := mode;
	c_uid   := uid;
	c_gid   := gid;

	t := itype(ip);
	if (t = IFBLK) or (t = IFCHR) then
	    c_rdev  := db[0]  { maj/min device number }
	else
	    c_rdev := 0;

	c_atime := atime;
	c_ctime := ctime;
    end;
end;

{----------------------------------------------------------------------}
{
{ fill_entry
{ given a catrec and a name + inode ptr
{ fills in the catrec with info about the given file
{ shortcut tells whether to skip reading the ws header
}
procedure fill_entry(var cat: catentry;
		     var thisname: string255;
		     ino: integer;
		     shortcut: boolean;
		     dostatrec: boolean);
label
    999;
type
    filetypechartype = packed array [0..15] of char;
const
    filetypechar = filetypechartype['-pc-d-b- nl-s---'];
    {
    { filetypechar meanings
    {   - undefined
    {   p pipe
    {   c character special
    {   d directory
    {   b block special
    {     (space) regular data file
    {   n network special file
    {   l symbolic link fie
    {   s socket
    }
var
    i, pos: integer;
    fileinfo: fileinfotype;
    ip: inode_ptr_type;
begin
    with cat, superblock^ do begin

	if strlen(thisname) <= tidleng then
	    cname := thisname
	else
	    cname := str(thisname,1,tidleng);

	if shortcut then
	    goto 999;

	ip := get_inode(ino);

	getfileinfo(ip, fileinfo, shortcut);

	{ external file type }
	ceft := fileinfo.ieft;
	{ file kind }
	ckind := fileinfo.ikind;
	{ physical size }
	cpsize := bytes_claimed(ip^.size.ls);
	{ logical size }
	clsize := fileinfo.ilogicalsize;

	cblocksize := fsize;

	zerotimedate(ccreatetime, ccreatedate);
	hfs_to_PWS_timedate(ip^.mtime, clasttime, clastdate);

	{ number of links }
	cextra1 := ip^.nlink;

      { cextra2 := -1;  {removed in 3.2G SFB}
	with fileinfo do
	 if ieft = datafile_eft then  {added in 3.2G;
	     report LIFimplement for all but .UX files, dirs (ieft=3), and
	     special files (ieft=0). SFB}
	  cextra2 := ilogicalsize
	 else
	  if (ieft <> uxfile_eft) and (ieft <> 0) and (ieft <> 3) then
	   cextra2 := istartaddress
	  else
	   cextra2 := -1;

	if dostatrec then begin
	    cstart := inumber(ip);
	    make_statrec(ip, cinfo);
	end
	else begin
	    {
	    { cstart -- "starting address" on disk
	    { FILER will divide by cblocksize, printing inumber
	    }
	    cstart := inumber(ip) * fsize;

	    {
	    { use 19 chars of 20-char cinfo
	    {         1234567890123456789
	    {         TMMMm UUUUUu GGGGGg
	    { T - filetype char
	    { MMM - octal file mode
	    { UUUUU - uid
	    { GGGGG - gid
	    }
	    i := binlsr(itype(ip), 12);
	    setstrlen(cinfo, 0);
	    strwrite(cinfo, 1, pos,
		     filetypechar[i]:1,
		     octalmode(ip^.mode),
		     'm ',
		     ip^.uid:5,
		     'u ',
		     ip^.gid:5,
		     'g');
	end;
	put_inode(ip, [release]);
    end;
999:
end;

{----------------------------------------------------------------------}
{
{ DOCATALOG
{ get catalog info from files in directory
{ fib is open to the directory (via opendirectory)
{       fwindow -- ptr to an array of catentries
{       fpeof -- how many cat entries are there (0..fpeof-1)
{       fpos -- where in directory to start (0-based)
{       fb0 -- false -> full info, true -> short info
{       fb1 -- false -> cinfo is string, true -> cinfo is statrec
{ returns
{       filled cat entries
{       fpeof -- number of entries filled
}
procedure docatalog;
label
    999;
type
    inrec_type = record
	fp: fibp;
	entry: integer;
    end;
var
    inrec: inrec_type;
    numdone: integer;
    pdir: inode_ptr_type;
    oldior: integer;    {for "protecting" ioresult during cleanup. SFB}
{----------------------------}
{
{ find_entry, the scanner for do_catalog
{ looks at dir entry and decides whether to catalog it, and where
{ calls fill_entry to do the cataloging
{ inrec.entry is the number (0-based) of this dir entry
}
procedure find_entry(dp: direntry_ptr_type;
		     offset: integer;
		     anyvar inrec: inrec_type;
		     anyvar numdone: integer;
		     var keep_going: boolean);
label
    999;
type
    catarray = array[0..maxint] of catentry;
    catarray_ptr_type = ^catarray;
var
    thisname: string255;
    catarr: catarray_ptr_type;
    index: integer;
begin
    with dp^ do begin
	{ ino 0 means slot not used }
	if ino = 0 then
	    goto 999;

	{ . and .. don't count }
	pac_to_string(name, namlen, thisname);

	if (thisname = '.') or (thisname = '..') then
	    goto 999;

	with inrec, fp^ do begin
	    { in requested region of directory? }
	    if entry >= fpos then begin
		index := entry - fpos;
		{ cat entry already full? }
		if index >= fpeof then begin
		    keep_going := false;
		    goto 999;
		end;
		catarr := catarray_ptr_type(fwindow);
		fill_entry(catarr^[index], thisname, ino, fb0, fb1);
		numdone := numdone + 1;
	    end;
	    entry := entry + 1;
	end;
    end;
999:
end;
{----------------------------}
begin {docatalog}
    { check input directory }
    if (f.pathid = no_inode) or (f.pathid = raw_inode) then begin
	ioresult := ord(ifilenotdir);
	goto 999;
    end;
    pdir := get_inode(f.pathid);
    if itype(pdir) <> IFDIR then begin
	ioresult := ord(ifilenotdir);
	goto 999;
    end;
    if not permission(pdir, r_permission) then
	goto 999;

    with inrec do begin
	entry := 0;
	fp := addr(f);
    end;
    numdone := 0;

    scan_dir(pdir, find_entry, inrec, numdone);
999:
    f.fpeof := numdone;
    oldior:=ioresult;   {SFB}
    put_inode(pdir, [release]);
    if ioresult=ord(inoerror) then      {SFB}
     ioresult:=oldior;
end;

{----------------------------------------------------------------------}
{
{ open a directory
{ and write dir info into cat
{ openparent true -> open parent of given dir
{ input
{       ftitle -- dir name
{       fb1 -- true if statrec wanted, else false
{ ftitle might include a filename at the end, in which case we
{ open the directory containing the file.
{ results
{       ftitle -- the path after the directory opened
{         e.g.  opendir dir1/dir2 -> ''
{               openparentdir dir1/dir2 -> 'dir2'
{               opendir dir1/file2 -> 'file2'
{       ftid -- simple name of dir opened
}
procedure doopendirectory(anyvar cat: catentry; openparent: boolean);
label
    999;
var
    dname: string255;
    pos: integer;
    dir_ip: inode_ptr_type;
    newtitle: string255;
    pathinfo: pathinfotype;
    fileinfo: fileinfotype;
    avail : integer; {for cextra2 calculation SFB}
    oldior: integer;    {for "protecting" ioresult during cleanup. SFB}
begin
    dir_ip := get_inode(start_path);
    dname := f.ftitle;

    {
    { find the directory to open
    { dir_ip -- dir to open
    { dname -- simple name of this dir
    { newtitle -- ftitle we will return (following rules above)
    }
    if traverse_path(dname, true, dir_ip, pathinfo) then begin
	newtitle := '';
	dname := pathinfo.basename;
    end
    else begin
	{ no error if last cmpnt missing }
	if ioresult <> ord(inofile) then
	    goto 999;
	if strpos('/', pathinfo.basename) <> 0 then
	    goto 999;
	ioresult := ord(inoerror);
	newtitle := pathinfo.basename;
	dname := dotname(dir_ip, pathinfo.parent_ino);
    end;
    if openparent then
	if inumber(dir_ip) = root_inode then
	    newtitle := ''
	else begin
	    newtitle := dname;
	    put_inode(dir_ip, [release]);
	    dir_ip := get_inode(pathinfo.parent_ino);
	    dname := dotname(dir_ip, pathinfo.parent_ino);
	end;
$if debug$
    reportn('opendir, title '+newtitle+' dname '+dname+' ino',
	    inumber(dir_ip));
$end$

    getfileinfo(dir_ip, fileinfo, true);
    { parent_ino can be wrong in case of openparent }
    finishfib(dir_ip, pathinfo.parent_ino, dname, fileinfo);

    { now load up the catalog fields }
    with f, superblock^, cat do begin
	cname       := dname;
	cblocksize  := fsize;
	clsize      := fsize*dsize;
      { with cstotal do {bugfix for 3.2G - compute available disc space SFB}
	  { cextra2    := fsize*(nbfree*frag + nffree); }
	with cstotal do {calculate avail bytes, accounting for minfree SFB}
	 begin {Do it the way 'freespace' in hfscalc does it. SFB}
	  avail := nbfree*frag + nffree - ((dsize*minfree) DIV 100);
	  if avail > 0 then
	   cextra2 := avail*fsize
	  else
	   cextra2 := 0;
	 end;
	zerotimedate(ccreatetime, ccreatedate);
	hfs_to_PWS_timedate(dir_ip^.mtime, clasttime, clastdate);
	if not fb1 then begin
	    { normal request -- no statrec }
	    cpsize      := ueovbytes(unum);
	    cstart      := -1;
	  { cextra1     := -1;  { removed for 3.2G - add "unallocated" SFB}
	    cextra1     := cstotal.nifree; {currently free inode count SFB}
	    setstrlen(cinfo, 0);
	    with dir_ip^ do
		{
		{ use 19 chars of cinfo string
		{ 1234567890123456789
		{ HFS MMM UUUUU GGGGG
		{ MMM - octal mode
		{ UUUUU - uid
		{ GGGGG - gid
		}
		strwrite(cinfo, 1, pos,
			 'HFS ',
			 octalmode(mode),
			 ' ',
			 uid:5,
			 ' ',
			 gid:5);
	end
	else
	with dir_ip^ do begin
	    { statrec requested }
	    cpsize := bytes_claimed(size.ls);
	    cstart := inumber(dir_ip);
	    cextra1 := nlink;
	    make_statrec(dir_ip, cinfo);
	end;
    end;
999:
    f.ftitle := newtitle;
    oldior:=ioresult;   {SFB}
    put_inode(dir_ip, [release]);
    if ioresult=ord(inoerror) then      {SFB}
     ioresult:=oldior;
end;


{-----------------------------------------------------------------------}
{
{ set the volume name
{ the "fib" parameter is really a string with the new name
{ to prevent fsck from saying the superblock is trashed, we must
{ set the fname field in the other copies of the superblock too.
}
procedure dosetvolname;
var
    requested_name: ^string255;
    volname: string[fs_name_len];
    cg, nameoffset: shortint;
    super_ptr: cache_blk_ptr_type;
{---------------}
procedure change_name(anyvar fname: fs_name_type);
var
    i: integer;
begin
    for i := 1 to strlen(volname) do
	fname[i-1] := volname[i];
    for i := strlen(volname)+1 to fs_name_len do
	fname[i-1] := #0;
end;
{---------------}
begin
    requested_name := addr(f);
    if h_unitable^.tbl[unum].prefix <> root_inode then
	ioresult := ord(inotclosed)
    else
    if strlen(requested_name^) <= fs_name_len then begin
	volname := requested_name^;

	{ first the real superblock }
	change_name(superblock^.fname);

	{ then the other copies }
	nameoffset := ord(addr(superblock^.fname)) - ord(superblock);
	for cg := 0 to superblock^.ncg-1 do begin
	    super_ptr := get_datablk(cgsblock(superblock, cg), nameoffset);
	    change_name(super_ptr^[nameoffset mod cache_blk_size]);
	    put_datablk(super_ptr, [dirty,release]);
	end;

	with unitable^[unum] do begin
	    if dkvid = uvid then
		dkvid := volname;
	    if syvid = uvid then
		syvid := volname;
	    uvid := volname;
	end;
    end
    else
	ioresult := ord(ibadtitle);
    put_superblock(superblock,[dirty]);
end;

{--------------------------------------------------------------------------}
{
{ setunitprefix
{ The fib is set up as for openfile or opendirectory.
{ We just use opendirectory to do the work.
}
procedure dosetunitprefix;
label 999;
var
    acatentry: catentry;
    dir_ip: inode_ptr_type;
    oldior: integer;    {for "protecting" ioresult during cleanup. SFB}
begin
    {Added code to disable prefixing on floppies. Need to do this to prevent
     "unreliable prefixing" caused by having dogetvolumename check umediavalid
     and popping prefix if it's false. The trouble is that various pieces of code
     (eg CI) clear umediavalid, even when the floppy has not been popped. SFB}

    dir_ip := nil;
    doopendirectory(acatentry, false);
    if ioresult = ord(inoerror) then begin
	if f.ftitle = '' then begin
	    dir_ip := get_inode(f.pathid);
	    if permission(dir_ip, x_permission) then
	      {stymie attempt to prefix floppy below its root. SFB}
	      if (not unitable^[unum].uisfixed) and (f.pathid <> root_inode) then
	       begin
		ioresult:=ord(ibadrequest);
		goto 999;
	       end
	      else
	       begin
		h_unitable^.tbl[unum].prefix := f.pathid;
		unitable^[unum].uvid := acatentry.cname;
	    end;
	    { if permission fails, ioresult already set to inopermission }
	end
	else
	    ioresult := ord(inofile);
    end;
999:oldior:=ioresult;   {SFB}
    put_inode(dir_ip, [release]);
    if ioresult=ord(inoerror) then      {SFB}
     ioresult:=oldior;
end;

{---------------------------------------------------------------------------}
{
{ makedirectory
{ fib is already open (via opendirectory) to parent directory.
{ fwindow -- a cat entry describing the dir (we use cname only)
}
procedure domakedir;
label
    999;
type
    catentryp = ^catentry;
var
    dirname : string255;
    parent_ip: inode_ptr_type;
    new_inodenum: integer;
    diroff: integer;
    oldior: integer;    {for "protecting" ioresult during cleanup. SFB}
begin
    with f do begin
	dirname := catentryp(fwindow)^.cname;
	good_file_name(dirname);
	parent_ip := get_inode(pathid);

	if not create_ok(parent_ip, dirname, diroff) then
	    goto 999;

	new_inodenum := create_dir(dirname, dir_mode, parent_ip, diroff);
    end;
999:
    oldior:=ioresult;   {SFB}
    put_inode(parent_ip, [release]);
    if ioresult=ord(inoerror) then      {SFB}
     ioresult:=oldior;
end;

{-------------------------------------------------------------------------}
{
{ docreate
{ create a new file
{ We always create a directoryless file, but remember its name
{ so that when it's closed we can make the dir entry.
{ This gets put into directory on close.
{ ftitle -- name of file to be created
}
procedure docreate;
label
    999;
var
    name: string255;
    start_inodep: inode_ptr_type;
    parent_ino: integer;
    pdir: inode_ptr_type;
    new_inodep: inode_ptr_type;
    pathinfo: pathinfotype;
    fileinfo: fileinfotype;

  {SFB fix for 00955, .ux file turns into wsheader file on preallocate}
    zapheader_buf : shortint;
    bn : integer;
    oldior: integer;    {for "protecting" ioresult during cleanup. SFB}

begin
    name := f.ftitle;
    pdir := nil;
    start_inodep := nil;
    new_inodep := nil;

    {
    { Find parent_ino and basename of file.
    { If anonymous, parent_ino is root_inode.
    { Be sure file exists and is writeable, or
    { parent exists and is writeable.
    }
    if f.fanonymous then begin
	pathinfo.basename := 'anonymous';
	pathinfo.parent_ino := root_inode;
    end
    else begin
	start_inodep := get_inode(start_path);
	if traverse_path(name, false, start_inodep, pathinfo) then begin
	    { file must be regular and writeable }
	    if itype(start_inodep) <> IFREG then begin
		ioresult := ord(inoaccess);
		goto 999;
	    end;
	    if not permission(start_inodep, w_permission) then
		goto 999;
	end
	else begin
	    { be sure all but last cmpnt in path exists }
	    if ioresult <> ord(inofile) then
		goto 999;
	    if strpos('/', pathinfo.basename) <> 0 then
		goto 999;
	    ioresult := ord(inoerror);

	    good_file_name(pathinfo.basename);

	    { what we found was the parent of target }
	    pathinfo.parent_ino := pathinfo.ino;
	    pdir := start_inodep;
	    start_inodep := nil;

	    { be sure parent dir writeable }
	    if not permission(pdir, w_permission) then
		goto 999;
	end;
    end;

    {
    { now we have
    { pathinfo.basename -- simple filename
    { pathinfo.parent_ino -- parent inumber for allocator
    { set up fileinfo for finishfib
    }
    with f, fileinfo do begin
	ieft := feft;
	ikind := fkind;
	if ieft = uxfile_eft then
	    ioffset := 0
	else
	    ioffset := wshdr_size;
	ilogicalsize := 0;
	istartaddress := fstartaddress;

	{ fpos shows how much to preallocate }
	if fpos < 0 then
	    { user gave [*], which we ignore }
	    fpos := 0;
	{ round to boundary; else ASCII AM has trouble }
	fpos := roundup(fpos, fblksize);
    end;

    if pdir = nil then
	pdir := get_inode(pathinfo.parent_ino);
$if debug$
    reportn('create file with size', fileinfo.ioffset + f.fpos);
$end$
    new_inodep := alloc_inode(pdir, file_mode, fileinfo.ioffset + f.fpos);
    if new_inodep = nil then
	goto 999;
    finishfib(new_inodep, pathinfo.parent_ino, pathinfo.basename, fileinfo);
    with f do begin
	fpeof := fpos;
	fpos := 0;
	if feft <> uxfile_eft then
	    put_wsheader(new_inodep, fileinfo)
	else
	 if fpeof > 2 then      {SFB fix for 00955}
	  begin
	   zapheader_buf := 0;  {kill leading word of possible wsheader. This
				 word must be 0x8000 to be wsheader}
	   bn := get_dbnum(new_inodep, 0, B_WRITE, 2);
	   if bn <> BMAP_ERROR then
	    put_bytes(f.funit, 2, data_start(superblock, bn),
		      addr(zapheader_buf));
	  end;
    end;
999:
    oldior:=ioresult;   {SFB}
    put_inode(start_inodep, [release]);
    put_inode(new_inodep, [release]);
    put_inode(pdir, [release]);
    if ioresult=ord(inoerror) then      {SFB}
     ioresult:=oldior;
end;

{---------------------------------------------------------------------------}
{
{ doclosefile
{ close the given fib
{ If made with no name, just deallocate inode.
{ If an old file, don't need to do anything (except change wshdr if grew).
{ If a new file, it's not in any directory yet, so we put it there.
{ We have already checked all permissions during the open.
}
procedure doclosefile;
label
    999;
var
    ip, pdir: inode_ptr_type;
    name: string255;
    fileinfo: fileinfotype;
    oldior: integer;    {for "protecting" ioresult during cleanup. SFB}

begin
    pdir := nil; {in case not fisnew or get_inode for ip escapes. SFB}
    ip := nil;  {in case we shortcut the close. SFB}
    try {so we can guarantee fib gets closed. SFB}
    with f do begin
	if pathid = no_inode then
	 begin
	   ioresult := ord(inotopen);
	   goto 999;     {can't get_inode anyway. SFB}
	 end;

	ip := get_inode(pathid);
	{ cannot close a directory with this dam call }
	if itype(ip) = IFDIR then begin
	    ioresult := ord(inotondir);
	    goto 999;
	end;
	if fmodified then begin
	    { need to update ws hdr? }
	    if feft <> uxfile_eft then begin
		with fileinfo do begin
		    ieft := feft;
		    ikind := fkind;
		    ioffset := fileid;
		    istartaddress := fstartaddress;
		    ilogicalsize := fleof;
		end;
		put_wsheader(ip, fileinfo);
		{ use leof from wsheader for changing file size }
		fleof := fileinfo.ilogicalsize;
	    end;
	    { inode size can be beyond leof; correct it now }
	    if change_file_size(ip, fileid + fleof) then
		;
	end;

	{ set time stamps }
	if freadable then
	    time_stamp(ip, [IACC]);
	if fwriteable then
	    time_stamp(ip, [IMOD,ICHG]);
	{ try to avoid errors on read-only disks }
	if not fisnew and not fmodified then
	    put_inode(ip, [stamping]);

	{ if new file, put it in a directory }
	if fisnew then begin
	    pdir := get_inode(foldfileid);
	    if itype(pdir) <> IFDIR then begin
		ioresult := ord(ilostfile);
		goto 999;
	    end;
	    name := ftid + ffpw;
	    enter_file(ip, pdir, name);
	end;
    end;
999:
    { show fib closed }
    recover     {don't leave till fib closed and all released. SFB}
     if escapecode <> -10 then      {guarantee ioresult non-0. SFB}
      ioresult := ord(icorrupt);
    close_fib;
    oldior:=ioresult;   {SFB}
    put_inode(ip, [release]);
    put_inode(pdir, [release]);
    if ioresult=ord(inoerror) then      {SFB}
     ioresult:=oldior;
    if ioresult <> ord(inoerror) then   {exercise main error-handling code.
					 SFB}
     escape(-10);
end;


{------------------------------------------------------------------------}
{
{ purgefile
{ If not in a directory, drop the inode
{ else remove it from dir too.
{ Can also remove directories.
{ diroff tells the offset in the directory.  Normally we don't
{ know this (diroff = -1), but if we do (called from purgename), then
{ we can avoid a directory search in delete_filename.
}
procedure dopurgefile(diroff: integer);
label
    999;
var
    ip, pdir: inode_ptr_type;
    ino: integer;
    name: string255;
    oldior: integer;    {for "protecting" ioresult during cleanup. SFB}
begin
    with f do begin
	pdir := nil;
	ip := get_inode(pathid);

	{ anonymous and new files are easy }
	if ip^.nlink = 0 then begin
	    dealloc_inode(ip);
	    goto 999;
	end;

	{ file is in dir, so be sure dir is writeable }
	pdir := get_inode(foldfileid);
	if not permission(pdir, w_permission) then
	    goto 999;

	{ don't allow removal of root or prefix }
	if in_use(inumber(ip)) then begin
	    ioresult := ord(inotclosed);
	    goto 999;
	end;

	if diroff = -1 then begin
	    name := ftid + ffpw;
	    delete_filename(ip, pdir, name);
	end
	else
	    delete_file(ip, pdir, diroff);
    end;
999:
    oldior:=ioresult;   {SFB}
    if ioresult = ord(inoerror) then
	close_fib;
    put_inode(ip, [release]);
    put_inode(pdir, [release]);
    if ioresult=ord(inoerror) then      {SFB}
     ioresult:=oldior;
end;

{-------------------------------------------------------------------------}
{
{ openold
{ opens an existing file (NOT a directory, unless we're deleting it)
{ ftitle -- name of file to be opened
{ if deleting, we can avoid a little work; we return the dir offset
}
procedure openold(var diroff: integer);
label
    999;
var
    name : string255;
    inodep: inode_ptr_type;
    pathinfo: pathinfotype;
    fileinfo: fileinfotype;
    deleting: boolean;
    ityp: integer;
    oldior: integer;    {for "protecting" ioresult during cleanup. SFB}
begin
    name := f.ftitle;
    inodep := get_inode(start_path);

    { name must exist }
    if not traverse_path(name, false, inodep, pathinfo) then
	goto 999;

    ityp := itype(inodep);
    deleting := false;
    case request of

	duplicatelink,
	purgefile,
	purgename:
	    deleting := true;

	openfile:
	    begin
		ioresult := ord(inoerror);
	    end;

	overwritefile:
	    begin
		if ityp <> IFREG then begin
		    ioresult := ord(inoaccess);
		    goto 999;
		end;
		if not permission(inodep, w_permission) then
		    goto 999;
	    end;

	otherwise
	    begin
$if debug$
		writeln('OPENOLD OTHERWISE');
$end$
		ioresult := ord(zcatchall);
		goto 999;
	    end;
    end;

    { unless dir_ok, must not be a directory (but special files OK) }
    if not deleting and (ityp = IFDIR) then begin
	ioresult := ord(inoaccess);
	goto 999;
    end;

    { dig out fileinfo for finishfib }
    getfileinfo(inodep, fileinfo, deleting);
    finishfib(inodep, pathinfo.parent_ino, pathinfo.basename, fileinfo);

    { set fpeof to inode size minus size for ws header }
    {and possibly adjust fleof. The problem is with BDAT files, where BASIC
     sets inode.size.ls to sizeof(wsheader) + sizeof(BDAT sector) + logical
     file size. Pascal wants inode.size.ls = sizeof(wsheader) + sizeof(wsvolume)
     (ie an integral # of sectors, as if it were LIF). The anomaly shows up when
     the BDAT file doesn't logically fill its last sector, at which time fleof>fpeof,
     which is not nice. Rather than fix finishfib, where fleof is set, we change
     it here. This is because finishfib is called by other routines, and I'm
     too lazy too fix 'em all. No time.

     Never let either fpeof or fleof > inode.size.ls, as that is what HP-UX thinks
     is really in the file, and we have no business going beyond that!

     BASIC may enhance in 5.01 to create only files in which inode.size.ls =
     n*256, which is a little more consistent (logical size is only in one place).
     SFB}

     with f do
      begin
       fpeof := inodep^.size.ls - fileinfo.ioffset;
       if fleof>fpeof then {limit fleof to inode.size.ls - wsheader (if it's there)}
	fleof:=fpeof;
      end;

    { if deleting, hide dir offset in fpos }
    if deleting then
	diroff := pathinfo.diroff;
999:
$if debug$
    reportn('open old file, fleof is', f.fleof);
$end$
    oldior:=ioresult;   {SFB}
    put_inode(inodep, [release]);
    if ioresult=ord(inoerror) then      {SFB}
     ioresult:=oldior;
end;

{-----------------------------------------------------------------------}
{
{ dopurgename
{ just open old file, then use purgefile
{ must save pathid of caller, since could be reused (e.g. FILER)
}
procedure dopurgename;
var
    savepathid: integer;
    diroff: integer;
begin
    savepathid := f.pathid;
    openold(diroff);
    if ioresult = ord(inoerror) then
	dopurgefile(diroff);
    f.pathid := savepathid;
end;

{---------------------------------------------------------------------}
{
{ stretchit
{ stretch file
{ current phys size is fpeof
{ desired phys size is fpos
{ we set fpeof to fpos (or beyond) on success
}
procedure dostretchit;
label
    999;
var
    havebytes, wantbytes, trybytes: integer;
    ip: inode_ptr_type;
    changed: boolean;
    oldior: integer;    {for "protecting" ioresult during cleanup. SFB}
{-----------------------}
procedure stretch(newsize: integer);
begin
    if (havebytes = newsize) then begin
	changed := true;
	if ip^.size.ls <> newsize then begin
	    ip^.size.ls := newsize;
	    put_inode(ip, [dirty]);
	end;
    end
    else
	changed := change_file_size(ip, newsize);
end;
{-----------------------}
begin
$if debug$
    reportn('stretchit -- old fpeof', f.fpeof);
$end$
    with f do begin
	ip := get_inode(pathid);

	{ only stretchable files allowed }
	if not has_blocks(ip) then begin
	    ioresult := ord(inoaccess);
	    goto 999;
	end;

	{ havebytes, wantbytes -- rounded to next disc block }
	havebytes := bytes_claimed(ip^.size.ls);
	wantbytes := bytes_claimed(fpos+fileid);
	trybytes := roundup(wantbytes, superblock^.bsize);
	stretch(trybytes);
	if changed then
	    wantbytes := trybytes
	else
	    stretch(wantbytes);
	if changed then begin
	    fmodified := true;
	    fpeof := wantbytes - fileid;
	end;
    end;
$if debug$
    reportn('stretchit -- new fpeof', f.fpeof);
$end$
999:
    oldior:=ioresult;   {SFB}
    put_inode(ip, [release]);
    if ioresult=ord(inoerror) then      {SFB}
     ioresult:=oldior;
end;

{------------------------------------------------------------------}
{
{ DUPLICATELINK
{ doduplink gets
{               f.vid, f.ftitle, f.funit -- for existing file
{       f.fwindow -- pointer to FIB open to parent of new link, with
{               ftitle the name to be created.
}
procedure doduplink;
label
    999;
var
    old_inodep, parent_inodep: inode_ptr_type;
    parent_inodenum: integer;
    dummy: boolean;
    parent_fibp: fibp;
    linkname: string255;
    pathinfo: pathinfotype;
    oldior: integer;    {for "protecting" ioresult during cleanup. SFB}
begin
    parent_inodep := nil;
    parent_fibp := fibp(f.fwindow);
    linkname := parent_fibp^.ftitle;

    { old file must exist }
    old_inodep := get_inode(start_path);
    if not traverse_path(f.ftitle, false, old_inodep, pathinfo) then
	goto 999;
    f.ftitle := pathinfo.basename;

    { old file must not be directory }
    if itype(old_inodep) = IFDIR then begin
	ioresult := ord(inotondir);
	goto 999;
    end;

    { parent of new file must be writeable directory }
    parent_inodep := get_inode(parent_fibp^.pathid);
    if not create_ok(parent_inodep, linkname, pathinfo.diroff) then
	goto 999;

    link_file(old_inodep, linkname, parent_inodep, pathinfo.diroff);
    if (ioresult = ord(inoerror)) and f.fpurgeoldlink then
	dopurgename;
999:
    oldior:=ioresult;   {SFB}
    put_inode(old_inodep, [release]);
    put_inode(parent_inodep, [release]);
    if ioresult=ord(inoerror) then      {SFB}
     ioresult:=oldior;
end;



{--------------------------------------------------------------------------}
{
{ CHANGENAME
{       fvid, funit, ftitle describe old file
{       fwindow^ is name of new file
}
procedure dochangename;
label
    999;
var
    diroffset: integer;
    old_inodep, parent_inodep: inode_ptr_type;
    cache_ptr: cache_blk_ptr_type;
    dir_ptr: direntry_ptr_type;
    blocknum: integer;
    newname: string255;
    i: integer;
    pathinfo: pathinfotype;
    oldior: integer;    {for "protecting" ioresult during cleanup. SFB}
begin
    parent_inodep := nil;
    cache_ptr := nil;
    newname := string255(f.fwindow^);
    good_file_name(newname);

    { old file must exist }
    old_inodep := get_inode(start_path);
    if not traverse_path(f.ftitle, false, old_inodep, pathinfo) then
	goto 999;

    { remember its directory offset }
    diroffset := pathinfo.diroff;

    { parent directory must be writeable, searchable }
    parent_inodep := get_inode(pathinfo.parent_ino);
    if not create_ok(parent_inodep, newname, pathinfo.diroff) then
	goto 999;

    { be sure not root or a prefix }
    if in_use(inumber(old_inodep)) then begin
	ioresult := ord(inotclosed);
	goto 999;
    end;

    { get access to directory entry }
    blocknum := get_dbnum(parent_inodep, diroffset, B_READ, 0);
    if blocknum = BMAP_ERROR then
	goto 999;
    cache_ptr := get_datablk(blocknum, blkoff(superblock, diroffset));
    dir_ptr := addr(cache_ptr^, diroffset mod cache_blk_size);

    { now change the directory entry }
    with dir_ptr^ do begin
	i := 0;
	while (i < DIRSIZ) and (i+1 <= strlen(newname)) do begin
	    name[i] := newname[i+1];
	    i := i + 1;
	end;
	namlen := i;
	while i < DIRSIZ do begin
	    name[i] := chr(0);
	    i := i + 1;
	end;
    end;
    put_datablk(cache_ptr, [release,dirty]);

999:
    oldior:=ioresult;   {SFB}
    put_inode(parent_inodep, [release]);
    put_inode(old_inodep, [release]);
    if ioresult=ord(inoerror) then      {SFB}
     ioresult:=oldior;
end;

{-----------------------------------------------------------------}
{
{ dogetvolumename
{ Put the vol name into the string f (not a fib this time).
{ If not is_hfsunit, we aren't ready to look at the superblock,
{ so we set name to ''.  This state occurs only when TABLE is
{ in the process of running.
{ Otherwise, we get the superblock.
{ If we get an error, it
{ might be transient, like popping and pushing the disc,
{ which we can ignore, so we just try again with get_superblock.
{ Once we have a superblock, we call medium_back, which
{ resets the uvid if it has been lost (it's lost when an
{ error occurs on the disc, in which case we have set the prefix
{ to the root, and we set the uvid to '').
{ We also check for a weird TABLE result: if there are not enough
{ units for all the hard discs, some of the hard disc can become
{ inaccessible, but there might be an HFS system already on it,
{ taking up the whole device.
{ Yes, this should be fixed in TABLE, but that's not so easy.
}
procedure dogetvolumename;
var
    fibstring: string255ptr;
    base_unum: unitnum;
    tmp_valid: boolean; {SFB}
begin
    if not h_unitable^.tbl[unum].is_hfsunit then
	superblock := nil
    else begin
	{Added code to save umediavalid so check_disk_status gets a look at
	 it. Unblockeddam clears umediavalid, and is called in set_unit.
	 Need to see umediavalid to see if medium changed, then controller
	 status was cleared by another non-HFS dam on same H/W, eg #3. SFB}

	tmp_valid:=unitable^[unum].umediavalid; {SFB}
	base_unum := set_unit(unum);
	unitable^[unum].umediavalid:=tmp_valid; {SFB}
	check_disk_status;
	if ioresult <> ord(inoerror) then begin
	    invalidate_unit(base_unum);
	    medium_gone;
	end;

	{ ignore any errors }
	ioresult := ord(inoerror);

	{ just in case we had umediavalid false on floppy (did no IO) }
	unitable^[unum].umediavalid:=TRUE; {SFB}

	{ now try for the superblock, reading disk if status was bad }
	superblock := get_superblock(unum);


	{
	{ callers (findvolume, e.g) expect that an unrecognizable name
	{ is returned as a null string, not an ioresult
	}
	if ioresult = ord(icorrupt) then
	    ioresult := ord(inoerror);

    end;

    fibstring := addr(f);
    if (superblock = nil) then
	setstrlen(fibstring^, 0)
    else begin
	with unitable^[unum] do begin
	    if uvid = '' then begin
		{ new medium may not be corrupt }
	       {h_unitable^.tbl[base_unum].fs_corrupt := false; {SFB}
		h_unitable^.tbl[base_unum].fs_corrupt :=
		 (superblock^.clean<>chr(FS_CLEAN)); {SFB}
		medium_back(rootname);
	     end;
	    fibstring^ := uvid;
	end;
    end;
end;

{---------------------------------------------------------------------}
{
{ get/set volume date
}
procedure getvdate(anyvar dt: datetimerec);
begin
    secs_to_timedate(superblock^.time - timezone, dt.date, dt.time);
end;

procedure setvdate(anyvar dt: datetimerec);
begin
    superblock^.time := timedate_to_secs(dt.date, dt.time) + timezone;
    put_superblock(superblock, [dirty]);
end;



{-----------------------------------------------------------------------
{ STRIPNAME
{       ftitle contains the path to be processed on entry
{       ftitle contains the 'dirname' of the original ftitle on exit
{              this is the name up to the last slash with slashes at
{              end
{       ftid   contain the 'basename' of the original ftitle on exit
{        +     this is the name from the last slash found in ftitle till
{       ffpw   the end of it.
}
procedure dostripname;
var s: string[255];
    i: integer;
    len: integer;

begin

  with f do
    begin
      len := strlen(ftitle);
      if len <= 0 then
	ioresult := ord(ibadtitle)
      else
	begin
	  setstrlen(s,0);
	  s   := ftitle;
	  i   := len;


	  while (i > 0) and (s[i] <> '/') do
	      i := i-1;

	  if (len - i) > (tidleng + passleng) then
	    ioresult := ord(ibadtitle)
	  else
	    begin
	      {copy basename part to ftid + ffpw}
	      setstrlen(ftid,0);
	      setstrlen(ffpw,0);
	      if (len - i) > tidleng then
		begin
		  strmove(tidleng,s,i+1,ftid,1);
		  strmove((len - i - tidleng),s,i+1+tidleng,ffpw,1);
		end
	      else
		if i <> len then
		  strmove((len - i),s,i+1,ftid,1);

	      {copy dirname part to ftitle}
	      setstrlen(ftitle,0);
	      strmove(i,s,1,ftitle,1);
	    end;
	end;{len > 0}
    end; {with f}
end; {dostripname}


{--------------------------------------------------------------------------}
{SETPASSWORDS
{ fwindow points to a command_array with fpeof elements                    }
{ there are two groups of commands file related and volume related ones    }
{ Those are : hfs_chmod, hfs_chown, hfs_chgrp, hfs_chatime, hfs_chmtime,   }
{             hfs_open (file related)                                      }
{             hfs_login, hfs_umask (volume related)                        }
{
}
procedure dosetpassword;

type
  command_array = array[0..maxint] of h_setpasswd_entry;
  command_arrayptr = ^command_array;

var inode_ptr: inode_ptr_type;
    f_d_name: fid;
    next_command: integer;
    is_vol_command: boolean;
    old_inodenum: integer;
    pathinfo: pathinfotype;

function owner_perm(inodep: inode_ptr_type): boolean;
begin
  if (get_uid = inodep^.uid) or
     (get_uid = 0 {in super_user_id}) then
     owner_perm := TRUE
  else
     owner_perm := FALSE;
end;{owner_perm}

begin

  with f do
   if fpeof > 0 then
      begin
	inode_ptr := NIL;
	next_command := 1;
	is_vol_command := false;
	{check the first command to see to which group it belongs}
	with command_arrayptr(fwindow)^[0] do
	begin
	  case command of
	  hfs_login : begin
		    is_vol_command := true;
		    next_command := 2;
		    if ffpw = '' then
		      {restore default values}
		      begin
			set_uid(paws_uid);
			set_gid(paws_gid);
		      end
		    else
		      {check password}
		      if ffpw = 'Angelika' then
		      {equal to the super user password}
			begin
			  set_uid(0);
			  set_gid(1);
			end
		      else
		      {restore default values}
			begin
			  set_uid(paws_uid);
			  set_gid(paws_gid);
			  ioresult := ord(ibadpass);
			end;
		    {there should be only one command}
		    if fpeof > 1 then
		      ioresult := ord(ibadvalue);
		  end;
	  hfs_umask : begin
		    is_vol_command := true;
		    next_command := 2;
		    h_unitable^.tbl[unum].umask := new_value MOD 512;
		    {there should be only one command}
		    if fpeof > 1 then
		      ioresult := ord(ibadvalue);
		  end;
	  hfs_open  : begin
		    {get the inode of the file/directory}
		    next_command := 2;
		    f_d_name := ftitle;
		    old_inodenum := start_path;
		    inode_ptr    := get_inode(old_inodenum);
		    if ioresult = ord(inoerror) then
		      if traverse_path(f_d_name, false,
				       inode_ptr, pathinfo) then
			begin
			  pathid := inumber(inode_ptr);
			  freadable := false;
			  fwriteable := false;
			end;
		   end;
	  hfs_chown,
	  hfs_chgrp,
	  hfs_chmod,
	  hfs_chatime,
	  hfs_chmtime : begin
		     if (pathid = no_inode) or (pathid = raw_inode) then
		       ioresult := ord(inotopen)
		     else
		       inode_ptr  := get_inode(pathid);
		   end;
	  otherwise ioresult := ord(ibadvalue);
	  end; {case}
	end; {with command_arrayptr(fwindow)^[0]}


	{process further commands}
	while (next_command <= fpeof) and (ioresult = ord(inoerror)) do
	  with command_arrayptr(fwindow)^[next_command -1], inode_ptr^ do
	    begin
	      case command of
		hfs_chmod  : if owner_perm(inode_ptr) then
			   begin
			     mode := iand(mode, IFMT) + iand(new_value, 4095);
			     next_command := next_command +1;
			   end
			 else
			   ioresult := ord(inopermission);
		hfs_chown  : if owner_perm(inode_ptr) then
			   begin
			     uid := new_value;
			     next_command := next_command +1;
			   end
			 else
			   ioresult := ord(inopermission);
		hfs_chgrp  : if owner_perm(inode_ptr) then
			   begin
			     gid := new_value;
			     next_command := next_command +1;
			   end
			 else
			   ioresult := ord(inopermission);
		hfs_chatime: if owner_perm(inode_ptr) or
				 permission(inode_ptr,w_permission) then
			   begin
			     atime := new_value;
			     next_command := next_command +1;
			   end
			 else
			   ioresult := ord(inopermission);
		hfs_chmtime: if owner_perm(inode_ptr) or
				  permission(inode_ptr,w_permission) then
			   begin
			     mtime := new_value;
			     next_command := next_command +1;
			   end
			 else
			   ioresult := ord(inopermission);
		otherwise ioresult := ord(ibadvalue);
	      end;{case}
	    end; {while}

	{number of successfully completed commands }
	fpeof := next_command -1;

	{make the changes to the inode}
	if not is_vol_command then
	  begin
	    time_stamp(inode_ptr,[ICHG]);
	    put_inode(inode_ptr,[release,dirty]);
	  end
      end; {fpeof > 0}
end; {dosetpassword}


{---------------------------------------------------------------}
{CATPASSWORDS
{       fwindow contains an id_ptr
{       if pathid is not valid then catalog the volume info
{       else catalog the info of the file with inode contained in pathid
}
procedure docatpassword;
type id_ptr = ^h_catpasswd_ids;
var inode_ptr: inode_ptr_type;
begin
  with f do
      if (pathid = no_inode) or (pathid = raw_inode) then
	{output volume information}
	with id_ptr(fwindow)^ do
	  begin
	    cat_uid := get_uid;
	    cat_gid := get_gid;
	    cat_umask := h_unitable^.tbl[unum].umask;
	  end
      else
	{output file/directory related information}
	begin
	  inode_ptr  := get_inode(pathid);
	  with id_ptr(fwindow)^, inode_ptr^ do
	    begin
	      cat_uid := uid;
	      cat_gid := gid;
	      cat_mode:= mode;
	    end;
	  put_inode(inode_ptr,[release]);
	end;
end; {docatpassword}

begin {hfsdam}
$if debug$
    if printmesg then
	writeln('DAM request ', request);
$end$
    ioresult := ord(inoerror);
    lockup;

    try

    unitable^[unum].ureportchange := true;
    superblock := nil;
    if request in (wants_superblock + needs_superblock) then begin
	superblock := get_superblock(unum);
	if (superblock = nil) and (request in needs_superblock) then
	    goto 1;
    end;

    case request of
	openfile       : begin
			     f.fisnew := false;
			     openold(junkdiroff);
			 end;
	createfile     : begin
			     f.fisnew := true;
			     docreate;
			 end;
	overwritefile  : begin
			     f.fisnew := false;
			     openold(junkdiroff);
			     if ioresult = ord(inoerror) then begin
				 f.fwriteable := true;
				 f.freadable := false;
				 f.fmodified := true;
				 f.fleof := 0;
			     end
			     else
			     if ioresult = ord(inofile) then begin
				 f.fisnew := true;
				 docreate;
			     end;
			 end;
	closefile      : if f.pathid = raw_inode then begin
			     { ignore any error from get_superblock }
			     ioresult := ord(inoerror);
			     close_fib;
			 end
			 else
			 if superblock <> nil then
			     doclosefile;
	purgefile      : dopurgefile(-1);
	stretchit      : dostretchit;
	changename     : dochangename;
	getvolumename  : dogetvolumename;
	setvolumename  : dosetvolname;
	purgename      : dopurgename;
	getvolumedate  : getvdate(f);
	setvolumedate  : setvdate(f);
	crunch         : { do nothing, as SRMDAM does } ;
	catalog        : docatalog;
	openparentdir,
	opendirectory  : doopendirectory(f.fwindow^,(request=openparentdir));
	closedirectory : close_fib;
	makedirectory  : begin
			   if f.pathid = no_inode then
			       { FILER Zero }
			       ioresult := ord(ibadrequest)
			   else
			   if superblock <> nil then
			       domakedir;
			 end;
	openunit,
	openvolume     : begin
			   f.pathid := raw_inode;
			   unblockeddam(f,unum,request);
			   invalidate_unit(h_unitable^.tbl[unum].base_unum);
			 end;
	setunitprefix  : dosetunitprefix;
	stripname      : dostripname;
	setpasswords   : dosetpassword;
	catpasswords   : docatpassword;
	duplicatelink  : doduplink;
	lockfile       : ioresult := ord(ibadrequest);
	unlockfile     : ioresult := ord(ibadrequest);
	otherwise        begin
			     ioresult := ord(ibadrequest);
			 end;
    end;
1:
    escape(0);
    recover begin       {error handling redone. SFB}
	if escapecode <> 0 then begin
	    nuke_unit(unum);    {show it corrupt, and invalidate in cache. SFB}
	    lockdown;
	    if escapecode <> -10 then
	     escape(escapecode);
	end
	else begin
	    try
	      put_superblock(superblock, [release]);
	      sync;
	    recover nuke_unit(unum);
	    lockdown;
	    if (escapecode <> -10) and (escapecode <> 0) then
	    {either escapecode from sync or original escapecode. SFB}
	     escape(escapecode);
	end;
    end;
end;

procedure install_hfs_dam;
var
    i: integer;
begin
    init_cache;
    init_hfsalloc;
    with h_unitable^ do begin
	init_cache_proc   := init_cache;
	init_unit_proc    := init_hfs_unit;
	config_cache_proc := configure_cache;
	inval_cache_proc  := invalidate_unit;
    end;
end;

end;

import hfs_dam_module, loader;

begin
    install_hfs_dam;
    markuser;
end.

@


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


56.1
log
@Automatic bump of revision number for PWS version 3.25
@
text
@a0 2328
$modcal$

$linenum 1000$
$lines 54$

$partial_eval on$
$allow_packed on$

$range off$
$ovflcheck off$
$debug off$


program hfs_dam_init(input, output);

module hfs_dam_module;


$search 'hfs'$
import
    hfstuff,
    hfsupport,
    hfsalloc,
    hfscalc,
    hfscache,
    iocomasm,
    sysglobals,
    sysdevs,
    misc,
    asm;

export

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

implement

const
    debug = false;

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

label
    1;

$include 'wsheader'$

type
    string20 = string[20];
    string3  = string[3];

const
    { MUST have superblock }
    needs_superblock = [setvolumename,
			changename,
			purgename,
			openfile,
			createfile,
			overwritefile,
			purgefile,
			stretchit,
			opendirectory,
			catalog,
			setunitprefix,
			duplicatelink,
			openparentdir,
			getvolumedate,
			setvolumedate,
			catpasswords,
			setpasswords];

      { wants superblock, but could do without it }
      wants_superblock = [closefile,
			  makedirectory];

      { default modes for creating files and directories }
      file_mode = octal('666');
      dir_mode  = octal('777');

  var
      superblock: super_block_ptr_type;
      junkdiroff: integer;

$include 'wsbody'$

{-------------------------------------------------------------}
{
{ get_wsheader
{ Read the ws hdr from the beginning of a file.
{ We just read the bytes, then call read_wsheader to interpret them.
{ Don't care if hdr not there.
}
procedure get_wsheader(inodep: inode_ptr_type;
		       var fileinfo: fileinfotype);
label
    999;
type
    eftheaderbuftype = packed array[0..wshdr_size-1] of char;
var
    headerbuf: eftheaderbuftype;
    bn: integer;
begin
$if debug$
    xreport('GET_WSHEADER');
$end$
    if inodep^.size.ls >= wshdr_size then begin
	bn := get_dbnum(inodep, 0, B_READ, wshdr_size);
	if (bn = BMAP_HOLE) or (bn = BMAP_ERROR) then
	    goto 999;
	get_bytes(f.funit, wshdr_size, data_start(superblock, bn),
		  addr(headerbuf));
	if read_wsheader(addr(headerbuf), fileinfo) then
	    ;
    end;
999:
end;

{--------------------------------------------------------------------------}
{
{ put_wsheader
{ given an inode and a fileinfo block, make a ws hdr and
{ write it to the given file.
{ Added protection against writing a wsheader to a corrupt file system.
{ Other writes are protected in hfstm, or by higher level caller. SFB
}
procedure put_wsheader(inodep: inode_ptr_type;
		       var fileinfo: fileinfotype);
label
    999;
type
    eftheaderbuftype = packed array[0..wshdr_size-1] of char;
var
    headerbuf: eftheaderbuftype;
    bn: integer;
begin
    if h_unitable^.tbl[h_unitable^.tbl[f.funit].base_unum].fs_corrupt then {SFB}
     begin
      ioresult := ord(icorrupt);
      goto 999;
     end;
    makews_header(addr(headerbuf), fileinfo);
    bn := get_dbnum(inodep, 0, B_WRITE, wshdr_size);
    if bn = BMAP_ERROR then
	goto 999;
    put_bytes(f.funit, wshdr_size, data_start(superblock, bn),
	      addr(headerbuf));
999:
end;

{------------------------------------------------------------------------}
{
{ bytes_claimed
{ tell how many bytes are claimed by an inode with this size
}
function bytes_claimed(size: integer): integer;
begin
    if lblkno(superblock, size) < NDADDR then
	bytes_claimed := roundup(size, superblock^.fsize)
    else
	bytes_claimed := roundup(size, superblock^.bsize)
end;

{--------------------------------------------------------------------}
{
{ create_ok
{ see if it's ok to create this file in this dir
{ parent_ip must be writeable directory
{ filename must not exist
{ true -> no problem
{ else ioresult already set
{ returns directory offset for use in creation
}
function create_ok(pdir: inode_ptr_type;
		   var fname: string255;
		   var diroff: integer): boolean;
var
    pathinfo: pathinfotype;
begin
    if itype(pdir) <> IFDIR then
	ioresult := ord(ifilenotdir)
    else
    if not permission(pdir, w_permission+x_permission) then
	{ ioresult already set to inopermission }
    else
    if foundname(fname, false, pdir, pathinfo) then
	ioresult := ord(idupfile);

    if ioresult = ord(inoerror) then begin
	create_ok := true;
	diroff := pathinfo.diroff;
    end
    else
	create_ok := false;
end;

{--------------------------------------------------------------------}
{
{ getfileinfo
{ takes inode
{ fills in fileinfo block describing the file
{ shortcut tells whether to skip reading the wsheader,
{ which makes file look like UX file, but is faster (short listings).
{ Note that filesize can be "wrong" (counts ws hdr size) if
{ shortcut is true.
}
procedure getfileinfo(inodep: inode_ptr_type;
		      var fileinfo: fileinfotype;
		      shortcut: boolean);
const
     hpux_fileinfo = fileinfotype [
	ikind        : untypedfile,  {reset according to inode}
	ieft         : 0,            {reset according to inode}
	ioffset      : 0,            {reset if LIFheader}
	ilogicalsize : 0,            {reset according to inode or LIFheader}
	istartaddress: 0             {reset if LIFheader}
	];
var
    iftype: integer;
begin
    { set up assuming shortcut true }
    fileinfo := hpux_fileinfo;
    iftype := itype(inodep);

    with fileinfo do begin
	ilogicalsize := inodep^.size.ls;

	if iftype = IFREG then begin
	    { HP-UX "regular" file }
	    ikind := uxfile;
	    ieft := uxfile_eft;
	    if not shortcut then
		{ LIF info requested, so read LIFheader if it's there }
		get_wsheader(inodep, fileinfo);
	end
	else
	if iftype = IFDIR then begin
	    { directory }
	    ieft   := 3;
	    ikind  := untypedfile;
	end
	else
	    { special file (fifo, char/block, etc) }
	    ikind := uxfile;
    end;
end;

{-----------------------------------------------------------------}
{
{ Find the starting inode for a relative path.  The bizarre rules,
{ deduced from the FILER (see the change name sequence, e.g.) are:
{ 1) if the FIB is open (pathid <> no_inode),
{            then start at that pathid
{ 2) if the FIB is closed,
{            then start at the unit prefix
}
function start_path: integer;
begin
    with f do
	if pathid = no_inode then
	    start_path := h_unitable^.tbl[funit].prefix
	else
	    start_path := pathid;
end;

{-------------------------------------------------------------------}
{
{ check for a good file name
{ cannot be too long for dir entry
{ cannot contain null or /
}
procedure good_file_name(var fname: string255);
begin
    if (strlen(fname) > MAXNAMLEN)
    or (strpos(#0, fname) <> 0)
    or (strpos('/', fname) <> 0) then begin
$if debug$
	xreport('good_file_name sees bad title');
$end$
	ioresult := ord(ibadtitle);
	escape(0);      {Because disc is not corrupt in this case. SFB}
    end;
end;

{-----------------------------------------------------------------------}
{
{ FOUNDINO
{ find inumber in directory pdir
{ returns true if found
{         name of file
}
function foundino(inumber: integer;
		  pdir: inode_ptr_type;
		  var name: string): boolean;
{--------------------}
procedure check_entry(dp: direntry_ptr_type;
		      offset: integer;
		      anyvar inumber: integer;
		      anyvar iname: string255;
		      var keep_going: boolean);
begin
    with dp^ do
	{ is this the entry we want? }
	if ino = inumber then begin
	    pac_to_string(name, namlen, iname);
	    keep_going := false;
	end;
end;
{--------------------}
begin {foundino}

    name := '';
    scan_dir(pdir, check_entry, inumber, name);

    foundino := (name <> '');

end;

{------------------------------------------------------------------------}
{
{ rootname
{ return the name of the root directory, which is
{ the volume name when the prefix is /.
{ We use the fname superblock field, unless it's null,
{ in which case we use 'hfs' + the unit number.
}
function rootname: vid;
const
    nilname = fs_name_type[#0#0#0#0#0#0];
var
    tempname: string[fs_name_len];
    i: integer;
begin
    with superblock^ do
	if fname = nilname then begin
	    setstrlen(tempname, 0);
	    strwrite(tempname, 1, i, 'hfs', h_unitable^.tbl[unum].base_unum:1);
	end
	else begin
	    setstrlen(tempname, fs_name_len);
	    i := 1;
	    while (i <= fs_name_len) and (fname[i-1] <> #0) do begin
		tempname[i] := fname[i-1];
		i := i + 1;
	    end;
	    setstrlen(tempname, i-1);
	end;
    rootname := tempname;
end;

{--------------------------------------------------------------}
{
{ Return inumber of parent
}
function parent_inode(inodep: inode_ptr_type): integer;
var
    dotdot: string[2];
    pathinfo: pathinfotype;
begin
$if debug$
    xreport('PARENT_INODE');
$end$
    dotdot := '..';
    if foundname(dotdot, true, inodep, pathinfo) then
	parent_inode := pathinfo.ino
    else begin
$if debug$
	xreport('parent_inode failed');
$end$
	ioresult := ord(ilostfile);
	escape(-10);    {Because we think disc must be corrupt. SFB}
    end;
end;



{-------------------------------------------------------------------}
{
{ dotname, dotdotname
{ return name of . or .. in given directory
{ also sets parent_ino if known, since we usually have it anyway
}
function dotname(inodep : inode_ptr_type;
		 var parent_ino: integer): string255;
var
    tempname     : string255;
    dotdotinode  : integer;
    dotdotinodep : inode_ptr_type;
    inodenum: integer;
begin
    inodenum := inumber(inodep);
    if inodenum = root_inode then begin
	 dotname := rootname;
	 parent_ino := root_inode;
    end
    else
    if inodenum = h_unitable^.tbl[unum].prefix then
	dotname := unitable^[unum].uvid
    else begin
$if debug$
	xreport('DOTNAME');
$end$
	{ no shortcut possible; must look through dirs }
	dotdotinode  := parent_inode(inodep);
	dotdotinodep := get_inode(dotdotinode);
	if foundino(inodenum, dotdotinodep, tempname) then begin
	    dotname := tempname;
	    parent_ino := dotdotinode;
	end
	else begin
$if debug$
	    xreport('dot not found');
$end$
	    ioresult := ord(ilostfile);
	    escape(-10);    {Because we think disc must be corrupt. SFB}
	end;
	put_inode(dotdotinodep, [release]);
    end;
end;

function dotdotname(inodep: inode_ptr_type;
		    var parent_ino: integer): string255;
var
    dotdotinodep: inode_ptr_type;
begin
    dotdotinodep := get_inode(parent_inode(inodep));
    dotdotname := dotname(dotdotinodep, parent_ino);
    put_inode(dotdotinodep, [release]);
end;


{-----------------------------------------------------------------------}
{
{ traverse_path
{ traverses a pathname to find named file
{ inodep is
{       on INPUT, where to start if pathname is relative
{       on OUTPUT, ptr to last inode found in path
{ dir_required means last cmpnt should be ignored if it's not a dir;
{       this is set by opendirectory and openparentdir.
{ returns bool showing success
{ gives extra info in pathinfo
{       ino -- inumber of inodep
{       diroff -- offset in directory of name found,
{                 or of free slot if name not found.
{                 "free slot" is one with ino 0, or one with
{                 reclen > entry size, or size of dir file if
{                 dir full.  Used by allocator routines.
{       basename -- name of file if found, or rest of path if not found.
{       parent_ino -- parent of file in inode_ptr.
{ The peculiar semantics (give back lots of info on "failure")
{ are due to FILER usage; it can pass wildcards as last component,
{ and thus we are expected to "fail", but give back enough info anyway.
{ Warning: callers check for ioresult = inofile and basename has no
{ slashes to detect case where all but last component is there.
}
function traverse_path(var path: string;
		       dir_required: boolean;
		       var inodep: inode_ptr_type;
		       var pathinfo: pathinfotype): boolean;
var
    atom     : string255;
    slashpos : shortint;
    inodenum : integer;
    oldatom, oldpath: string255;
    tmpioresult: integer;

{----------------------------}
{
{ Put next component of path into atom,
{ and update path.
}
procedure nextcmpnt;
var
    i: integer;
begin
    setstrlen(atom, 255);
    i := 1;
    { copy to initial / }
    while (i <= strlen(path)) and (path[i] <> '/') do begin
	atom[i] := path[i];
	i := i + 1;
    end;
    setstrlen(atom, i-1);

    { skip next /s }
    while (i <= strlen(path)) and (path[i] = '/') do
	i := i + 1;

    { put remainder into path }
    if i <= strlen(path) then
	path := str(path, i, strlen(path)-i+1)
    else
	path := '';
end;
{----------------------------}
begin {traverse_path}
$if debug$
    report('traverse_path ' + path);
$end$

    pathinfo.parent_ino := no_inode;

    { if path begins /, start at root inode, else start at inodep }
    if strpos('/', path) = 1 then begin
	put_inode(inodep, [release]);
	inodep := get_inode(root_inode);
	pathinfo.parent_ino := root_inode;
	{ lop off initial /s from path }
	repeat
	    path := str(path, 2, strlen(path)-1);
	    slashpos := strpos('/', path);
	until slashpos <> 1;
    end;

    pathinfo.ino := inumber(inodep);

    oldatom := '';
    oldpath := path;
    nextcmpnt;
    while (ioresult = ord(inoerror)) and (atom <> '') do begin
	{ check for dir type now to avoid permission error on non-dir }
	if itype(inodep) <> IFDIR then
	    ioresult := ord(ifilenotdir)
	else
	if permission(inodep, x_permission)
	and foundname(atom, dir_required and (path = ''),
		      inodep, pathinfo) then begin
	    { found, so move to next atom of path }
	    put_inode(inodep, [release]);
	    inodep := get_inode(pathinfo.ino);
	    oldatom := atom;
	    oldpath := path;
	    nextcmpnt;
	end
	else
	if ioresult = ord(inoerror) then
	    ioresult := ord(inofile);
    end;

    if oldpath <> '' then begin
	{ path not exhausted, so failed }
	pathinfo.basename := oldpath;
	traverse_path := false;
    end
    else begin
	{ success; make basename look reasonable }
	if (oldatom = '') or (oldatom = '.') then
	    pathinfo.basename := dotname(inodep, pathinfo.parent_ino)
	else
	if oldatom = '..' then begin
	    { parent inumber never correct in this case }
	    pathinfo.parent_ino := no_inode;
	    pathinfo.basename := dotname(inodep, pathinfo.parent_ino)
	end
	else
	    pathinfo.basename := oldatom;
	traverse_path := true;
    end;

    {
    { if no one has set parent_ino yet, do it explicitly
    { optimization: parent_ino already set if traverse_path
    { succeeded.  If it failed, then ONLY opendirectory and
    { openparentdir care about its value.
    }
    if (pathinfo.parent_ino = no_inode)
    and (request in [opendirectory, openparentdir]) then begin
	{ save ioresult so parent_inode will work }
	tmpioresult := ioresult;
	ioresult := ord(inoerror);
	pathinfo.parent_ino := parent_inode(inodep);
	if ioresult = ord(inoerror) then
	    ioresult := tmpioresult;
    end;

$if debug$
    reportn('traverse path ioresult', ioresult);
$end$
end;

{----------------------------------------------------------------------------}
{
{ We have a successful open/create of file ino.
{ Set up fib fields from fileinfo with info about this file.
{ pathid -- inumber of file
{ foldfileid -- parent inumber
{ fileid -- size of ws hdr (0 if not there)
{ fleof -- 0 if new, size of file if old
{ ftitle -- simple name of file
{ ftid + ffpw -- simple name of file (from ftitle)
{ feft
{ fkind
{ fmodified
{ fstartaddress
{ am
}
procedure finishfib(inodep: inode_ptr_type;
		    parent_ino: integer;
		    var name: string255;
		    var fileinfo: fileinfotype);
begin
    with f do begin
       {see LIFDAM finishfib to see where this was modified from}

       pathid := inumber(inodep);
       foldfileid := parent_ino;
       fmodified := fisnew;

       with fileinfo do begin
	   fileid        := ioffset;
	   feft          := ieft;
	   fkind         := ikind;
	   fstartaddress := istartaddress;
	   if fisnew then
	       fleof     := 0
	   else
	       fleof     := ilogicalsize;
       end;

       ftitle := name;
       if strlen(ftitle) <= tidleng then begin
	   ftid := ftitle;
	   ffpw := '';
       end
       else
       if strlen(ftitle) <= tidleng + passleng then begin
	   ftid := str(ftitle, 1, tidleng);
	   ffpw := str(ftitle, tidleng + 1, strlen(ftitle) - tidleng);
       end
       else begin
$if debug$
	   xreport('finishfib sees name too long');
$end$
	   ioresult := ord(ibadtitle);
	   escape(0);   {Because disc is not corrupt in this case. SFB}
       end;

       if not fbuffered then
	   am := amtable^[untypedfile]
       else
       if fistextvar then
	   am := amtable^[fkind]         {textfib}
       else
	   am := amtable^[datafile];      {not textfib}
    end;
end;


{------------------------------------------------------------------}
{
{ close_fib
{ resets fib values to show file now closed
{ Warning: FILER looks at fpeof AFTER closing fib.  Therefore, we
{ are conservative about resetting fields.
}
procedure close_fib;
begin
    with f do begin
	pathid := no_inode;
	freadable  := false;
	fwriteable := false;
	fmodified  := false;
	fisnew     := false;
    end;
end;

{--------------------------------------------------------------------------}
{
{ zerotimedate
{ set time and date to 1-MAR-0 0:0:0-- the "invalid" time and date
}
procedure zerotimedate(var time: timerec; var date: daterec);
begin
    with time, date do begin
	year        := 0;
	day         := 1;
	month       := 3;
	hour        := 0;
	minute      := 0;
	centisecond := 0;
    end;
end;

{------------------------------------------------------------------------}
{
{ convert a time_t to PWS timerec and daterec
}
procedure hfs_to_PWS_timedate(hfstime: integer;
			      var time: timerec; var date: daterec);
begin
    secs_to_timedate(hfstime - timezone, date, time);
end;


{-----------------------------------------------------------------------}
{
{ octalmode
{ convert a decimal number to a 0-padded 3-digit octal number
}
function octalmode(decmode: integer): string3;
var
    str: string3;
    i: integer;
begin
    setstrlen(str, 3);
    for i := 3 downto 1 do begin
	str[i] := chr(ord('0') + binand(decmode, 7));
	decmode := binlsr(decmode, 3);
    end;
    octalmode := str;
end;

{-------------------------------------------------------------------}
{
{ make_statrec
{ put a stat record into the given cinfo.
{ since the cinfo is really a string, we zero the string length
}
procedure make_statrec(ip: inode_ptr_type; anyvar info: string20);
type
    cinfo_statrec = packed record
	pad         : shortint;
	c_mode      : ushort;
	c_uid       : ushort;
	c_gid       : ushort;
	c_rdev      : integer;
	c_atime     : integer;
	c_ctime     : integer;
    end;
    cinfo_statrecp = ^cinfo_statrec;
var
    t: integer;
begin
    setstrlen(info,0);
    with cinfo_statrecp(addr(info))^, ip^ do begin
	c_mode  := mode;
	c_uid   := uid;
	c_gid   := gid;

	t := itype(ip);
	if (t = IFBLK) or (t = IFCHR) then
	    c_rdev  := db[0]  { maj/min device number }
	else
	    c_rdev := 0;

	c_atime := atime;
	c_ctime := ctime;
    end;
end;

{----------------------------------------------------------------------}
{
{ fill_entry
{ given a catrec and a name + inode ptr
{ fills in the catrec with info about the given file
{ shortcut tells whether to skip reading the ws header
}
procedure fill_entry(var cat: catentry;
		     var thisname: string255;
		     ino: integer;
		     shortcut: boolean;
		     dostatrec: boolean);
label
    999;
type
    filetypechartype = packed array [0..15] of char;
const
    filetypechar = filetypechartype['-pc-d-b- nl-s---'];
    {
    { filetypechar meanings
    {   - undefined
    {   p pipe
    {   c character special
    {   d directory
    {   b block special
    {     (space) regular data file
    {   n network special file
    {   l symbolic link fie
    {   s socket
    }
var
    i, pos: integer;
    fileinfo: fileinfotype;
    ip: inode_ptr_type;
begin
    with cat, superblock^ do begin

	if strlen(thisname) <= tidleng then
	    cname := thisname
	else
	    cname := str(thisname,1,tidleng);

	if shortcut then
	    goto 999;

	ip := get_inode(ino);

	getfileinfo(ip, fileinfo, shortcut);

	{ external file type }
	ceft := fileinfo.ieft;
	{ file kind }
	ckind := fileinfo.ikind;
	{ physical size }
	cpsize := bytes_claimed(ip^.size.ls);
	{ logical size }
	clsize := fileinfo.ilogicalsize;

	cblocksize := fsize;

	zerotimedate(ccreatetime, ccreatedate);
	hfs_to_PWS_timedate(ip^.mtime, clasttime, clastdate);

	{ number of links }
	cextra1 := ip^.nlink;

      { cextra2 := -1;  {removed in 3.2G SFB}
	with fileinfo do
	 if ieft = datafile_eft then  {added in 3.2G;
	     report LIFimplement for all but .UX files, dirs (ieft=3), and
	     special files (ieft=0). SFB}
	  cextra2 := ilogicalsize
	 else
	  if (ieft <> uxfile_eft) and (ieft <> 0) and (ieft <> 3) then
	   cextra2 := istartaddress
	  else
	   cextra2 := -1;

	if dostatrec then begin
	    cstart := inumber(ip);
	    make_statrec(ip, cinfo);
	end
	else begin
	    {
	    { cstart -- "starting address" on disk
	    { FILER will divide by cblocksize, printing inumber
	    }
	    cstart := inumber(ip) * fsize;

	    {
	    { use 19 chars of 20-char cinfo
	    {         1234567890123456789
	    {         TMMMm UUUUUu GGGGGg
	    { T - filetype char
	    { MMM - octal file mode
	    { UUUUU - uid
	    { GGGGG - gid
	    }
	    i := binlsr(itype(ip), 12);
	    setstrlen(cinfo, 0);
	    strwrite(cinfo, 1, pos,
		     filetypechar[i]:1,
		     octalmode(ip^.mode),
		     'm ',
		     ip^.uid:5,
		     'u ',
		     ip^.gid:5,
		     'g');
	end;
	put_inode(ip, [release]);
    end;
999:
end;

{----------------------------------------------------------------------}
{
{ DOCATALOG
{ get catalog info from files in directory
{ fib is open to the directory (via opendirectory)
{       fwindow -- ptr to an array of catentries
{       fpeof -- how many cat entries are there (0..fpeof-1)
{       fpos -- where in directory to start (0-based)
{       fb0 -- false -> full info, true -> short info
{       fb1 -- false -> cinfo is string, true -> cinfo is statrec
{ returns
{       filled cat entries
{       fpeof -- number of entries filled
}
procedure docatalog;
label
    999;
type
    inrec_type = record
	fp: fibp;
	entry: integer;
    end;
var
    inrec: inrec_type;
    numdone: integer;
    pdir: inode_ptr_type;
    oldior: integer;    {for "protecting" ioresult during cleanup. SFB}
{----------------------------}
{
{ find_entry, the scanner for do_catalog
{ looks at dir entry and decides whether to catalog it, and where
{ calls fill_entry to do the cataloging
{ inrec.entry is the number (0-based) of this dir entry
}
procedure find_entry(dp: direntry_ptr_type;
		     offset: integer;
		     anyvar inrec: inrec_type;
		     anyvar numdone: integer;
		     var keep_going: boolean);
label
    999;
type
    catarray = array[0..maxint] of catentry;
    catarray_ptr_type = ^catarray;
var
    thisname: string255;
    catarr: catarray_ptr_type;
    index: integer;
begin
    with dp^ do begin
	{ ino 0 means slot not used }
	if ino = 0 then
	    goto 999;

	{ . and .. don't count }
	pac_to_string(name, namlen, thisname);

	if (thisname = '.') or (thisname = '..') then
	    goto 999;

	with inrec, fp^ do begin
	    { in requested region of directory? }
	    if entry >= fpos then begin
		index := entry - fpos;
		{ cat entry already full? }
		if index >= fpeof then begin
		    keep_going := false;
		    goto 999;
		end;
		catarr := catarray_ptr_type(fwindow);
		fill_entry(catarr^[index], thisname, ino, fb0, fb1);
		numdone := numdone + 1;
	    end;
	    entry := entry + 1;
	end;
    end;
999:
end;
{----------------------------}
begin {docatalog}
    { check input directory }
    if (f.pathid = no_inode) or (f.pathid = raw_inode) then begin
	ioresult := ord(ifilenotdir);
	goto 999;
    end;
    pdir := get_inode(f.pathid);
    if itype(pdir) <> IFDIR then begin
	ioresult := ord(ifilenotdir);
	goto 999;
    end;
    if not permission(pdir, r_permission) then
	goto 999;

    with inrec do begin
	entry := 0;
	fp := addr(f);
    end;
    numdone := 0;

    scan_dir(pdir, find_entry, inrec, numdone);
999:
    f.fpeof := numdone;
    oldior:=ioresult;   {SFB}
    put_inode(pdir, [release]);
    if ioresult=ord(inoerror) then      {SFB}
     ioresult:=oldior;
end;

{----------------------------------------------------------------------}
{
{ open a directory
{ and write dir info into cat
{ openparent true -> open parent of given dir
{ input
{       ftitle -- dir name
{       fb1 -- true if statrec wanted, else false
{ ftitle might include a filename at the end, in which case we
{ open the directory containing the file.
{ results
{       ftitle -- the path after the directory opened
{         e.g.  opendir dir1/dir2 -> ''
{               openparentdir dir1/dir2 -> 'dir2'
{               opendir dir1/file2 -> 'file2'
{       ftid -- simple name of dir opened
}
procedure doopendirectory(anyvar cat: catentry; openparent: boolean);
label
    999;
var
    dname: string255;
    pos: integer;
    dir_ip: inode_ptr_type;
    newtitle: string255;
    pathinfo: pathinfotype;
    fileinfo: fileinfotype;
    avail : integer; {for cextra2 calculation SFB}
    oldior: integer;    {for "protecting" ioresult during cleanup. SFB}
begin
    dir_ip := get_inode(start_path);
    dname := f.ftitle;

    {
    { find the directory to open
    { dir_ip -- dir to open
    { dname -- simple name of this dir
    { newtitle -- ftitle we will return (following rules above)
    }
    if traverse_path(dname, true, dir_ip, pathinfo) then begin
	newtitle := '';
	dname := pathinfo.basename;
    end
    else begin
	{ no error if last cmpnt missing }
	if ioresult <> ord(inofile) then
	    goto 999;
	if strpos('/', pathinfo.basename) <> 0 then
	    goto 999;
	ioresult := ord(inoerror);
	newtitle := pathinfo.basename;
	dname := dotname(dir_ip, pathinfo.parent_ino);
    end;
    if openparent then
	if inumber(dir_ip) = root_inode then
	    newtitle := ''
	else begin
	    newtitle := dname;
	    put_inode(dir_ip, [release]);
	    dir_ip := get_inode(pathinfo.parent_ino);
	    dname := dotname(dir_ip, pathinfo.parent_ino);
	end;
$if debug$
    reportn('opendir, title '+newtitle+' dname '+dname+' ino',
	    inumber(dir_ip));
$end$

    getfileinfo(dir_ip, fileinfo, true);
    { parent_ino can be wrong in case of openparent }
    finishfib(dir_ip, pathinfo.parent_ino, dname, fileinfo);

    { now load up the catalog fields }
    with f, superblock^, cat do begin
	cname       := dname;
	cblocksize  := fsize;
	clsize      := fsize*dsize;
      { with cstotal do {bugfix for 3.2G - compute available disc space SFB}
	  { cextra2    := fsize*(nbfree*frag + nffree); }
	with cstotal do {calculate avail bytes, accounting for minfree SFB}
	 begin {Do it the way 'freespace' in hfscalc does it. SFB}
	  avail := nbfree*frag + nffree - ((dsize*minfree) DIV 100);
	  if avail > 0 then
	   cextra2 := avail*fsize
	  else
	   cextra2 := 0;
	 end;
	zerotimedate(ccreatetime, ccreatedate);
	hfs_to_PWS_timedate(dir_ip^.mtime, clasttime, clastdate);
	if not fb1 then begin
	    { normal request -- no statrec }
	    cpsize      := ueovbytes(unum);
	    cstart      := -1;
	  { cextra1     := -1;  { removed for 3.2G - add "unallocated" SFB}
	    cextra1     := cstotal.nifree; {currently free inode count SFB}
	    setstrlen(cinfo, 0);
	    with dir_ip^ do
		{
		{ use 19 chars of cinfo string
		{ 1234567890123456789
		{ HFS MMM UUUUU GGGGG
		{ MMM - octal mode
		{ UUUUU - uid
		{ GGGGG - gid
		}
		strwrite(cinfo, 1, pos,
			 'HFS ',
			 octalmode(mode),
			 ' ',
			 uid:5,
			 ' ',
			 gid:5);
	end
	else
	with dir_ip^ do begin
	    { statrec requested }
	    cpsize := bytes_claimed(size.ls);
	    cstart := inumber(dir_ip);
	    cextra1 := nlink;
	    make_statrec(dir_ip, cinfo);
	end;
    end;
999:
    f.ftitle := newtitle;
    oldior:=ioresult;   {SFB}
    put_inode(dir_ip, [release]);
    if ioresult=ord(inoerror) then      {SFB}
     ioresult:=oldior;
end;


{-----------------------------------------------------------------------}
{
{ set the volume name
{ the "fib" parameter is really a string with the new name
{ to prevent fsck from saying the superblock is trashed, we must
{ set the fname field in the other copies of the superblock too.
}
procedure dosetvolname;
var
    requested_name: ^string255;
    volname: string[fs_name_len];
    cg, nameoffset: shortint;
    super_ptr: cache_blk_ptr_type;
{---------------}
procedure change_name(anyvar fname: fs_name_type);
var
    i: integer;
begin
    for i := 1 to strlen(volname) do
	fname[i-1] := volname[i];
    for i := strlen(volname)+1 to fs_name_len do
	fname[i-1] := #0;
end;
{---------------}
begin
    requested_name := addr(f);
    if h_unitable^.tbl[unum].prefix <> root_inode then
	ioresult := ord(inotclosed)
    else
    if strlen(requested_name^) <= fs_name_len then begin
	volname := requested_name^;

	{ first the real superblock }
	change_name(superblock^.fname);

	{ then the other copies }
	nameoffset := ord(addr(superblock^.fname)) - ord(superblock);
	for cg := 0 to superblock^.ncg-1 do begin
	    super_ptr := get_datablk(cgsblock(superblock, cg), nameoffset);
	    change_name(super_ptr^[nameoffset mod cache_blk_size]);
	    put_datablk(super_ptr, [dirty,release]);
	end;

	with unitable^[unum] do begin
	    if dkvid = uvid then
		dkvid := volname;
	    if syvid = uvid then
		syvid := volname;
	    uvid := volname;
	end;
    end
    else
	ioresult := ord(ibadtitle);
    put_superblock(superblock,[dirty]);
end;

{--------------------------------------------------------------------------}
{
{ setunitprefix
{ The fib is set up as for openfile or opendirectory.
{ We just use opendirectory to do the work.
}
procedure dosetunitprefix;
label 999;
var
    acatentry: catentry;
    dir_ip: inode_ptr_type;
    oldior: integer;    {for "protecting" ioresult during cleanup. SFB}
begin
    {Added code to disable prefixing on floppies. Need to do this to prevent
     "unreliable prefixing" caused by having dogetvolumename check umediavalid
     and popping prefix if it's false. The trouble is that various pieces of code
     (eg CI) clear umediavalid, even when the floppy has not been popped. SFB}

    dir_ip := nil;
    doopendirectory(acatentry, false);
    if ioresult = ord(inoerror) then begin
	if f.ftitle = '' then begin
	    dir_ip := get_inode(f.pathid);
	    if permission(dir_ip, x_permission) then
	      {stymie attempt to prefix floppy below its root. SFB}
	      if (not unitable^[unum].uisfixed) and (f.pathid <> root_inode) then
	       begin
		ioresult:=ord(ibadrequest);
		goto 999;
	       end
	      else
	       begin
		h_unitable^.tbl[unum].prefix := f.pathid;
		unitable^[unum].uvid := acatentry.cname;
	    end;
	    { if permission fails, ioresult already set to inopermission }
	end
	else
	    ioresult := ord(inofile);
    end;
999:oldior:=ioresult;   {SFB}
    put_inode(dir_ip, [release]);
    if ioresult=ord(inoerror) then      {SFB}
     ioresult:=oldior;
end;

{---------------------------------------------------------------------------}
{
{ makedirectory
{ fib is already open (via opendirectory) to parent directory.
{ fwindow -- a cat entry describing the dir (we use cname only)
}
procedure domakedir;
label
    999;
type
    catentryp = ^catentry;
var
    dirname : string255;
    parent_ip: inode_ptr_type;
    new_inodenum: integer;
    diroff: integer;
    oldior: integer;    {for "protecting" ioresult during cleanup. SFB}
begin
    with f do begin
	dirname := catentryp(fwindow)^.cname;
	good_file_name(dirname);
	parent_ip := get_inode(pathid);

	if not create_ok(parent_ip, dirname, diroff) then
	    goto 999;

	new_inodenum := create_dir(dirname, dir_mode, parent_ip, diroff);
    end;
999:
    oldior:=ioresult;   {SFB}
    put_inode(parent_ip, [release]);
    if ioresult=ord(inoerror) then      {SFB}
     ioresult:=oldior;
end;

{-------------------------------------------------------------------------}
{
{ docreate
{ create a new file
{ We always create a directoryless file, but remember its name
{ so that when it's closed we can make the dir entry.
{ This gets put into directory on close.
{ ftitle -- name of file to be created
}
procedure docreate;
label
    999;
var
    name: string255;
    start_inodep: inode_ptr_type;
    parent_ino: integer;
    pdir: inode_ptr_type;
    new_inodep: inode_ptr_type;
    pathinfo: pathinfotype;
    fileinfo: fileinfotype;

  {SFB fix for 00955, .ux file turns into wsheader file on preallocate}
    zapheader_buf : shortint;
    bn : integer;
    oldior: integer;    {for "protecting" ioresult during cleanup. SFB}

begin
    name := f.ftitle;
    pdir := nil;
    start_inodep := nil;
    new_inodep := nil;

    {
    { Find parent_ino and basename of file.
    { If anonymous, parent_ino is root_inode.
    { Be sure file exists and is writeable, or
    { parent exists and is writeable.
    }
    if f.fanonymous then begin
	pathinfo.basename := 'anonymous';
	pathinfo.parent_ino := root_inode;
    end
    else begin
	start_inodep := get_inode(start_path);
	if traverse_path(name, false, start_inodep, pathinfo) then begin
	    { file must be regular and writeable }
	    if itype(start_inodep) <> IFREG then begin
		ioresult := ord(inoaccess);
		goto 999;
	    end;
	    if not permission(start_inodep, w_permission) then
		goto 999;
	end
	else begin
	    { be sure all but last cmpnt in path exists }
	    if ioresult <> ord(inofile) then
		goto 999;
	    if strpos('/', pathinfo.basename) <> 0 then
		goto 999;
	    ioresult := ord(inoerror);

	    good_file_name(pathinfo.basename);

	    { what we found was the parent of target }
	    pathinfo.parent_ino := pathinfo.ino;
	    pdir := start_inodep;
	    start_inodep := nil;

	    { be sure parent dir writeable }
	    if not permission(pdir, w_permission) then
		goto 999;
	end;
    end;

    {
    { now we have
    { pathinfo.basename -- simple filename
    { pathinfo.parent_ino -- parent inumber for allocator
    { set up fileinfo for finishfib
    }
    with f, fileinfo do begin
	ieft := feft;
	ikind := fkind;
	if ieft = uxfile_eft then
	    ioffset := 0
	else
	    ioffset := wshdr_size;
	ilogicalsize := 0;
	istartaddress := fstartaddress;

	{ fpos shows how much to preallocate }
	if fpos < 0 then
	    { user gave [*], which we ignore }
	    fpos := 0;
	{ round to boundary; else ASCII AM has trouble }
	fpos := roundup(fpos, fblksize);
    end;

    if pdir = nil then
	pdir := get_inode(pathinfo.parent_ino);
$if debug$
    reportn('create file with size', fileinfo.ioffset + f.fpos);
$end$
    new_inodep := alloc_inode(pdir, file_mode, fileinfo.ioffset + f.fpos);
    if new_inodep = nil then
	goto 999;
    finishfib(new_inodep, pathinfo.parent_ino, pathinfo.basename, fileinfo);
    with f do begin
	fpeof := fpos;
	fpos := 0;
	if feft <> uxfile_eft then
	    put_wsheader(new_inodep, fileinfo)
	else
	 if fpeof > 2 then      {SFB fix for 00955}
	  begin
	   zapheader_buf := 0;  {kill leading word of possible wsheader. This
				 word must be 0x8000 to be wsheader}
	   bn := get_dbnum(new_inodep, 0, B_WRITE, 2);
	   if bn <> BMAP_ERROR then
	    put_bytes(f.funit, 2, data_start(superblock, bn),
		      addr(zapheader_buf));
	  end;
    end;
999:
    oldior:=ioresult;   {SFB}
    put_inode(start_inodep, [release]);
    put_inode(new_inodep, [release]);
    put_inode(pdir, [release]);
    if ioresult=ord(inoerror) then      {SFB}
     ioresult:=oldior;
end;

{---------------------------------------------------------------------------}
{
{ doclosefile
{ close the given fib
{ If made with no name, just deallocate inode.
{ If an old file, don't need to do anything (except change wshdr if grew).
{ If a new file, it's not in any directory yet, so we put it there.
{ We have already checked all permissions during the open.
}
procedure doclosefile;
label
    999;
var
    ip, pdir: inode_ptr_type;
    name: string255;
    fileinfo: fileinfotype;
    oldior: integer;    {for "protecting" ioresult during cleanup. SFB}

begin
    pdir := nil; {in case not fisnew or get_inode for ip escapes. SFB}
    ip := nil;  {in case we shortcut the close. SFB}
    try {so we can guarantee fib gets closed. SFB}
    with f do begin
	if pathid = no_inode then
	 begin
	   ioresult := ord(inotopen);
	   goto 999;     {can't get_inode anyway. SFB}
	 end;

	ip := get_inode(pathid);
	{ cannot close a directory with this dam call }
	if itype(ip) = IFDIR then begin
	    ioresult := ord(inotondir);
	    goto 999;
	end;
	if fmodified then begin
	    { need to update ws hdr? }
	    if feft <> uxfile_eft then begin
		with fileinfo do begin
		    ieft := feft;
		    ikind := fkind;
		    ioffset := fileid;
		    istartaddress := fstartaddress;
		    ilogicalsize := fleof;
		end;
		put_wsheader(ip, fileinfo);
		{ use leof from wsheader for changing file size }
		fleof := fileinfo.ilogicalsize;
	    end;
	    { inode size can be beyond leof; correct it now }
	    if change_file_size(ip, fileid + fleof) then
		;
	end;

	{ set time stamps }
	if freadable then
	    time_stamp(ip, [IACC]);
	if fwriteable then
	    time_stamp(ip, [IMOD,ICHG]);
	{ try to avoid errors on read-only disks }
	if not fisnew and not fmodified then
	    put_inode(ip, [stamping]);

	{ if new file, put it in a directory }
	if fisnew then begin
	    pdir := get_inode(foldfileid);
	    if itype(pdir) <> IFDIR then begin
		ioresult := ord(ilostfile);
		goto 999;
	    end;
	    name := ftid + ffpw;
	    enter_file(ip, pdir, name);
	end;
    end;
999:
    { show fib closed }
    recover     {don't leave till fib closed and all released. SFB}
     if escapecode <> -10 then      {guarantee ioresult non-0. SFB}
      ioresult := ord(icorrupt);
    close_fib;
    oldior:=ioresult;   {SFB}
    put_inode(ip, [release]);
    put_inode(pdir, [release]);
    if ioresult=ord(inoerror) then      {SFB}
     ioresult:=oldior;
    if ioresult <> ord(inoerror) then   {exercise main error-handling code.
					 SFB}
     escape(-10);
end;


{------------------------------------------------------------------------}
{
{ purgefile
{ If not in a directory, drop the inode
{ else remove it from dir too.
{ Can also remove directories.
{ diroff tells the offset in the directory.  Normally we don't
{ know this (diroff = -1), but if we do (called from purgename), then
{ we can avoid a directory search in delete_filename.
}
procedure dopurgefile(diroff: integer);
label
    999;
var
    ip, pdir: inode_ptr_type;
    ino: integer;
    name: string255;
    oldior: integer;    {for "protecting" ioresult during cleanup. SFB}
begin
    with f do begin
	pdir := nil;
	ip := get_inode(pathid);

	{ anonymous and new files are easy }
	if ip^.nlink = 0 then begin
	    dealloc_inode(ip);
	    goto 999;
	end;

	{ file is in dir, so be sure dir is writeable }
	pdir := get_inode(foldfileid);
	if not permission(pdir, w_permission) then
	    goto 999;

	{ don't allow removal of root or prefix }
	if in_use(inumber(ip)) then begin
	    ioresult := ord(inotclosed);
	    goto 999;
	end;

	if diroff = -1 then begin
	    name := ftid + ffpw;
	    delete_filename(ip, pdir, name);
	end
	else
	    delete_file(ip, pdir, diroff);
    end;
999:
    oldior:=ioresult;   {SFB}
    if ioresult = ord(inoerror) then
	close_fib;
    put_inode(ip, [release]);
    put_inode(pdir, [release]);
    if ioresult=ord(inoerror) then      {SFB}
     ioresult:=oldior;
end;

{-------------------------------------------------------------------------}
{
{ openold
{ opens an existing file (NOT a directory, unless we're deleting it)
{ ftitle -- name of file to be opened
{ if deleting, we can avoid a little work; we return the dir offset
}
procedure openold(var diroff: integer);
label
    999;
var
    name : string255;
    inodep: inode_ptr_type;
    pathinfo: pathinfotype;
    fileinfo: fileinfotype;
    deleting: boolean;
    ityp: integer;
    oldior: integer;    {for "protecting" ioresult during cleanup. SFB}
begin
    name := f.ftitle;
    inodep := get_inode(start_path);

    { name must exist }
    if not traverse_path(name, false, inodep, pathinfo) then
	goto 999;

    ityp := itype(inodep);
    deleting := false;
    case request of

	duplicatelink,
	purgefile,
	purgename:
	    deleting := true;

	openfile:
	    begin
		ioresult := ord(inoerror);
	    end;

	overwritefile:
	    begin
		if ityp <> IFREG then begin
		    ioresult := ord(inoaccess);
		    goto 999;
		end;
		if not permission(inodep, w_permission) then
		    goto 999;
	    end;

	otherwise
	    begin
$if debug$
		writeln('OPENOLD OTHERWISE');
$end$
		ioresult := ord(zcatchall);
		goto 999;
	    end;
    end;

    { unless dir_ok, must not be a directory (but special files OK) }
    if not deleting and (ityp = IFDIR) then begin
	ioresult := ord(inoaccess);
	goto 999;
    end;

    { dig out fileinfo for finishfib }
    getfileinfo(inodep, fileinfo, deleting);
    finishfib(inodep, pathinfo.parent_ino, pathinfo.basename, fileinfo);

    { set fpeof to inode size minus size for ws header }
    {and possibly adjust fleof. The problem is with BDAT files, where BASIC
     sets inode.size.ls to sizeof(wsheader) + sizeof(BDAT sector) + logical
     file size. Pascal wants inode.size.ls = sizeof(wsheader) + sizeof(wsvolume)
     (ie an integral # of sectors, as if it were LIF). The anomaly shows up when
     the BDAT file doesn't logically fill its last sector, at which time fleof>fpeof,
     which is not nice. Rather than fix finishfib, where fleof is set, we change
     it here. This is because finishfib is called by other routines, and I'm
     too lazy too fix 'em all. No time.

     Never let either fpeof or fleof > inode.size.ls, as that is what HP-UX thinks
     is really in the file, and we have no business going beyond that!

     BASIC may enhance in 5.01 to create only files in which inode.size.ls =
     n*256, which is a little more consistent (logical size is only in one place).
     SFB}

     with f do
      begin
       fpeof := inodep^.size.ls - fileinfo.ioffset;
       if fleof>fpeof then {limit fleof to inode.size.ls - wsheader (if it's there)}
	fleof:=fpeof;
      end;

    { if deleting, hide dir offset in fpos }
    if deleting then
	diroff := pathinfo.diroff;
999:
$if debug$
    reportn('open old file, fleof is', f.fleof);
$end$
    oldior:=ioresult;   {SFB}
    put_inode(inodep, [release]);
    if ioresult=ord(inoerror) then      {SFB}
     ioresult:=oldior;
end;

{-----------------------------------------------------------------------}
{
{ dopurgename
{ just open old file, then use purgefile
{ must save pathid of caller, since could be reused (e.g. FILER)
}
procedure dopurgename;
var
    savepathid: integer;
    diroff: integer;
begin
    savepathid := f.pathid;
    openold(diroff);
    if ioresult = ord(inoerror) then
	dopurgefile(diroff);
    f.pathid := savepathid;
end;

{---------------------------------------------------------------------}
{
{ stretchit
{ stretch file
{ current phys size is fpeof
{ desired phys size is fpos
{ we set fpeof to fpos (or beyond) on success
}
procedure dostretchit;
label
    999;
var
    havebytes, wantbytes, trybytes: integer;
    ip: inode_ptr_type;
    changed: boolean;
    oldior: integer;    {for "protecting" ioresult during cleanup. SFB}
{-----------------------}
procedure stretch(newsize: integer);
begin
    if (havebytes = newsize) then begin
	changed := true;
	if ip^.size.ls <> newsize then begin
	    ip^.size.ls := newsize;
	    put_inode(ip, [dirty]);
	end;
    end
    else
	changed := change_file_size(ip, newsize);
end;
{-----------------------}
begin
$if debug$
    reportn('stretchit -- old fpeof', f.fpeof);
$end$
    with f do begin
	ip := get_inode(pathid);

	{ only stretchable files allowed }
	if not has_blocks(ip) then begin
	    ioresult := ord(inoaccess);
	    goto 999;
	end;

	{ havebytes, wantbytes -- rounded to next disc block }
	havebytes := bytes_claimed(ip^.size.ls);
	wantbytes := bytes_claimed(fpos+fileid);
	trybytes := roundup(wantbytes, superblock^.bsize);
	stretch(trybytes);
	if changed then
	    wantbytes := trybytes
	else
	    stretch(wantbytes);
	if changed then begin
	    fmodified := true;
	    fpeof := wantbytes - fileid;
	end;
    end;
$if debug$
    reportn('stretchit -- new fpeof', f.fpeof);
$end$
999:
    oldior:=ioresult;   {SFB}
    put_inode(ip, [release]);
    if ioresult=ord(inoerror) then      {SFB}
     ioresult:=oldior;
end;

{------------------------------------------------------------------}
{
{ DUPLICATELINK
{ doduplink gets
{               f.vid, f.ftitle, f.funit -- for existing file
{       f.fwindow -- pointer to FIB open to parent of new link, with
{               ftitle the name to be created.
}
procedure doduplink;
label
    999;
var
    old_inodep, parent_inodep: inode_ptr_type;
    parent_inodenum: integer;
    dummy: boolean;
    parent_fibp: fibp;
    linkname: string255;
    pathinfo: pathinfotype;
    oldior: integer;    {for "protecting" ioresult during cleanup. SFB}
begin
    parent_inodep := nil;
    parent_fibp := fibp(f.fwindow);
    linkname := parent_fibp^.ftitle;

    { old file must exist }
    old_inodep := get_inode(start_path);
    if not traverse_path(f.ftitle, false, old_inodep, pathinfo) then
	goto 999;
    f.ftitle := pathinfo.basename;

    { old file must not be directory }
    if itype(old_inodep) = IFDIR then begin
	ioresult := ord(inotondir);
	goto 999;
    end;

    { parent of new file must be writeable directory }
    parent_inodep := get_inode(parent_fibp^.pathid);
    if not create_ok(parent_inodep, linkname, pathinfo.diroff) then
	goto 999;

    link_file(old_inodep, linkname, parent_inodep, pathinfo.diroff);
    if (ioresult = ord(inoerror)) and f.fpurgeoldlink then
	dopurgename;
999:
    oldior:=ioresult;   {SFB}
    put_inode(old_inodep, [release]);
    put_inode(parent_inodep, [release]);
    if ioresult=ord(inoerror) then      {SFB}
     ioresult:=oldior;
end;



{--------------------------------------------------------------------------}
{
{ CHANGENAME
{       fvid, funit, ftitle describe old file
{       fwindow^ is name of new file
}
procedure dochangename;
label
    999;
var
    diroffset: integer;
    old_inodep, parent_inodep: inode_ptr_type;
    cache_ptr: cache_blk_ptr_type;
    dir_ptr: direntry_ptr_type;
    blocknum: integer;
    newname: string255;
    i: integer;
    pathinfo: pathinfotype;
    oldior: integer;    {for "protecting" ioresult during cleanup. SFB}
begin
    parent_inodep := nil;
    cache_ptr := nil;
    newname := string255(f.fwindow^);
    good_file_name(newname);

    { old file must exist }
    old_inodep := get_inode(start_path);
    if not traverse_path(f.ftitle, false, old_inodep, pathinfo) then
	goto 999;

    { remember its directory offset }
    diroffset := pathinfo.diroff;

    { parent directory must be writeable, searchable }
    parent_inodep := get_inode(pathinfo.parent_ino);
    if not create_ok(parent_inodep, newname, pathinfo.diroff) then
	goto 999;

    { be sure not root or a prefix }
    if in_use(inumber(old_inodep)) then begin
	ioresult := ord(inotclosed);
	goto 999;
    end;

    { get access to directory entry }
    blocknum := get_dbnum(parent_inodep, diroffset, B_READ, 0);
    if blocknum = BMAP_ERROR then
	goto 999;
    cache_ptr := get_datablk(blocknum, blkoff(superblock, diroffset));
    dir_ptr := addr(cache_ptr^, diroffset mod cache_blk_size);

    { now change the directory entry }
    with dir_ptr^ do begin
	i := 0;
	while (i < DIRSIZ) and (i+1 <= strlen(newname)) do begin
	    name[i] := newname[i+1];
	    i := i + 1;
	end;
	namlen := i;
	while i < DIRSIZ do begin
	    name[i] := chr(0);
	    i := i + 1;
	end;
    end;
    put_datablk(cache_ptr, [release,dirty]);

999:
    oldior:=ioresult;   {SFB}
    put_inode(parent_inodep, [release]);
    put_inode(old_inodep, [release]);
    if ioresult=ord(inoerror) then      {SFB}
     ioresult:=oldior;
end;

{-----------------------------------------------------------------}
{
{ dogetvolumename
{ Put the vol name into the string f (not a fib this time).
{ If not is_hfsunit, we aren't ready to look at the superblock,
{ so we set name to ''.  This state occurs only when TABLE is
{ in the process of running.
{ Otherwise, we get the superblock.
{ If we get an error, it
{ might be transient, like popping and pushing the disc,
{ which we can ignore, so we just try again with get_superblock.
{ Once we have a superblock, we call medium_back, which
{ resets the uvid if it has been lost (it's lost when an
{ error occurs on the disc, in which case we have set the prefix
{ to the root, and we set the uvid to '').
{ We also check for a weird TABLE result: if there are not enough
{ units for all the hard discs, some of the hard disc can become
{ inaccessible, but there might be an HFS system already on it,
{ taking up the whole device.
{ Yes, this should be fixed in TABLE, but that's not so easy.
}
procedure dogetvolumename;
var
    fibstring: string255ptr;
    base_unum: unitnum;
    tmp_valid: boolean; {SFB}
begin
    if not h_unitable^.tbl[unum].is_hfsunit then
	superblock := nil
    else begin
	{Added code to save umediavalid so check_disk_status gets a look at
	 it. Unblockeddam clears umediavalid, and is called in set_unit.
	 Need to see umediavalid to see if medium changed, then controller
	 status was cleared by another non-HFS dam on same H/W, eg #3. SFB}

	tmp_valid:=unitable^[unum].umediavalid; {SFB}
	base_unum := set_unit(unum);
	unitable^[unum].umediavalid:=tmp_valid; {SFB}
	check_disk_status;
	if ioresult <> ord(inoerror) then begin
	    invalidate_unit(base_unum);
	    medium_gone;
	end;

	{ ignore any errors }
	ioresult := ord(inoerror);

	{ just in case we had umediavalid false on floppy (did no IO) }
	unitable^[unum].umediavalid:=TRUE; {SFB}

	{ now try for the superblock, reading disk if status was bad }
	superblock := get_superblock(unum);


	{
	{ callers (findvolume, e.g) expect that an unrecognizable name
	{ is returned as a null string, not an ioresult
	}
	if ioresult = ord(icorrupt) then
	    ioresult := ord(inoerror);

    end;

    fibstring := addr(f);
    if (superblock = nil) then
	setstrlen(fibstring^, 0)
    else begin
	with unitable^[unum] do begin
	    if uvid = '' then begin
		{ new medium may not be corrupt }
	       {h_unitable^.tbl[base_unum].fs_corrupt := false; {SFB}
		h_unitable^.tbl[base_unum].fs_corrupt :=
		 (superblock^.clean<>chr(FS_CLEAN)); {SFB}
		medium_back(rootname);
	     end;
	    fibstring^ := uvid;
	end;
    end;
end;

{---------------------------------------------------------------------}
{
{ get/set volume date
}
procedure getvdate(anyvar dt: datetimerec);
begin
    secs_to_timedate(superblock^.time - timezone, dt.date, dt.time);
end;

procedure setvdate(anyvar dt: datetimerec);
begin
    superblock^.time := timedate_to_secs(dt.date, dt.time) + timezone;
    put_superblock(superblock, [dirty]);
end;



{-----------------------------------------------------------------------
{ STRIPNAME
{       ftitle contains the path to be processed on entry
{       ftitle contains the 'dirname' of the original ftitle on exit
{              this is the name up to the last slash with slashes at
{              end
{       ftid   contain the 'basename' of the original ftitle on exit
{        +     this is the name from the last slash found in ftitle till
{       ffpw   the end of it.
}
procedure dostripname;
var s: string[255];
    i: integer;
    len: integer;

begin

  with f do
    begin
      len := strlen(ftitle);
      if len <= 0 then
	ioresult := ord(ibadtitle)
      else
	begin
	  setstrlen(s,0);
	  s   := ftitle;
	  i   := len;


	  while (i > 0) and (s[i] <> '/') do
	      i := i-1;

	  if (len - i) > (tidleng + passleng) then
	    ioresult := ord(ibadtitle)
	  else
	    begin
	      {copy basename part to ftid + ffpw}
	      setstrlen(ftid,0);
	      setstrlen(ffpw,0);
	      if (len - i) > tidleng then
		begin
		  strmove(tidleng,s,i+1,ftid,1);
		  strmove((len - i - tidleng),s,i+1+tidleng,ffpw,1);
		end
	      else
		if i <> len then
		  strmove((len - i),s,i+1,ftid,1);

	      {copy dirname part to ftitle}
	      setstrlen(ftitle,0);
	      strmove(i,s,1,ftitle,1);
	    end;
	end;{len > 0}
    end; {with f}
end; {dostripname}


{--------------------------------------------------------------------------}
{SETPASSWORDS
{ fwindow points to a command_array with fpeof elements                    }
{ there are two groups of commands file related and volume related ones    }
{ Those are : hfs_chmod, hfs_chown, hfs_chgrp, hfs_chatime, hfs_chmtime,   }
{             hfs_open (file related)                                      }
{             hfs_login, hfs_umask (volume related)                        }
{
}
procedure dosetpassword;

type
  command_array = array[0..maxint] of h_setpasswd_entry;
  command_arrayptr = ^command_array;

var inode_ptr: inode_ptr_type;
    f_d_name: fid;
    next_command: integer;
    is_vol_command: boolean;
    old_inodenum: integer;
    pathinfo: pathinfotype;

function owner_perm(inodep: inode_ptr_type): boolean;
begin
  if (get_uid = inodep^.uid) or
     (get_uid = 0 {in super_user_id}) then
     owner_perm := TRUE
  else
     owner_perm := FALSE;
end;{owner_perm}

begin

  with f do
   if fpeof > 0 then
      begin
	inode_ptr := NIL;
	next_command := 1;
	is_vol_command := false;
	{check the first command to see to which group it belongs}
	with command_arrayptr(fwindow)^[0] do
	begin
	  case command of
	  hfs_login : begin
		    is_vol_command := true;
		    next_command := 2;
		    if ffpw = '' then
		      {restore default values}
		      begin
			set_uid(paws_uid);
			set_gid(paws_gid);
		      end
		    else
		      {check password}
		      if ffpw = 'Angelika' then
		      {equal to the super user password}
			begin
			  set_uid(0);
			  set_gid(1);
			end
		      else
		      {restore default values}
			begin
			  set_uid(paws_uid);
			  set_gid(paws_gid);
			  ioresult := ord(ibadpass);
			end;
		    {there should be only one command}
		    if fpeof > 1 then
		      ioresult := ord(ibadvalue);
		  end;
	  hfs_umask : begin
		    is_vol_command := true;
		    next_command := 2;
		    h_unitable^.tbl[unum].umask := new_value MOD 512;
		    {there should be only one command}
		    if fpeof > 1 then
		      ioresult := ord(ibadvalue);
		  end;
	  hfs_open  : begin
		    {get the inode of the file/directory}
		    next_command := 2;
		    f_d_name := ftitle;
		    old_inodenum := start_path;
		    inode_ptr    := get_inode(old_inodenum);
		    if ioresult = ord(inoerror) then
		      if traverse_path(f_d_name, false,
				       inode_ptr, pathinfo) then
			begin
			  pathid := inumber(inode_ptr);
			  freadable := false;
			  fwriteable := false;
			end;
		   end;
	  hfs_chown,
	  hfs_chgrp,
	  hfs_chmod,
	  hfs_chatime,
	  hfs_chmtime : begin
		     if (pathid = no_inode) or (pathid = raw_inode) then
		       ioresult := ord(inotopen)
		     else
		       inode_ptr  := get_inode(pathid);
		   end;
	  otherwise ioresult := ord(ibadvalue);
	  end; {case}
	end; {with command_arrayptr(fwindow)^[0]}


	{process further commands}
	while (next_command <= fpeof) and (ioresult = ord(inoerror)) do
	  with command_arrayptr(fwindow)^[next_command -1], inode_ptr^ do
	    begin
	      case command of
		hfs_chmod  : if owner_perm(inode_ptr) then
			   begin
			     mode := iand(mode, IFMT) + iand(new_value, 4095);
			     next_command := next_command +1;
			   end
			 else
			   ioresult := ord(inopermission);
		hfs_chown  : if owner_perm(inode_ptr) then
			   begin
			     uid := new_value;
			     next_command := next_command +1;
			   end
			 else
			   ioresult := ord(inopermission);
		hfs_chgrp  : if owner_perm(inode_ptr) then
			   begin
			     gid := new_value;
			     next_command := next_command +1;
			   end
			 else
			   ioresult := ord(inopermission);
		hfs_chatime: if owner_perm(inode_ptr) or
				 permission(inode_ptr,w_permission) then
			   begin
			     atime := new_value;
			     next_command := next_command +1;
			   end
			 else
			   ioresult := ord(inopermission);
		hfs_chmtime: if owner_perm(inode_ptr) or
				  permission(inode_ptr,w_permission) then
			   begin
			     mtime := new_value;
			     next_command := next_command +1;
			   end
			 else
			   ioresult := ord(inopermission);
		otherwise ioresult := ord(ibadvalue);
	      end;{case}
	    end; {while}

	{number of successfully completed commands }
	fpeof := next_command -1;

	{make the changes to the inode}
	if not is_vol_command then
	  begin
	    time_stamp(inode_ptr,[ICHG]);
	    put_inode(inode_ptr,[release,dirty]);
	  end
      end; {fpeof > 0}
end; {dosetpassword}


{---------------------------------------------------------------}
{CATPASSWORDS
{       fwindow contains an id_ptr
{       if pathid is not valid then catalog the volume info
{       else catalog the info of the file with inode contained in pathid
}
procedure docatpassword;
type id_ptr = ^h_catpasswd_ids;
var inode_ptr: inode_ptr_type;
begin
  with f do
      if (pathid = no_inode) or (pathid = raw_inode) then
	{output volume information}
	with id_ptr(fwindow)^ do
	  begin
	    cat_uid := get_uid;
	    cat_gid := get_gid;
	    cat_umask := h_unitable^.tbl[unum].umask;
	  end
      else
	{output file/directory related information}
	begin
	  inode_ptr  := get_inode(pathid);
	  with id_ptr(fwindow)^, inode_ptr^ do
	    begin
	      cat_uid := uid;
	      cat_gid := gid;
	      cat_mode:= mode;
	    end;
	  put_inode(inode_ptr,[release]);
	end;
end; {docatpassword}

begin {hfsdam}
$if debug$
    if printmesg then
	writeln('DAM request ', request);
$end$
    ioresult := ord(inoerror);
    lockup;

    try

    unitable^[unum].ureportchange := true;
    superblock := nil;
    if request in (wants_superblock + needs_superblock) then begin
	superblock := get_superblock(unum);
	if (superblock = nil) and (request in needs_superblock) then
	    goto 1;
    end;

    case request of
	openfile       : begin
			     f.fisnew := false;
			     openold(junkdiroff);
			 end;
	createfile     : begin
			     f.fisnew := true;
			     docreate;
			 end;
	overwritefile  : begin
			     f.fisnew := false;
			     openold(junkdiroff);
			     if ioresult = ord(inoerror) then begin
				 f.fwriteable := true;
				 f.freadable := false;
				 f.fmodified := true;
				 f.fleof := 0;
			     end
			     else
			     if ioresult = ord(inofile) then begin
				 f.fisnew := true;
				 docreate;
			     end;
			 end;
	closefile      : if f.pathid = raw_inode then begin
			     { ignore any error from get_superblock }
			     ioresult := ord(inoerror);
			     close_fib;
			 end
			 else
			 if superblock <> nil then
			     doclosefile;
	purgefile      : dopurgefile(-1);
	stretchit      : dostretchit;
	changename     : dochangename;
	getvolumename  : dogetvolumename;
	setvolumename  : dosetvolname;
	purgename      : dopurgename;
	getvolumedate  : getvdate(f);
	setvolumedate  : setvdate(f);
	crunch         : { do nothing, as SRMDAM does } ;
	catalog        : docatalog;
	openparentdir,
	opendirectory  : doopendirectory(f.fwindow^,(request=openparentdir));
	closedirectory : close_fib;
	makedirectory  : begin
			   if f.pathid = no_inode then
			       { FILER Zero }
			       ioresult := ord(ibadrequest)
			   else
			   if superblock <> nil then
			       domakedir;
			 end;
	openunit,
	openvolume     : begin
			   f.pathid := raw_inode;
			   unblockeddam(f,unum,request);
			   invalidate_unit(h_unitable^.tbl[unum].base_unum);
			 end;
	setunitprefix  : dosetunitprefix;
	stripname      : dostripname;
	setpasswords   : dosetpassword;
	catpasswords   : docatpassword;
	duplicatelink  : doduplink;
	lockfile       : ioresult := ord(ibadrequest);
	unlockfile     : ioresult := ord(ibadrequest);
	otherwise        begin
			     ioresult := ord(ibadrequest);
			 end;
    end;
1:
    escape(0);
    recover begin       {error handling redone. SFB}
	if escapecode <> 0 then begin
	    nuke_unit(unum);    {show it corrupt, and invalidate in cache. SFB}
	    lockdown;
	    if escapecode <> -10 then
	     escape(escapecode);
	end
	else begin
	    try
	      put_superblock(superblock, [release]);
	      sync;
	    recover nuke_unit(unum);
	    lockdown;
	    if (escapecode <> -10) and (escapecode <> 0) then
	    {either escapecode from sync or original escapecode. SFB}
	     escape(escapecode);
	end;
    end;
end;

procedure install_hfs_dam;
var
    i: integer;
begin
    init_cache;
    init_hfsalloc;
    with h_unitable^ do begin
	init_cache_proc   := init_cache;
	init_unit_proc    := init_hfs_unit;
	config_cache_proc := configure_cache;
	inval_cache_proc  := invalidate_unit;
    end;
end;

end;

import hfs_dam_module, loader;

begin
    install_hfs_dam;
    markuser;
end.

@


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


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


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.1
log
@Automatic bump of revision number for PWS version 3.23c
@
text
@@


49.1
log
@Automatic bump of revision number for PWS version 3.24b
@
text
@@


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


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


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.1
log
@Automatic bump of revision number for PWS version 3.23b
@
text
@@


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


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


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


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.1
log
@Automatic bump of revision number for PWS version 3.2Y
@
text
@@


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.2
log
@removed some escape(-10)s in favor of escape(0) so we won't mark disc
corrupt for escape from good_file_name, etc.
@
text
@@


21.1
log
@Automatic bump of revision number for PWS version 3.2M
@
text
@d281 1
a281 1
	escape(-10);
d371 1
a371 1
	escape(-10);
d415 1
a415 1
	    escape(-10);
d636 1
a636 1
	   escape(-10);
@


20.2
log
@Fixed up main recover block, esp for escapecode <> -10.Fixed doclosefile
to ensure ip initialized, and fib is always closed.
@
text
@@


20.1
log
@Automatic bump of revision number for PWS version 3.2L
@
text
@d1392 3
a1394 1
    pdir := nil;
d1396 6
a1401 3
$if debug$
	report('close file ' + ftid);
$end$
d1447 1
d1449 3
a1452 1
999:
d1458 3
a2280 3
$if debug$
			     report('DAM otherwise !');
$end$
d2286 3
a2288 7
    recover begin
	if (escapecode <> 0) and (escapecode <> -10) then begin
$if debug$
	    xreportn('ESCAPED HFSDAM',ESCAPECODE);
	    freeze;
$end$
	    sync;
d2290 2
a2291 7
	    escape(escapecode);
	end;
	if escapecode = -10 then begin
$if debug$
	    reportn('IORESULT ', ioresult);
$end$
	    invalidate_unit(h_unitable^.tbl[unum].base_unum);
d2294 8
a2301 4
	    put_superblock(superblock, [release]);
$if debug$
	    check_cache;
$end$
a2302 6
	sync;
	lockdown;
$if debug$
	reportn('dam done, ioresult ', ioresult);
	freeze;
$end$
@


19.2
log
@Fixed the "nuke wsheader" when Overwriting to corrupt hfs bug.
@
text
@@


19.1
log
@Automatic bump of revision number for PWS version 3.2K
@
text
@d124 2
d137 5
d1900 3
a1902 1
		h_unitable^.tbl[base_unum].fs_corrupt := false;
@


18.2
log
@General cleanup of ioresult handling around "cleanup" on abortive exit
from DAM. Prep for other, nastier bugfixes.
@
text
@@


18.1
log
@Automatic bump of revision number for PWS version 3.2J
@
text
@d885 1
d961 1
d963 2
d995 1
d1090 1
d1092 2
d1164 1
d1193 4
a1196 1
999:put_inode(dir_ip, [release]);
d1215 1
d1228 1
d1230 2
d1258 1
d1358 1
d1362 2
d1382 2
d1438 1
d1441 2
d1463 1
d1494 1
d1499 2
d1520 1
d1604 1
d1606 2
d1643 1
d1689 1
d1691 2
d1713 1
d1740 1
d1743 2
d1767 1
d1816 1
d1819 2
@


17.3
log
@Fixed "unreliable floppy cache after Volumes" bug. This fix required
disabling prefixing down paths on floppies.
hfsupport has related fixes.
AMIGO and MINI need related fixes
@
text
@@


17.2
log
@Fixed copy BDAT problem (get unexpected EOF). Now set fleof <= fpeof.
@
text
@d1152 1
d1157 5
d1167 9
a1175 1
	    if permission(dir_ip, x_permission) then begin
d1184 1
a1184 1
    put_inode(dir_ip, [release]);
d1803 1
d1808 6
d1815 1
d1825 3
d1831 1
d1850 1
a1850 1
	    end;
@


17.1
log
@Automatic bump of revision number for PWS version 3.2I+
@
text
@d1530 22
a1551 1
    f.fpeof := inodep^.size.ls - fileinfo.ioffset;
@


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


15.2
log
@Fixed "off-by-one" available blocks in FILER listing trailer
@
text
@@


15.1
log
@Automatic bump of revision number for PWS version 3.2H
@
text
@d990 1
a990 1
    free, used, allocblks, avail : integer; {for cextra2 calculation SFB}
d1041 2
a1042 5
	 begin  {see source for HP-UX 'df' command (df.c) SFB}
	  free := nbfree*frag + nffree;
	  used := dsize - free;
	  allocblks := dsize * (100 - minfree) div 100;
	  avail := allocblks - used + 1 {fudge factor: df.c has bug. SFB};
@


14.2
log
@Fixes for revised enumerated hfs passwd commands in MISC
@
text
@@


14.1
log
@Automatic bump of revision number for PWS version 3.2G
@
text
@d1890 3
a1892 3
{ Those are : chmod, chown, chgrp, chatime, chmtime,                       }
{             open (file related)                                          }
{             login, umask (volume related)                                }
d1929 1
a1929 1
	  login : begin
d1957 1
a1957 1
	  umask : begin
d1965 1
a1965 1
	  open  : begin
d1980 5
a1984 5
	  chown,
	  chgrp,
	  chmod,
	  chatime,
	  chmtime : begin
d2000 1
a2000 1
		chmod  : if owner_perm(inode_ptr) then
d2007 1
a2007 1
		chown  : if owner_perm(inode_ptr) then
d2014 1
a2014 1
		chgrp  : if owner_perm(inode_ptr) then
d2021 2
a2022 1
		chatime: if owner_perm(inode_ptr) or permission(inode_ptr,w_permission) then
d2029 2
a2030 1
		chmtime: if owner_perm(inode_ptr) or permission(inode_ptr,w_permission) then
@


13.2
log
@Fixed: available space vs minfree residue problem
       now display lifimplement in extension2 (wsheader only)
       FILER shows "unallocated" inodes (requird FILER fix)
@
text
@@


13.1
log
@Automatic bump of revision number for PWS version 3.2F
@
text
@a809 1
	cextra2 := -1;
d811 12
d990 1
d1038 13
a1050 2
	with cstotal do
	    cextra2    := fsize*(nbfree*frag + nffree);
d1057 2
a1058 1
	    cextra1     := -1;
@


12.2
log
@Fixed .UX file preallocation filetype "spoofing". See comments "SFB"
bug #0955
@
text
@@


12.1
log
@Automatic bump of revision number for PWS version 3.2E
@
text
@d1203 5
d1293 11
a1303 1
	    put_wsheader(new_inodep, fileinfo);
@


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


10.4
log
@Fix for FSDat00867. Write all superblock copies when volume name changes
@
text
@@


10.3
log
@Fix for FSDat00868 -- Problems if file in root dir with same name as volume
@
text
@d1072 2
d1079 6
a1084 1
    i: shortint;
d1086 7
d1099 10
a1108 5
	with superblock^ do begin
	    for i := 1 to strlen(volname) do
		fname[i-1] := volname[i];
	    for i := strlen(volname)+1 to fs_name_len do
		fname[i-1] := #0;
d1110 1
@


10.2
log
@Fix for FSDat00850. Moved and corrected permission checks.
@
text
@d1003 9
a1011 6
    if openparent then begin
	newtitle := dname;
	put_inode(dir_ip, [release]);
	dir_ip := get_inode(pathinfo.parent_ino);
	dname := dotname(dir_ip, pathinfo.parent_ino);
    end;
@


10.1
log
@Automatic bump of revision number for PWS version 3.2C
@
text
@d176 1
a176 1
    if not permission(pdir, w_permission) then
a1013 4
    { must have execute permission to name a directory }
    if not permission(dir_ip, x_permission) then
	goto 999;

d1110 1
d1112 1
d1116 6
a1121 2
	    h_unitable^.tbl[unum].prefix := f.pathid;
	    unitable^[unum].uvid := acatentry.cname;
d1126 1
@


9.2
log
@FSDat00742 -- inoaccess returned for open on directory
FSDat00728 -- no overwrite or createfile allowed for special files
@
text
@@


9.1
log
@Automatic bump of revision number for PWS version 3.2B
@
text
@d1196 5
a1200 1
	    { file must be writeable }
d1414 1
d1423 1
d1438 8
a1445 2
	    if not permission(inodep, w_permission) then
		goto 999;
d1458 2
a1459 2
    if not deleting and (itype(inodep) = IFDIR) then begin
	ioresult := ord(inotondir);
@


8.4
log
@FSDat00562 opendirectory puts directory mtime in clastdate,clasttime
FSDat00666,670  Always sync after hfsdam call. Actual defects are 
bad file system reactions to corrupt disc.
FSDat00696 (?) Allow "/" in filenames relative to current directory.
@
text
@@


8.3
log
@FSDat00561 -- Round preallocated file size to 512-byte boundary
FSDat00563 -- Implement getvolumedate/setvolumedate 
@
text
@a29 1
    fs,
a76 13
      { needs a sync.  omit createfile, stretchit for speed }
      needs_sync = [getvolumename,
		    setvolumename,
		    setvolumedate,
		    changename,
		    purgename,
		    closefile,
		    purgefile,
		    makedirectory,
		    duplicatelink,
		    setpasswords];


d83 1
a246 1
{            BUT the name (ftitle) can't have slashes
a255 8
	if (pathid <> raw_inode) and (strpos('/', ftitle) <> 0) then begin
$if debug$
	    xreport('start_path sees bad title');
$end$
	    ioresult := ord(ibadtitle);
	    escape(-10);
	end
	else
d1030 1
a1035 1
	    hfs_to_PWS_timedate(superblock^.time, clasttime, clastdate);
a1059 1
	    hfs_to_PWS_timedate(mtime, clasttime, clastdate);
d1399 1
a1399 1
{ if deleting, we can avoid a little work; we hide the dir offset in fpos.
d1401 1
a1401 1
procedure openold;
d1460 1
a1460 1
	f.fpos := pathinfo.diroff;
d1477 1
d1480 1
a1480 1
    openold;
d1482 1
a1482 1
	dopurgefile(f.fpos);
d1721 1
a1721 3
    if (superblock = nil)
    or (unitable^[unum].umaxbytes < fragstobytes(superblock,
						 superblock^.size)) then
d2029 1
a2029 1
			     openold;
d2037 1
a2037 1
			     openold;
d2123 1
a2123 2
	if (request in needs_sync) or (escapecode <> 0) then
	    sync;
@


8.2
log
@Temp. fix for FSDat00675. Filer shows 0 for eft on Hp-ux
files if UXTEXT_AM not installed. Should be fixed in standardam.
@
text
@d69 2
d81 1
d1264 2
d1759 8
d1768 8
d2088 2
a2089 2
	getvolumedate  : ioresult := ord(ibadrequest);
	setvolumedate  : ioresult := ord(ibadrequest);
@


8.1
log
@Automatic bump of revision number for PWS version 3.2A
@
text
@d234 1
a234 1
	    ieft := efttable^[ikind];
@


7.2
log
@Decision about whether to write ws header is now based on 
feft, NOT fkind.  Otherwise, header appears with UX files
if UXTEXT_AM is not present.
@
text
@@


7.1
log
@Automatic bump of revision number for PWS version 3.2l
@
text
@d1250 1
a1250 1
	if ikind = uxfile then
d1275 1
a1275 1
	if fkind <> uxfile then
d1314 1
a1314 1
	    if fkind <> uxfile then begin
@


6.2
log
@Finish fixing FILER Dup/Move bug (DAM ignored fpurgeoldlink);
previous "fix" brought zcatchall because of missing label in 
openold case statement.
@
text
@@


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


5.3
log
@Fix bug where a FILER Change of a volume name, when volume was not
at root, would change real volume name instead of dir name.
Also, when setvolumename called, change dkvid and syvid also
if necessary.
@
text
@@


5.2
log
@openfile ignores permissions, since it is called for reading, writing,
and deleting.
Observe fpurgeoldlink; otherwise, FILER Move fails (result is Duplink).
@
text
@d1101 3
d1112 7
a1118 1
	unitable^[unum].uvid := volname;
@


5.1
log
@Automatic bump of revision number for PWS version 3.2j
@
text
@d1403 90
a1595 1
    { fall through with any ioresult from link_file }
d1597 2
a1999 93

{-------------------------------------------------------------------------}
{
{ openold
{ opens an existing file (NOT a directory, unless we're deleting it)
{ ftitle -- name of file to be opened
{ if deleting, we can avoid a little work; we hide the dir offset in fpos.
}
procedure openold;
label
    999;
var
    name : string255;
    inodep: inode_ptr_type;
    pathinfo: pathinfotype;
    fileinfo: fileinfotype;
    deleting: boolean;
begin
    name := f.ftitle;
    inodep := get_inode(start_path);

    { name must exist }
    if not traverse_path(name, false, inodep, pathinfo) then
	goto 999;

    deleting := false;
    case request of

	purgefile,
	purgename:
	    deleting := true;

	openfile:
	    begin
		if not permission(inodep, r_permission)
		and not permission(inodep, w_permission) then
		    goto 999;
		ioresult := ord(inoerror);
	    end;

	overwritefile:
	    if not permission(inodep, w_permission) then
		goto 999;

	otherwise
	    begin
$if debug$
		writeln('OPENOLD OTHERWISE');
$end$
		ioresult := ord(zcatchall);
		goto 999;
	    end;
    end;

    { unless dir_ok, must not be a directory (but special files OK) }
    if not deleting and (itype(inodep) = IFDIR) then begin
	ioresult := ord(inotondir);
	goto 999;
    end;

    { dig out fileinfo for finishfib }
    getfileinfo(inodep, fileinfo, deleting);
    finishfib(inodep, pathinfo.parent_ino, pathinfo.basename, fileinfo);

    { set fpeof to inode size minus size for ws header }
    f.fpeof := inodep^.size.ls - fileinfo.ioffset;

    { if deleting, hide dir offset in fpos }
    if deleting then
	f.fpos := pathinfo.diroff;
999:
$if debug$
    reportn('open old file, fleof is', f.fleof);
$end$
    put_inode(inodep, [release]);
end;

{-----------------------------------------------------------------------}
{
{ dopurgename
{ just open old file, then use purgefile
{ must save pathid of caller, since could be reused (e.g. FILER)
}
procedure dopurgename;
var
    savepathid: integer;
begin
    savepathid := f.pathid;
    openold;
    if ioresult = ord(inoerror) then
	dopurgefile(f.fpos);
    f.pathid := savepathid;
end;
@


4.4
log
@Remove references to hfs_user module.
@
text
@@


4.3
log
@When medium changes, clear fs_corrupt bit.  This fixes bug where a
floppy swap could leave the bit set.
@
text
@d19 1
a19 1
$search 'hfs', 'hfs_user'$
@


4.2
log
@Don't set fb0 for uxfile -- this was an old idea, long gone, and
the code interferes with fb0/fb1 usage by uxam.
@
text
@d1643 3
a1645 1
	    if uvid = '' then
d1647 1
@


4.1
log
@Automatic bump of revision number for PWS version 3.2i
@
text
@a601 1
{ fb0 -- true if file is uxfile (no wshdr)
a631 2

       fb0 := (fkind = uxfile);
@


3.4
log
@Detect makedirectory from FILER Zero (pathid = no_inode) and
return ibadrequest.
Detect setvolumename with name too long (> 6 chars), and retun ibadtitle.
make that RETURN ibadtitle.
@
text
@@


3.3
log
@In openunit/openvolume, set pathid before calling unblockeddam.
Otherwise, unblockeddam can call TM before pathid set.
@
text
@a63 1
			makedirectory,
d73 2
a74 1
      wants_superblock = [closefile];
d1104 10
a1113 2
    if strlen(requested_name^) <= fs_name_len then
	volname := requested_name^
d1115 1
a1115 8
	volname := str(requested_name^, 1, fs_name_len);
    with superblock^ do begin
	for i := 1 to strlen(volname) do
	    fname[i-1] := volname[i];
	for i := strlen(volname)+1 to fs_name_len do
	    fname[i-1] := #0;
    end;
    unitable^[unum].uvid := volname;
d2066 8
a2073 1
	makedirectory  : domakedir;
@


3.2
log
@$if debug$ (off) around debugging stuff.
overwritefile turns into createfile if file doesn't exist
(SRM and LIF both do this).
@
text
@d2068 1
a2069 1
			   f.pathid := raw_inode;
@


3.1
log
@Automatic bump of revision number for PWS version 3.2h
@
text
@d1 1
a1 1
$LINENUM 1000$
d3 2
a4 1
$LINES 54$
d6 2
a7 1
$MODCAL$
a13 3
{ MUST have partial eval }
$partial_eval on$

a17 1
$ALLOW_PACKED ON$
d19 1
a19 1
$SEARCH 'hfs'$
d40 2
d48 1
a48 1
$INCLUDE 'wsheader'$
d95 1
a95 1
  $INCLUDE 'wsbody'$
d111 1
a111 1
    headerbuf   : eftheaderbuftype;
d114 1
d116 1
d268 3
a271 1
	    xreport('start_path sees bad title');
d289 3
a292 1
	xreport('good_file_name sees bad title');
d372 1
d374 1
d379 3
a382 1
	xreport('parent_inode failed');
d412 1
d414 1
d423 1
d425 1
d510 1
d512 1
d589 1
d591 1
d647 3
a650 1
	   xreport('finishfib sees name too long');
d1031 1
d1034 1
d1258 1
d1260 1
d1296 1
d1298 1
d1435 3
a1437 1
reportn('stretchit -- old fpeof', f.fpeof);
d1461 3
a1463 1
reportn('stretchit -- new fpeof', f.fpeof);
d1953 7
a1959 1
	    writeln('OPENOLD OTHERWISE');
d1979 3
a1981 1
reportn('open old file, fleof is', f.fleof);
d2003 1
d2006 1
d2037 5
d2080 1
d2082 1
d2090 1
d2092 2
d2095 1
a2096 1
	    freeze;
d2099 1
d2101 1
d2105 4
a2108 8
	    try
		put_superblock(superblock, [release]);
	    recover
		reportn('escape in put_super ', ioresult);
	    try
		check_cache;
	    recover
		report('escape in check_cache');
d2110 7
a2116 11
	try
	    if (request in needs_sync) or (escapecode <> 0) then
		sync;
	recover
	    reportn('escape in sync ', ioresult);
	try
	    lockdown;
	recover
	     report('lockdown failed');
       reportn('dam done, ioresult ', ioresult);
       freeze;
a2141 42


{
{ testing
{  FILER, EDITOR, TREE
}
{
DOCUMENTATION NOTE
 files on heap can lead to lost space on disc if not closed
 also, files in ploaded program
}
{
interrupt during filecopy -- bad file system
redo tmp files?
}
{
run BACKUP on #3 (LIF), table of contents.  Someone calls
HFSdam (opendir, openparent).  Why???
}
{
uxtextam -- treat tabs correctly
}
{
inode time stamp and corruption -- put_bytes escapes, but if this
happens in get_buf (buffer is dirty), don't want to escape.
Try: check for corrupt in get_buf.
}
{
LIF overwritefile -- if file not there, same as createfile!
(but not UCSD)
}
{
FS sets readable/writeable (modified?)
should the DAM leave these alone?
}
{
still to go
	review all code once more
	$if out all panics?
	overwritefile?
	time stamping on read-only disks
}
@


2.15
log
@Avoid write errors when trying to time _stamp on a read-only disk.
@
text
@@


2.14
log
@closedir -- doesn't need superblock.
Add "needs_sync" -- set of requests needing a sync.  We omit
stretchit and createfile for speed.
Fast catalog now doesn't even read inode -- only the name is accurate.
closefile -- time stamp a little earlier to save an inode write.
@
text
@d1303 3
d2132 7
@


2.13
log
@purgename tested fanonymous and fisnew, but these are not
set by FILER.  Better test (for files in no dir) is
nlink = 0, which is now there,
@
text
@a65 1
			closedirectory,
d76 12
d756 1
a756 1
		     ip: inode_ptr_type;
d759 2
d780 1
a781 2
    getfileinfo(ip, fileinfo, shortcut);

d789 7
d845 1
d847 1
a894 1
    ip: inode_ptr_type;
a917 1
		ip := get_inode(ino);
d919 1
a919 2
		fill_entry(catarr^[index], thisname, ip, fb0, fb1);
		put_inode(ip, [release]);
d1297 7
a1303 2
	if fmodified then
	    reportn('close: new size (w/hdr)', ip^.size.ls);
a1311 1
	    report('close -- calling enter_file');
a1313 5
	{ set time stamps }
	if freadable then
	    time_stamp(ip, [IACC]);
	if fwriteable then
	    time_stamp(ip, [IMOD,ICHG]);
a1390 2
    extra: integer;
    filetype: integer;
d1411 1
a1411 4
	filetype := itype(ip);
	if (filetype = IFDIR)
	or (filetype = IFCHR)
	or (filetype = IFBLK) then begin
d1962 2
a1963 2
    reportn('in dam request ',ord(request));
    reportn('memavail ', memavail);
d2041 1
d2060 2
a2061 1
	    sync;
@


2.12
log
@Debug etc now off.
@
text
@d1328 2
a1329 2
	{ anonymous files are easy }
	if fanonymous or fisnew then begin
@


2.11
log
@stretchit -- only stretch stretchable files (no dirs, dev specials).
getvolumename -- check_disk_status here, not in get_superblock.
@
text
@d7 3
a9 1
{$range off$ $ovflcheck off$ {want to enable this line when finished}
d11 1
a11 1
$debug ON$                  {debug OFF when finished}
@


2.10
log
@Permission function gone; now in hfsalloc.
opendirectory/openparentdir now requires x permission on the dir.
getvolumename bug: set itoobig where should have just returned empty
volume name.
openfile now requires r OR w permission; checked more precisely in HFSTM.
@
text
@a997 3
    { set some fields to prevent accidental use of fib }
    close_fib;

d1366 2
d1373 1
d1392 10
a1414 1
	put_inode(ip, [release]);
d1417 2
d1564 1
d1569 6
a1574 1
	superblock := get_superblock(unum);
d1576 1
a1576 1
	{ ignore any get_superblock errors }
d1579 2
a1580 3
	{ retry }
	if superblock = nil then
	    superblock := get_superblock(unum);
a1985 1
			     goto 1;
d1988 1
a1988 3
			 if superblock = nil then
			     goto 1
			 else
a2098 6
require execute permission for setunitprefix
}
{
openfile -- can come from reset or open.  what are right perms in open?
}
{
d2107 2
a2108 1
go over section in SDG end of DAM chapter
a2112 1
(check LIFDAM)
@


2.9
log
@Rootname (default volume name) now 'hfs'+base_unit, not 'hfs'+unit.
Otherwise, two units prefixed to root on same device could
have two different volume names.
@
text
@a78 9
  type
      permission_type = integer;

  const
      no_permission = 0;
      x_permission  = 1;
      w_permission  = 2;
      r_permission  = 4;

a151 40
{-----------------------------------------------------------------------}
{
{ Tell whether user has given permission on given inode.
{ Sets ioresult to inopermission if not.
{ Uses HP-UX algorithm: look at the "most privileged" category
{     only, with no second or third try.
}
function permission(inodep: inode_ptr_type;
		    perm_needed: permission_type): boolean;
var
    themode: packed record case boolean of
	      true : (num: ushort);
	      false: (pad: 0..127;
		      usr: 0..7;
		      grp: 0..7;
		      oth: 0..7);
	     end;
    sameuser, samegroup: boolean;
    tmp_perm: boolean;
begin
    if get_uid = 0 {superuser} then
	permission := true
    else begin
	themode.num    := inodep^.mode;
	sameuser       := get_uid = inodep^.uid;
	samegroup      := get_gid = inodep^.gid;

	if sameuser then
	    tmp_perm := (iand(themode.usr, perm_needed) = perm_needed)
	else
	if samegroup then
	    tmp_perm := (iand(themode.grp, perm_needed) = perm_needed)
	else
	    tmp_perm := (iand(themode.oth, perm_needed) = perm_needed);
	if not tmp_perm then
	    ioresult := ord(inopermission);
	permission := tmp_perm;
    end;
end;

d994 4
d1547 1
a1547 1
{ taking up the whole device.  We return itoobig in that case.
d1576 3
a1578 1
    if superblock = nil then
a1584 2
	    if umaxbytes < fragstobytes(superblock, superblock^.size) then
		ioresult := ord(itoobig);
a1849 1
{ openpermissions are the permissions we must have
d1851 1
a1851 2
{ deleting -- true if called from purgename; we can avoid a little work
{ in this case; we hide the dir offset in the fpos.
d1853 1
a1853 2
procedure openold(openpermissions: permission_type;
		  deleting: boolean);
d1861 1
d1870 23
a1898 4
    { must have the requested permissions }
    if not permission(inodep, openpermissions) then
	goto 999;

d1925 1
a1925 1
    openold(no_permission, true);
d1950 1
a1950 1
			     openold(r_permission, false);
d1958 1
a1958 1
			     openold(w_permission, false);
d2090 16
@


2.8
log
@change in dosetpassword, use iand to set only last 12 bit of mode with chmod.
@
text
@d379 1
a379 1
	    strwrite(tempname, 1, i, 'hfs', unum:1);
@


2.7
log
@Pws2unix automatic delta on Tue Aug 19 10:31:55 MEZ 1986
@
text
@d1808 1
a1808 1
			     mode := (mode DIV 4096) + (new_value MOD 4096);
@


2.6
log
@getvolumename works (returns '') even when not yet is_hfsunit.
catalog puts inumber in cstart if statrec (otherwise inumber * fblksize).
@
text
@d1757 1
a1757 1
			  ioresult := ibadpass;
@


2.5
log
@if wrong password in login then set default uid and gid.
@
text
@d73 1
a73 2
      wants_superblock = [getvolumename,
			  closefile];
d763 2
d771 7
a777 1
	c_rdev  := db[0]; { maj/min device number }
a832 5
	{
	{ cstart -- "starting address" on disk
	{ FILER will divide by cblocksize, printing inumber
	}
	cstart := inumber(ip) * fsize;
d842 4
a845 2
	if dostatrec then
	    make_statrec(ip, cinfo)
d848 6
d1577 7
a1583 4
{ put the vol name into the string f (not a fib this time).
{ We have already called get_superblock.
{ If we don't have a superblock, there has been some error.  But the
{ error might be transient, like popping and pushing the disc,
d1599 3
a1601 5
    { ignore any get_superblock errors }
    ioresult := ord(inoerror);

    { retry }
    if superblock = nil then
d1604 1
a1604 5
    {
    { callers (findvolume, e.g) expect that an unrecognizable name
    { is returned as a null string, not an ioresult
    }
    if ioresult = ord(icorrupt) then
d1607 13
d2112 6
@


2.4
log
@take only last 12 bits of mode in chmod and last 9 bits in umask.
@
text
@d1735 1
a1735 1
			  {set_uid(paws_uid);
d1737 1
a1737 1
			  ioresult := ibadpass;}
@


2.3
log
@setpassword open command starts now with start_path to open 'ftitle'
@
text
@d69 1
a1706 3
     if (fvid <> unitable^[funit].uvid) and (fvid <> rootname) then
       ioresult := ord(zmediumchanged)
     else
d1726 2
a1727 1
		      {if ffpw equal to the super user password then}
d1731 2
a1732 2
			end;
		      {else
d1746 1
a1746 1
		    h_unitable^.tbl[unum].umask := new_value;
d1788 1
a1788 1
			     mode := new_value;
a1848 3
    if (fvid <> unitable^[funit].uvid) and (fvid <> rootname) then
      ioresult := ord(zmediumchanged)
    else
@


2.2
log
@check_root_uvid -> medium_back, now in support.
let put_wsheader adjust fleof to 256-byte boundary if needed.
set itoobig in getvoluemename if fs size bigger than umaxbytes.
@
text
@d1756 1
a1756 1
		    old_inodenum := h_unitable^.tbl[unum].prefix;
@


2.1
log
@Auto bump rev number to 2.1 for sys 3.2e.
@
text
@a971 15
{------------------------------------------------------------------}
{
{ check_root_uvid
{ We have a valid superblock.  If the uvid was lost (set to ''),
{ we can now reset it correctly.
}
procedure check_root_uvid;
begin
    with unitable^[unum], h_unitable^.tbl[unum] do
	if is_hfsunit
	and (prefix = root_inode)
	and (uvid = '') then
	    uvid := rootname;
end;

a1296 3
	    { inode size can be beyond leof; correct it now }
	    if change_file_size(ip, fileid + fleof) then
		;
d1307 2
d1310 3
d1571 1
a1571 1
{ Once we have a superblock, we call check_root_uvid, which
d1575 5
d1603 7
a1609 2
	check_root_uvid;
	fibstring^ := unitable^[unum].uvid;
a2089 6
what about system files?  startaddr comes from where?
}
{
check root uvid -- get them all?
}
{
d2094 2
a2095 16
change LIF and WS1.0 DAMs to recognize fkind7 hdrs
}
{
try mediainit on hfs device -- escape -10 in TM???
try again after mediainit bug fix
}
{
can we have HFS at beginning of disc and LIF at end?
why must HFS live at beginning of disc?
}
{
test invalidate_unit (mkfs, e.g.) and base_unum accuracy
}
{
fs can be too big for unit as a result of TABLE chucking
extra volumes.
@


1.45
log
@Permission accepts uid 0 as superuser.
Invalidate base unit with openunit/openvolume.
@
text
@@


1.44
log
@Change "uxkind" to "uxfile".
@
text
@d181 6
a186 3
    themode.num    := inodep^.mode;
    sameuser       := get_uid = inodep^.uid;
    samegroup      := get_gid = inodep^.gid;
d188 12
a199 11
    if sameuser then
	tmp_perm := (iand(themode.usr, perm_needed) = perm_needed)
    else
    if samegroup then
	tmp_perm := (iand(themode.grp, perm_needed) = perm_needed)
    else
	tmp_perm := (iand(themode.oth, perm_needed) = perm_needed);
    if not tmp_perm then
	ioresult := ord(inopermission);
    permission := tmp_perm;
 end;
d2034 1
a2034 1
	    invalidate_unit(unum);
d2115 4
@


1.43
log
@closefile works on fibs with pathid = raw_inode (from openunit
and openvolume).  doesn't require superblock in this case.
Name of '..' incorrectly found (e.g. FILER prefix ..).
getvolumename -- no ioerror if name "missing" (icorrupt); this
info callers expect only in form of null string (e.g. findvolume).
purgename -- save old pathid, as filer uses same fib for
multiple calls.
@
text
@d263 1
a263 1
	    ikind := uxkind;
d277 1
a277 1
	    ikind := uxkind;
d616 1
a616 1
{ fb0 -- true if file is uxkind (no wshdr)
d648 1
a648 1
       fb0 := (fkind = uxkind);
d1249 1
a1249 1
	if ikind = uxkind then
d1272 1
a1272 1
	if fkind <> uxkind then
d1312 1
a1312 1
	    if fkind <> uxkind then begin
@


1.42
log
@Call invalidate_unit with openunit and openvolume.
@
text
@a59 1
			closefile,
d72 2
a73 1
      wants_superblock = [getvolumename];
d582 1
a582 1
	    pathinfo.basename := dotdotname(inodep, pathinfo.parent_ino)
d687 1
a687 1
	pathid     := no_inode;
a1364 1
    filetype: integer;
a1370 1
	filetype := itype(ip);
d1501 1
d1596 7
a1612 1

a1873 1

d1925 17
d1977 11
a1987 1
	closefile      : doclosefile;
d1993 1
a1993 5
	purgename      : begin
			     openold(no_permission, true);
			     if ioresult = ord(inoerror) then
				 dopurgefile(f.fpos);
			 end;
a2091 3
openvolume/openunit
}
{
d2110 1
a2110 6
run HFSTABLE
assigns HFS to floppy #43 (force)
filer list #43
in check_disc_status, calls old TM
this apparently recurses infinitely, and bombs -2
note -- disc in #43 is not HFS
@


1.41
log
@implementation of openunit/openvolume
@
text
@d1979 1
@


1.40
log
@change ctime in inode is not available on HP-UX, therefore it 
was also taken out of HFSDAM.
@
text
@d1975 5
a1979 2
	openunit       : ioresult := ord(ibadrequest);
	openvolume     : ioresult := ord(ibadrequest);
@


1.39
log
@Debugging printout changes.
Changes to make table work -- set up h_unitable procedures.
@
text
@d1667 1
a1667 2
{ fwindow points to a catarray with fpeof elements                         }
{ command contains the command string.                                     }
d1669 1
a1669 1
{ Those are : chmod, chown, chgrp, chatime, chmtime, chctime,              }
a1683 1
    chctime_flag: boolean;
a1706 1
	chctime_flag := true;
d1765 1
a1765 2
	  chmtime,
	  chctime :  begin
a1815 8
		chctime: if owner_perm(inode_ptr) or permission(inode_ptr,w_permission) then
			   begin
			     ctime := new_value;
			     chctime_flag := true;
			     next_command := next_command +1;
			   end
			 else
			   ioresult := ord(inopermission);
d1826 1
a1826 2
	    if not chctime_flag then
	      time_stamp(inode_ptr,[ICHG]);
@


1.38
log
@Use in_use routine to prevent name change or
removal of a prefix directory.
finishfib gets new param -- simple name, for ftitle.
default creation modes named -- 777 for dirs, 666 for files.
stretchit alwaysstretches to 8K boundary.
@
text
@d50 1
a51 1

d110 1
a110 1
writeln('GET_WSHEADER');
d299 1
a299 1
	    report('start_path sees bad title');
d318 1
a318 1
	report('good_file_name sees bad title');
d398 1
a398 1
writeln('PARENT_INODE');
d404 1
a404 1
	report('parent_inode failed');
d434 1
a434 1
writeln('DOTNAME');
d443 1
a443 1
	    report('dot not found');
d528 1
a528 1
report('traverse_path ' + path);
d605 1
a605 1
reportn('traverse path ioresult', ioresult);
d662 1
a662 1
	   report('finishfib sees name too long');
d726 1
a726 1
{ convert a decimal number to a 3-digit octal number
d728 4
a731 1
function octalmode(decmode : integer) : integer;
d733 6
a738 3
    octalmode := (decmode mod 8) +
		((decmode div 8)  mod 8) * 10 +
		((decmode div 64) mod 8) * 100;
d851 1
a851 1
		     octalmode(ip^.mode):3,
d1040 2
a1041 1
reportn('opendir, title '+newtitle+' dname '+dname+' ino', inumber(dir_ip));
d1076 1
a1076 1
			 octalmode(mode):3,
d1264 1
a1264 1
reportn('create file with size', fileinfo.ioffset + f.fpos);
d1300 1
a1300 1
report('close file ' + ftid);
d1323 2
a1324 2
if fmodified then
reportn('close: new size (w/hdr)', ip^.size.ls);
d1333 1
a1333 1
report('close -- calling enter_file');
d2006 1
a2006 1
	    writeln('ESCAPED HFSDAM',ESCAPECODE);
a2011 1
	    {freeze;}
d2038 2
a2040 1
    init_support;
d2043 6
d2071 1
a2071 1
why is memavail so small when hfs running?
d2074 1
a2074 1
what if say rewrite(f, 'foo); ...; reset(f); ??
d2077 1
a2077 1
what about system files?  startaddr comes from where?
d2080 2
a2081 1
look at disc accesses to optimize
d2084 1
a2084 1
openvolume/openunit
d2087 2
a2088 1
also, check root uvid -- get them all?
d2091 2
a2092 1
finishfib always sets ftitle first.  parameter?
d2095 6
a2100 1
interrupt during filecopy -- bad file system
@


1.37
log
@Mostly cleanup.  Add new routine create_ok.
No leading 0 in octal mode with catalog.
traverse_path checks for filenotdir, e.g. /abc/file1/foo.
close_fib cut back, since filer expects size in peof AFTER close.
randomize stretchit -- asks for a little extra.
@
text
@d76 2
a77 2
      file_mode = octal('777');
      dir_mode = octal('777');
d217 1
a217 1
	{ ioresult already set }
d312 1
a312 1
procedure good_file_name(fname: string255);
d398 1
a398 1
writeln('DOTNAME');
a549 1
writeln('CHECKING ', atom);
d617 1
d627 1
d650 1
d681 1
a681 1
{ Warning: FILER looks at leof AFTER closing fib.  Therefore, we
a691 1
	fpos       := 0;
d719 1
a719 1
    secs_to_timedate(hfstime-timezone, date, time);
d974 1
a974 1
	    unitable^[unum].uvid := rootname;
d1036 1
a1036 1
    { set a lot of fields to prevent accidental use of fib }
d1041 1
a1041 3
    { finishfib expects simple name in ftitle }
    f.ftitle := dname;
    finishfib(dir_ip, pathinfo.parent_ino, fileinfo);
d1063 3
d1153 1
a1153 1
    pathinfo: pathinfotype;
d1160 1
a1160 1
	if not create_ok(parent_ip, dirname, pathinfo.diroff) then
d1163 1
a1163 2
	new_inodenum := create_dir(dirname, dir_mode,
				   parent_ip, pathinfo.diroff);
d1203 1
a1203 1
	pathinfo.parent_ino := root_inode
d1261 1
a1261 2
    f.ftitle := pathinfo.basename;
    finishfib(new_inodep, pathinfo.parent_ino, fileinfo);
d1368 1
a1368 1
	if (fanonymous or fisnew) and (filetype <> IFDIR) then begin
d1379 1
a1379 3
	ino := inumber(ip);
	if (ino = root_inode)
	or (ino = h_unitable^.tbl[funit].prefix) then begin
d1433 1
a1433 10
	if wantbytes < 5000 then
	    extra := 1
	else
	if wantbytes < 40000 then
	    extra := 5
	else
	    extra := 10;
	trybytes := wantbytes + fragstobytes(superblock,
				   randbetween(0, extra));
writeln('stretch: want ', wantbytes, ' trying ', trybytes);
d1533 2
a1534 2
    { can't change name of root inode }
    if old_inodep = parent_inodep then begin
d1914 1
a1914 2
    f.ftitle := pathinfo.basename;
    finishfib(inodep, pathinfo.parent_ino, fileinfo);
d2055 1
d2073 1
a2073 1
domakedir -- what to do with fib?
a2075 12
make list of SRM tests (and hfs)
example: makedirectory -- what is ftitle, pathid, etc?
}
{
watch for open and fb0
does purgename need to do so much?
}
{
change name of any prefixed dir - not allowed?
also, check root uvid -- get them all
}
{
a2079 3
}
{
duplink dir/file (source), dir not there -- error -8
@


1.36
log
@Dir scanners now set keep_going to false only.
closefile now reset inode size correctly.
changename allowed on directory.
getvolumename simplified because of new powers of check_disc_status.
Other miscellaneous cleanup.
@
text
@d10 1
d19 13
a31 3
import $SEARCH 'hfs'$ hfstuff, hfsupport, hfsalloc, hfscalc, hfscache,
       iocomasm, sysglobals, sysdevs,
       misc, fs, asm;
d35 2
a36 2
  procedure install_hfs_dam;
  procedure hfsdam(anyvar f : fib; unum : unitnum; request : damrequesttype);
d41 1
a41 1
procedure hfsdam(anyvar f : fib; unum : unitnum; request : damrequesttype);
d54 4
a57 1
    needs_superblock = [openfile,
d60 1
d63 1
a63 6
			changename,
			setvolumename,
			purgename,
			catalog,
			openparentdir,
			closefile,
d66 1
a66 1
			makedirectory,
d68 3
a70 2
			setpasswords,
			duplicatelink ];
d72 2
a73 2
    { wants superblock, but could do without it }
    wants_superblock = [getvolumename];
d75 4
d88 2
a89 3
  var superblock   : super_block_ptr_type;
      fileinfo     : fileinfotype;
      pathinfo     : pathinfotype;
d100 2
a101 1
procedure get_wsheader(inodep: inode_ptr_type);
d110 1
a110 1
report('GET_WSHEADER');
d129 2
a130 1
procedure put_wsheader(inodep: inode_ptr_type);
d172 5
a176 5
	      true : (num : ushort);
	      false: (pad  : 0..127;
		      usr  : 0..7;
		      grp  : 0..7;
		      oth  : 0..7);
d189 1
a189 1
	tmp_perm:= (iand(themode.grp, perm_needed) = perm_needed)
d197 24
d222 8
d237 2
a238 2
{ note that shortcut causes file size to appear as the inode size,
{ which can be wrong for preallocated ws header files.
d267 1
a267 1
		get_wsheader(inodep);
d369 2
a370 2
    tempname : string[fs_name_len];
    i        : integer;
d374 2
a375 2
	    tempname := 'hfs';
	    strwrite(tempname, 4, i, unum:1);
d398 1
d400 1
a400 1
    if foundname(dotdot, false, inodep, pathinfo) then
d434 1
d469 2
a470 1
{ dir_required means we MUST have a directory
d549 6
a554 1
    while atom <> '' do begin
d556 2
a557 1
	and foundname(atom, dir_required, inodep, pathinfo) then begin
d566 2
a567 1
	    atom := '';
a571 2
	if ioresult = ord(inoerror) then
	    ioresult := ord(inofile);
d591 1
a591 1
    { if no one has set parent_ino yet, do it explicitly }
d609 1
d625 3
a627 1
procedure finishfib(inodep: inode_ptr_type; parent_ino: integer);
d649 1
a649 11
       if strlen(ftitle) > tidleng then
	   if strlen(ftitle) <= tidleng + passleng then begin
	       ftid := str(ftitle, 1, tidleng);
	       ffpw := str(ftitle, tidleng + 1, strlen(ftitle) - tidleng);
	   end
	   else begin
	       ioresult := ord(ibadtitle);
	       report('finishfib sees name too long');
	       escape(-10);
	   end
       else begin
d652 10
d679 2
d685 2
a686 2
	pathid := no_inode;
	freadable := false;
d688 3
a690 5
	fmodified := false;
	fleof := 0;
	fpeof := 0;
	fisnew := false;
	fpos := 0;
d765 1
d794 1
d831 9
a839 6
	    { use 19 chars of 20-char cinfo }
	    {         1234567890123456789   }
	    cinfo := '                   ';
	    pos := 1;

	    { 1: file type char }
d841 9
a849 15
	    strwrite(cinfo, pos, pos, filetypechar[i]:1);

	    { 2-6: octal mode, e.g. 755m }
	    strwrite(cinfo, pos, pos, octalmode(ip^.mode):3, 'm ');
	    { change initial blanks in mode to zero }
	    i := 2;
	    while cinfo[i] = ' ' do begin
		cinfo[i] := '0';
		i := i + 1;
	    end;

	    { 7-13: uid, e.g. 19u }
	    strwrite(cinfo, pos, pos, ip^.uid:5, 'u ');
	    { 14-19: gid similarly }
	    strwrite(cinfo, pos, pos, ip^.gid:5, 'g');
d855 1
a856 1
{
d881 1
d914 1
a914 1
	with inrec do begin
d916 2
a917 2
	    if entry >= fp^.fpos then begin
		index := entry - fp^.fpos;
d919 1
a919 1
		if index >= fp^.fpeof then begin
d923 3
a925 3
		ip := get_inode(dp^.ino);
		catarr := catarray_ptr_type(fp^.fwindow);
		fill_entry(catarr^[index], thisname, ip, fp^.fb0, fp^.fb1);
a975 20
$if 1=0$

{OBSOLESCENT}
{------------------------------------------------------------------------}
{
{ check_disc_present
{ see comments at getvolumename
{ We read from the disc to be sure it's really there.
}
procedure check_disc_present;
var
    tmpbuf: packed array [1..256] of char;
begin
    try
	get_bytes(unum, sizeof(tmpbuf), 0, addr(tmpbuf));
    recover
	invalidate_unit(unum);
end;
$end$

d997 2
a998 5
    dname      : string255;
    i, pos     : integer;
    found      : boolean;
    saveprefix : integer;
    dummy: integer;
d1001 2
d1042 1
a1042 1
    finishfib(dir_ip, pathinfo.parent_ino);
d1060 12
a1071 2
		strwrite(cinfo, 1, pos, 'HFS ', octalmode(mode):3,
			 ' ', uid:5, ' ', gid:5);
d1096 3
a1098 3
    requested_name : ^string255;
    volname        : string[6];
    i              : shortint;
d1101 1
a1101 1
    if strlen(requested_name^) <= 6 then
d1104 7
a1110 5
	volname := str(requested_name^,1,6);
    for i:=1 to strlen(volname) do
	superblock^.fname[i-1] := volname[i];
    for i:=strlen(volname)+1 to 6 do
	superblock^.fname[i-1] := #0;
d1126 1
a1126 1
    if (ioresult = ord(inoerror)) then begin
d1151 1
d1157 2
a1158 2
	if foundname(dirname, false, parent_ip, pathinfo) then begin
	    ioresult := ord(idupfile);
d1160 2
a1161 4
	end;
	if not permission(parent_ip, w_permission) then
	    goto 999;
	new_inodenum := create_dir(dirname, 511,
d1172 2
a1173 1
{ We always create an anonymous file (not in directory).
d1186 2
d1257 1
a1257 1
    new_inodep := alloc_inode(pdir, 511, fileinfo.ioffset + f.fpos);
d1260 2
a1261 1
    finishfib(new_inodep, pathinfo.parent_ino);
d1266 1
a1266 1
	    put_wsheader(new_inodep);
d1281 1
d1289 1
a1290 1
    ip := nil;
d1313 1
a1313 1
		put_wsheader(ip);
d1349 3
d1353 1
a1353 1
procedure dopurgefile;
d1362 4
a1365 4
    ip := nil;
    pdir := nil;
    ip := get_inode(f.pathid);
    filetype := itype(ip);
d1367 5
a1371 5
    { anonymous files are easy }
    if (f.fanonymous or f.fisnew) and (filetype <> IFDIR) then begin
	dealloc_inode(ip);
	goto 999;
    end;
d1373 4
a1376 4
    { file is in dir, so be sure dir is writeable }
    pdir := get_inode(f.foldfileid);
    if not permission(pdir, w_permission) then
	goto 999;
d1378 14
a1391 5
    { don't allow removal of root or prefix }
    ino := inumber(ip);
    if (ino = root_inode) or (ino = h_unitable^.tbl[f.funit].prefix) then begin
	ioresult := ord(inotclosed);
	goto 999;
a1392 3

    name := f.ftid + f.ffpw;
    delete_filename(ip, pdir, name);
d1410 1
a1410 1
    havebytes, wantbytes: integer;
d1413 3
d1417 12
d1435 15
a1449 10
	if (havebytes = wantbytes) then begin
	    changed := true;
	    if ip^.size.ls <> wantbytes then begin
		ip^.size.ls := wantbytes;
		put_inode(ip, [dirty]);
	    end;
	end
	else begin
	    changed := change_file_size(ip, wantbytes);
	end;
d1476 1
d1496 1
a1496 2
    if iand(parent_inodep^.mode, IFMT) <> IFDIR then begin
	ioresult := ord(ifilenotdir);
a1497 3
    end;
    if not permission(parent_inodep, w_permission) then
	goto 999;
a1498 7
    { new name (no slashes) must NOT exist }
    parent_inodenum := inumber(parent_inodep);
    if foundname(linkname, false, parent_inodep, pathinfo) then begin
	ioresult := ord(idupfile);
	goto 999;
    end;

d1500 1
a1500 1
    dummy := link_file(old_inodep, linkname, parent_inodep, pathinfo.diroff);
d1524 1
d1541 1
a1541 1
    if not permission(parent_inodep, w_permission+x_permission) then
d1546 1
a1546 1
	ioresult := ord(inotondir);
a1549 7
    { new filename (no slashes) must NOT exist }
    if foundname(newname, false, parent_inodep, pathinfo) then begin
	ioresult := ord(idupfile);
	goto 999;
    end;
    ioresult := ord(inoerror);

d1691 1
d1890 1
a1890 1
{ opens an existing file (NOT a directory)
d1893 2
a1894 1
{ dir_ok -- true if called from purgename, otherwise false
d1897 1
a1897 1
		  dir_ok: boolean);
d1903 2
d1914 1
a1914 1
    if not dir_ok and (itype(inodep) = IFDIR) then begin
d1924 1
a1924 1
    getfileinfo(inodep, fileinfo, false);
d1926 1
a1926 1
    finishfib(inodep, pathinfo.parent_ino);
d1930 4
d1975 1
a1975 1
	purgefile      : dopurgefile;
d1983 1
a1983 1
				 dopurgefile;
d2089 17
@


1.35
log
@Lots of cleanup.  Redid makedirectory, fixed bug in setunitprefix.
@
text
@a29 5
  procedure strtoany(var s: string; anyvar s2: string255); {see LIFDAM}
  begin
   s2 := s;
  end;

d95 1
d183 1
d292 1
a292 1
    with dp^ do begin
d295 1
d297 1
a297 5
	    pac_to_string(name, namlen, iname);
	end
	else
	    keep_going := true;
    end;
d321 1
a321 1
    tempname : string[6];
d330 3
a332 2
	    setstrlen(tempname, 6);
	    for i:=1 to 6 do
d334 3
a336 1
	    tempname := strltrim(strrtrim(tempname));
d534 1
d536 6
a541 1
    if pathinfo.parent_ino = no_inode then begin
d618 1
a618 1
{ reset_fib
d621 1
a621 1
procedure reset_fib;
d631 1
a843 1
    keep_going := true;
d917 3
d935 1
a936 1

d998 1
a998 19
    with f do begin
	fisnew     := false;
	freadable  := false;
	fwriteable := false;
	freadmode  := false;
	fbufvalid  := false;
	feof       := false;
	fmodified  := false;
	fileid     := 0;
	fpeof      := 0;
	fleof      := fpeof;
	fpos       := 0;
	fistextvar := false;
	am         := amtable^[datafile];
	freptcnt   := 0;
	flastpos   := -1;
	fbufchanged:= false;
	fbuffered  := true;
    end;
d1020 4
a1023 4
	    cinfo       := 'HFS ';
	    strwrite(cinfo, 5, pos, octalmode(dir_ip^.mode):3, ' ');
	    strwrite(cinfo, pos, pos, dir_ip^.uid:5,' ');
	    strwrite(cinfo, pos, pos, dir_ip^.gid:5);
d1060 1
a1060 1
	superblock^.fname[i-1] := ' ';
a1113 5
	if new_inodenum <> no_inode then begin
	    { why do we change ftitle and pathid? }
	    ftitle := dirname;
	    pathid := new_inodenum;
	end;
d1246 14
a1259 8
	{ need to update ws hdr? }
	if fmodified and (fkind <> uxkind) then begin
	    with fileinfo do begin
		ieft := feft;
		ikind := fkind;
		ioffset := fileid;
		istartaddress := fstartaddress;
		ilogicalsize := fleof;
a1260 1
	    put_wsheader(ip);
a1261 5
	{ inode size has been beyond leof; correct it now }
	if ip^.size.ls <> fileid + fleof then begin
	    ip^.size.ls := fileid + fleof;
	    put_inode(ip, [dirty]);
	end;
d1282 1
a1282 1
    reset_fib;
d1332 1
a1332 1
	reset_fib;
a1356 1
writeln('havebytes ', havebytes:1, ' wantbytes ', wantbytes:1);
a1364 1
writeln('change_file_size called');
a1370 1
reportn('after stretch: blocks ', ip^.blocks);
a1460 1
    f.ftitle := pathinfo.basename;
a1464 6
    { old file must not be directory }
    if iand(old_inodep^.mode, IFMT) = IFDIR then begin
	ioresult := ord(inotondir);
	goto 999;
    end;

d1470 6
d1490 1
a1490 1
    { now change the directory name }
a1514 10
{ The algorithm there is:
{   if the sb is in cache, then use it, but check the disc status too,
{       and return nil if the status isn't normal.
{   if the sb not in cache, then read it from disc.
{ Unfortunately, "check disc status" notices if the disc has been
{ popped and pushed, but not if it is completely absent.
{ Thus, if we have a superblock, we might have read it from the
{ disc, BUT we might also have the cache copy, and the disc might
{ be completely out.  Therefore, we do a read from the disc in this
{ case, which is why getvolumename is very slow.
d1529 2
d1532 2
a1533 6
	superblock := get_superblock(unum)
    else begin
	check_disc_present;
	if ioresult <> ord(inoerror) then
	    superblock := nil;
    end;
d1916 15
a1930 14
	closedirectory : reset_fib;
	makedirectory   : domakedir;
	openunit        : ioresult := ord(ibadrequest);
	openvolume      : ioresult := ord(ibadrequest);
	setunitprefix   : dosetunitprefix;
	stripname       : dostripname;
	setpasswords    : dosetpassword;
	catpasswords    : docatpassword;
	duplicatelink   : doduplink;
	lockfile        : ioresult := ord(ibadrequest);
	unlockfile      : ioresult := ord(ibadrequest);
	otherwise         BEGIN report('DAM otherwise !');
				ioresult := ord(ibadrequest);
			  END
a1987 1
{ should opendir use start_path???
a1993 3
put_wshdr should use real date and time
}
{
a2002 3
close anon file -- close or purge?
}
{
d2009 1
a2009 1
get_inode should handle ino out of range
d2012 2
a2013 1
domakedir -- what to do with fib?
@


1.34
log
@Move get/put_wsheader here.  Improved stretchit a little.
Othe minor changes.
@
text
@d35 1
a35 1
  procedure hfsdam(anyvar f : fib; unum : unitnum; request : damrequesttype);
d37 2
a38 1
  label 1;
d40 1
a40 1
  $INCLUDE 'wsheader'$
d42 2
a43 1
  type
a44 2
       catarray = array[0..maxint] of catentry;
       catarray_ptr_type = ^catarray;
d46 19
a64 1
       objectkind = (nameobject, inodeobject);
d66 2
a67 9
  type cinfo_statrec = packed record
	  pad         : shortint;
	  c_mode      : ushort;
	  c_uid       : ushort;
	  c_gid       : ushort;
	  c_rdev      : integer;
	  c_atime     : integer;
	  c_ctime     : integer;
	end;
a68 28
	cinfo_statrecp = ^cinfo_statrec;


   var
     fibstring: string255ptr;

  const
      eftblocksize = 512;       {size of ws_header}
      needs_superblock = [openfile,
			  createfile,
			  overwritefile,
			  purgefile,
			  stretchit,
			  changename,
			  setvolumename,
			  purgename,
			  catalog,
			  openparentdir,
			  closefile,
			  opendirectory,
			  closedirectory,
			  makedirectory,
			  setunitprefix,
			  setpasswords,
			  duplicatelink ];

      wants_superblock = [getvolumename];

a78 4
      new_inodep   : inode_ptr_type;
      old_inodep   : inode_ptr_type;
      new_inodenum : integer;
      old_inodenum : integer;
a79 2
      mediavalid   : boolean;
      temperr      : integer;
d84 24
a107 24

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


procedure get_wsheader (inodep : inode_ptr_type);

   type eftheaderbuftype = packed array[0..eftblocksize-1] of char;

   var
     wsheaderp : dev_block_ptr_type;
     l_fileinfo     : fileinfotype;
     ok : boolean;
	headerbuf   : eftheaderbuftype;

    begin
     if inodep^.size.ls >= eftblocksize then
     begin
      get_bytes(f.funit, eftblocksize,
       data_start(superblock, get_dbnum(inodep, 0, b_read,
				       min(inodep^.size.ls,eftblocksize))),
       addr(headerbuf));
     ok := read_wsheader(addr(headerbuf), fileinfo);
     end;
d109 2
d112 1
a112 25
{**************************************************************}
{**************************************************************}

procedure put_wsheader (inodep : inode_ptr_type);

   type eftheaderbuftype = packed array[0..eftblocksize-1] of char;

    var
	wsheaderp   : dev_block_ptr_type;
	dirblockp   : wsdirarray_ptrtype;
	headerbuf   : eftheaderbuftype;

    begin
    {
    wsheaderp := get_data(get_dbnum(inodep, 0, b_read,
			  eftblocksize), 0);
    release_data(wsheaderp);
    put_datablk(cache_blk_ptr_type(wsheaderp),[dirty,immediate,release]);
    }
    makews_header (addr(headerbuf), fileinfo);
    put_bytes(f.funit, eftblocksize,
      data_start(superblock, get_dbnum(inodep, 0, b_read, eftblocksize)),
      addr(headerbuf));
    end;

d114 21
a134 1
procedure put_wsheader (inodep : inode_ptr_type);
a135 11
    var
	wsheaderp   : dev_block_ptr_type;
	dirblockp   : wsdirarray_ptrtype;

    begin
    wsheaderp := get_data(get_dbnum(inodep, 0, b_read,
			  eftblocksize), 0);
    makews_header (wsheaderp, fileinfo);
    put_datablk(cache_blk_ptr_type(wsheaderp),[dirty,immediate,release]);
    end;
}
d156 4
a159 4
function permission(inodep : inode_ptr_type;
		perm_needed : permission_type) : boolean;
 var
   themode : packed record case boolean of
d166 6
a171 2
   sameuser, samegroup : boolean;
   tmp_perm: boolean;
d173 10
a182 16
 begin
  themode.num    := inodep^.mode;
  sameuser       := get_uid = inodep^.uid;
  samegroup      := get_gid = inodep^.gid;

  if sameuser then
   tmp_perm := (iand(themode.usr, perm_needed) = perm_needed)
  else
  if samegroup then
    tmp_perm:= (iand(themode.grp, perm_needed) = perm_needed)
  else
    tmp_perm := (iand(themode.oth, perm_needed) = perm_needed);
  permission := tmp_perm;

  if not tmp_perm then
    ioresult := ord(inopermission);
d265 1
a265 1
{ cannot contain null
d269 3
a271 1
    if (strlen(fname) > MAXNAMLEN) or (strpos(#0, fname) <> 0) then begin
d315 10
a324 4


function rootname : vid;
   const
d326 1
a326 1
   var
d329 12
a340 13
   begin
    if superblock^.fname = nilname then
     begin
      tempname := 'hfs';
      strwrite(tempname,4,i,unum:1);
     end
    else
     begin
      setstrlen(tempname, 6);
      for i:=1 to 6 do
       tempname[i] := superblock^.fname[i-1];
      tempname := strltrim(strrtrim(tempname));
     end;
d342 1
a342 1
   end;
d631 16
a646 13
   {set time and date to 1-MAR-0 0:0:0-- the "invalid" time and date}
   procedure zerotimedate(var time : timerec; var date : daterec);
   begin
    with time, date do
     begin
      year        := 0;
      day         := 1;
      month       := 3;
      hour        := 0;
      minute      := 0;
      centisecond := 0;
     end;
   end;
d648 9
a656 5
   {convert a PWS timerec and daterec to time_t}
   procedure PWS_to_hfs_timedate(time : timerec; date : daterec;
			  var hfstime : integer);
   begin
   end;
a657 6
   {convert a time_t to PWS timerec and daterec}
   procedure hfs_to_PWS_timedate(hfstime : integer;
				var time : timerec; var date : daterec);
   begin
    secs_to_timedate(hfstime-timezone,date,time);
   end;
d659 11
a669 6
     function octalmode(decmode : integer) : integer;
     begin
       octalmode := (decmode mod 8) +
		    ((decmode div 8) mod 8) * 10 +
		    ((decmode div 64) mod 8) * 100;
     end;
d671 30
d763 2
a764 11
	if dostatrec then begin
	    setstrlen(cinfo,0);
	    with cinfo_statrecp(addr(cinfo))^, ip^ do begin
		c_mode  := mode;
		c_uid   := uid;
		c_gid   := gid;
		c_rdev  := db[0]; { maj/min device number }
		c_atime := atime;
		c_ctime := ctime;
	     end;
	end
d831 3
d899 6
a904 2


d907 5
a911 4
   with h_unitable^.tbl[unum] do
     if is_hfsunit then
	 if prefix = root_inode then
	     unitable^[unum].uvid := rootname;
d914 6
a919 1

d922 1
a922 1
   tmpbuf: packed array [1..256] of char;
d924 4
a927 4
  try
    get_bytes(unum, sizeof(tmpbuf), 0, addr(tmpbuf));
  recover
      invalidate_unit(unum);
d948 1
a948 1
procedure doopendirectory(anyvar cat : catentry; openparent : boolean);
d1044 1
a1044 9
	    with cinfo_statrecp(addr(cinfo))^ do begin
		setstrlen(cinfo, 0);
		c_mode  := mode;
		c_uid   := uid;
		c_gid   := gid;
		c_rdev  := db[0];
		c_atime := atime;
		c_ctime := ctime;
	    end;
d1058 2
a1059 2
   procedure dosetvolname;
   var
d1063 1
a1063 1
   begin
d1066 1
a1066 1
     volname := requested_name^
d1068 1
a1068 1
     volname := str(requested_name^,1,6);
d1070 1
a1070 1
     superblock^.fname[i-1] := volname[i];
d1072 1
a1072 1
     superblock^.fname[i-1] := ' ';
d1075 1
a1075 1
   end;
d1077 16
a1092 38
   procedure dosetunitprefix;
   var acatentry : catentry;
   begin
    doopendirectory(acatentry,false);
    if ioresult = ord(inoerror) then
    with f, h_unitable^.tbl[unum], unitable^[unum] do
     begin
      prefix := pathid;
      uvid   := acatentry.cname;
     end;
   end;

   procedure domakedir;
   type catentryp = ^catentry;
   var dirname : string255;
   begin
    dirname := catentryp(f.fwindow)^.cname;
    old_inodenum := start_path;
    old_inodep   := get_inode(old_inodenum);
    with f do
     if not traverse_path(dirname, false, old_inodep, pathinfo) then
      {CHECK FOR / IN BASENAME}
      if (ioresult = ord(inofile)) then
      begin
       f.ftitle := pathinfo.basename;
       ioresult := ord(inoerror);
       reportn('in makedir, old_inodenum',old_inodenum);
       reportn('in makedir, parent_inodenum',pathinfo.parent_ino);
       if permission(old_inodep, w_permission) then
	 begin
	   good_file_name(pathinfo.basename);
	   new_inodenum := create_dir(pathinfo.basename, 511,
				      old_inodep, pathinfo.diroff);
	   if new_inodenum <> no_inode then
	    pathid := new_inodenum {change only if created}
	   else
	    reportn('create_dir failed, ioresult',ioresult);
	 end
d1094 3
a1096 8
	 begin
	  report('no permission in createdir');
	  ioresult := ord(inopermission);
	 end;
       put_inode(old_inodep, [release]);
      end
     else ioresult := ord(idupfile);
   end;
d1098 38
d1209 1
a1209 2
	    ioffset := eftblocksize;
	{ CORRECT NEXT TWO LINES FOR SYSTEM FILES, OTHERS? }
d1211 1
a1211 1
	istartaddress := 0;
d1221 1
d1408 1
a1408 1
    parent_inodep: inode_ptr_type;
d1465 1
a1465 1
    parent_inodep: inode_ptr_type;
d1478 1
a1478 2
    old_inodenum := start_path; {h_unitable^.tbl[unum].prefix;}
    old_inodep := get_inode(old_inodenum);
d1531 23
a1553 1

d1555 2
d1558 16
a1573 16
  ioresult := ord(inoerror);
  if superblock = nil then
      superblock := get_superblock(unum)
  else begin
     check_disc_present;
     if ioresult <> ord(inoerror) then
	 superblock := nil;
  end;
  if superblock = nil then begin
      fibstring := addr(f);
      setstrlen(fibstring^, 0);
  end
  else begin
     check_root_uvid;
     strtoany(unitable^[unum].uvid,f)
  end;
d1656 1
d1893 1
d1897 1
a1897 3


  begin {hfsdam}
d1905 1
a1905 3
    with unitable^[unum] do begin
	ureportchange := true;
    end;
d1910 1
a1910 1
	  goto 1;
d1913 1
a1913 1
      case request of
d1963 1
a1963 1
      end;
d1965 2
a1966 3
      escape(0);
    recover
      begin
d1968 3
a1970 3
	  writeln('ESCAPED HFSDAM',ESCAPECODE);
	  escape(escapecode);
	  freeze;
d1973 3
a1975 3
	  reportn('IORESULT ', ioresult);
	  {freeze;}
	  invalidate_unit(unum);
d1978 8
a1985 8
	  try
	    put_superblock(superblock, [release]);
	  recover
	    reportn('escape in put_super ', ioresult);
	  try
	    check_cache;
	  recover
	    report('escape in check_cache');
d1988 1
a1988 1
	  sync;
d1990 5
a1994 5
	  reportn('escape in sync ', ioresult);
	try lockdown;
	recover begin
	 report('lockdown failed');
       end;
d1997 2
a1998 2
      end;
  end;
d2000 6
a2005 6
  procedure install_hfs_dam;
  begin
   init_support;
   init_cache;
   init_hfsalloc;
  end;
d2012 2
a2013 2
 install_hfs_dam;
 markuser;
d2046 6
@


1.33
log
@Remove ioresult checks after foundname calls; foundname doesn't
set ioresult, and the checks broke duplink.
@
text
@d107 65
d275 1
d282 1
a282 1
{            then start at the prefix
d286 11
a296 11
  with f do
    if pathid = no_inode then
      start_path := h_unitable^.tbl[funit].prefix
    else
    if (pathid <> raw_inode) and (strpos('/', ftitle) <> 0) then begin
      ioresult := ord(ibadtitle);
      report('start_path sees bad title');
      escape(-10);
    end
    else
       start_path := pathid;
d578 1
a578 3
reportn('tp basename ' + pathinfo.basename + ', iores ', ioresult);
reportn('tp parent_inodenum ', pathinfo.parent_ino);

a658 1
	fmodified := false;
d937 1
a1005 1
reportn('calling finishfib, parent_ino', pathinfo.parent_ino);
a1007 1
    f.ftitle := newtitle;
d1052 5
a1056 1

d1244 1
a1252 1
report('update wshdr during close');
a1264 3
	    { debug check }
	    if ip^.size.ls > fpeof then
		report('CLOSE SETS INODE SIZE TOO BIG');
d1267 2
d1342 31
a1372 18

   procedure dostretchit;       {stretch existing file}
   var allocbytes : integer;
       changed    : boolean;

   begin
    with f do
     begin
      changed := false;
      old_inodep := get_inode(pathid);
      allocbytes := bytes_claimed(old_inodep^.size.ls);
      if allocbytes = bytes_claimed(fpos+fileid) then
	changed := true
      else
       if change_file_size(old_inodep, fpos+fileid) then
	begin
	 allocbytes := bytes_claimed(old_inodep^.size.ls);
	 changed := true;
d1374 9
a1382 13
      if changed then
       begin
	if old_inodep^.size.ls <> allocbytes then
	 begin
	  old_inodep^.size.ls := allocbytes;
	  put_inode(old_inodep,[dirty]);
	 end;
	fmodified := true;
	fpeof     := allocbytes - fileid;
       end;
      put_inode(old_inodep, [release]);
     end;
   end;
d1407 1
a1407 2
    old_inodenum := start_path;
    old_inodep := get_inode(old_inodenum);
d1413 1
a1413 1
    if iand(old_inodep^.mode, IFMT) = IFDIR then begin
d1463 1
d1491 1
d1839 1
a1839 1
    { must not be a directory (but special files OK) }
d1864 1
d1882 2
a1883 2
			  f.fisnew := false;
			  openold(r_permission, false);
d1886 2
a1887 2
			  f.fisnew := true;
			  docreate;
d1890 8
a1897 9
			  f.fisnew := false;
			  openold(w_permission, false);
			  if ioresult = ord(inoerror) then
			   begin
			    f.fwriteable := true;
			    f.freadable := false;
			    f.fmodified := true;
			    f.fleof := 0;
			   end;
d1912 1
a1912 1
	crunch         : ioresult := ord(ibadrequest);
d1938 1
d2001 1
a2001 1
why do directories grow to 1024?
d2004 1
a2004 1
who stops a read of a special file (and which?)
d2007 1
a2007 1
who needs ftitle set to basename?
d2010 1
a2010 1
what if say rewrite(f, 'foo); ...; reset(f); ??
d2013 1
a2013 7
look at exact use of fmodified (fs, e.g.)
}
{
what about system files?  startaddr comes from where?
}
{
close anon file -- close or purge?
@


1.32
log
@foundold -> traverse_path in setpasswords; fix bug in docreate where
wshdr always written, even with UX files.
@
text
@a1359 3
    if ioresult <> ord(inofile) then
	goto 999;
    ioresult := ord(inoerror);
a1360 1

a1416 1
    ioresult := ord(inoerror);
@


1.31
log
@itype, inumber now in cacher.   pac_to_string in support.
foundname in hfsalloc.  redid many routines: dotname, parent_inode,
openfile, createfile, closefile, purgefile, finishfib.  Added reset_fib.
opendirectory/openparentdirectory redone.  purgename also ok now.
@
text
@d1151 2
a1153 1
    put_wsheader(new_inodep);
d1619 2
a1620 1
		      if foundold(f_d_name, old_inodenum, inode_ptr) then
d1622 1
a1622 1
			  pathid := old_inodenum;
d1703 1
a1703 1
	      put_inode(inode_ptr,[release,dirty]);
@


1.30
log
@Pws2unix automatic delta on Tue Jul 15 16:35:26 MEZ 1986
@
text
@a28 1
  type pac_type = packed array[1..maxint] of char;
a29 1

d62 1
a62 3
     ok        : boolean;
     dirblockp     : wsdirarray_ptrtype;
     damstring: string255ptr;
a101 4
      is_dir       : boolean;
      basename     : string[255];
      offset       : integer;
      parent_inodenum : integer;
d103 1
a120 10
{ ITYPE
{ return the inode type (IFREG, IFDIR, etc).
}
function itype(ip: inode_ptr_type): integer;
begin
    itype := binand(ip^.mode, IFMT);
end;


{-----------------------------------------------------------------------}
a157 7
{
{ Given an inode ptr, return the inode number.
}
function inumber(iptr: inode_ptr_type): integer;
begin
    inumber := binode_ptr_type(iptr)^.inumber;
end;
a158 1

d226 1
d233 1
a233 27
   procedure good_file_name(fname: string255);
   begin
     if (strlen(fname) > MAXNAMLEN) or (strpos(#0, fname) <> 0) then begin
       ioresult := ord(ibadtitle);
       escape(-10);
     end;
   end;



{-----------------------------------------------------------------}
{ PAC_TO_STRING
{  converts a pac of given length to a string
}
procedure pac_to_string(anyvar pac: pac_type;
			length: integer;
			var strng: string);
var
    i: integer;
begin
    setstrlen(strng, length);
    for i := 1 to length do
	strng[i] := pac[i];
end;


{-----------------------------------------------------------------------}
d235 3
a237 8
{ FOUNDNAME
{ find name in directory pdir
{ returns true if found
{         inodenum of file
{         is_dir telling if it's a directory
{ sets global variables:
{         offset -- offset in dir of file
{                   or offset of free slot if file not there
d239 1
a239 27
function foundname(pdir: inode_ptr_type;
		   var name: string;
		   var inodenum: integer ;
		   var is_dir: boolean): boolean;
label
    999;
type
    inrec_type = record
	nameptr: string255ptr;
	want_dir: boolean;
    end;
    outrec_type = record
	diroff: integer;
	inumber: integer;
    end;
var
    inrec: inrec_type;
    outrec: outrec_type;
    ip: inode_ptr_type;
{--------------------}
procedure check_entry(dp: direntry_ptr_type;
		      offset: integer;
		      anyvar inrec: inrec_type;
		      anyvar outrec: outrec_type;
		      var keep_going: boolean);
var
    thisname: string255;
d241 4
a244 13
    with dp^ do begin
	{ is this the entry we want? }
	pac_to_string(name, namlen, thisname);
	if (ino <> 0) and (thisname = inrec.nameptr^) then begin
	    keep_going := false;
	    outrec.inumber := ino;
	    outrec.diroff := offset;
	end
	else begin
	    keep_going := true;
	    if (ino = 0) or (reclen > sizeof(direntrytype)) then
		outrec.diroff := offset;
	end;
a246 4
{--------------------}
begin {foundname}
    if not permission(pdir, x_permission) then
	goto 999;
a247 25
    inrec.nameptr := addr(name);

    outrec.diroff := -1;
    outrec.inumber := no_inode;

    scan_dir(pdir, check_entry, inrec, outrec);

    if outrec.diroff <> -1 then
	offset := outrec.diroff
    else
	offset := pdir^.size.ls;

    if outrec.inumber <> no_inode then begin
	inodenum := outrec.inumber;
	ip := get_inode(inodenum);
	is_dir := (itype(ip) = IFDIR);
	put_inode(ip, [release]);
	foundname := true;
    end
    else
	foundname := false;
999:
end;


d255 2
a256 2
function foundino(pdir: inode_ptr_type;
		  var inumber: integer;
d309 12
a320 13

   {HAL} {and all calls}
   function parent_inode(inodep : inode_ptr_type): integer;
   var
    tempname : string[2];
    is_dir   : boolean;
    inodenum: integer;
   begin
    inodenum := inumber(inodep);
    tempname := '..';
    is_dir := (iand(inodep^.mode, IFMT)) = IFDIR;
    if foundname(inodep, tempname, inodenum, is_dir) then
     parent_inode := inodenum
d322 3
a324 4
     ioresult := ord(ilostfile);
if ioresult <> 0 then
 report('parent_inode failed');
     escape(-10);
d326 1
a326 1
   end;
d328 11
a338 3
   {HAL} {and all calls}
   function dotname(inodep : inode_ptr_type) : string255;
   var
a339 1
    is_dir       : boolean;
d343 1
a343 1
   begin
d345 4
a348 3
    is_dir := (iand(inodep^.mode, IFMT)) = IFDIR;
    if inodenum = root_inode then
     dotname := rootname
d351 17
a367 16
     dotname := unitable^[unum].uvid
    else
     begin
      dotdotinode  := parent_inode(inodep);
      dotdotinodep := get_inode(dotdotinode);
      if foundino(dotdotinodep, inodenum, tempname)
       then
       dotname := tempname
      else begin
       report('dot not found');
       ioresult := ord(ilostfile);
       escape(-10);
      end;
      put_inode(dotdotinodep, [release]);
     end;
   end;
d369 9
a377 9
   {HAL} {and all calls}
   function dotdotname(inodep : inode_ptr_type) : string255;
   var
     dotdotinodep: inode_ptr_type;
   begin
     dotdotinodep := get_inode(parent_inode(inodep));
     dotdotname := dotname(dotdotinodep);
     put_inode(dotdotinodep, [release]);
   end;
d380 34
a413 20
   {traverse_path is given (the prefix) inodenum, and a string 'path'. It tries
    to traverse the path, updating inodenum and inodep as it goes. If it is
    successful in exhausting the path, it returns TRUE, and is_dir is set to
    indicate whether the last atom in the path was a directory inode or not.
    The caller of traverse_path is always responsible for releasing the
    inode buffer, even if traverse path failed.
    Inodep is assumed initialized at entry. If traverse_path does not
    abort before either exhausting the path, or coming to the last node in the
    path, inodep will be left initialized and claiming the last inode used.
    Note that the caller may expect traverse_path to fail on the last atom.
    This would be typically the case where the last atom is a filer wildcard
    string. This would be handled by detecting traverse_path false, and
    ioresult = inofile (failure higher up the path will not give this error)
   }
   function traverse_path(var inodenum : integer; var inodep : inode_ptr_type;
			  var path : string; var is_dir : boolean) : boolean;
   var node     : string255;
       slashpos : shortint;
       tempinum : integer;
       oldnode, oldpath: string255;
d415 15
a429 19
   function nextcmpnt: string255;
   var
       cmpnt: string255;
       i: integer;
   begin
       setstrlen(cmpnt, 255);
       i := 1;
       while (i <= strlen(path)) and (path[i] <> '/') do begin
	   cmpnt[i] := path[i];
	   i := i + 1;
       end;
       setstrlen(cmpnt, i-1);
       while (i <= strlen(path)) and (path[i] = '/') do
	   i := i + 1;
       if i <= strlen(path) then
	   path := str(path, i, strlen(path)-i+1)
       else
	   path := '';
       nextcmpnt := cmpnt;
d431 1
d433 3
d437 9
a445 10
   begin
	if strpos('/', path) = 1 then begin
	    put_inode(inodep, [release]);
	    inodenum := root_inode;
	    inodep := get_inode(inodenum);
	    repeat
		path := str(path, 2, strlen(path)-1);
		slashpos := strpos('/', path);
	    until slashpos <> 1;
	end;
d447 1
a447 2
	parent_inodenum := inodenum;
	is_dir := (iand(inodep^.mode, IFMT) = IFDIR);
d449 11
a459 18
	oldnode := '';
	oldpath := path;
	node := nextcmpnt;
	while node <> '' do begin
report('tp searching for ' + node);
	    if foundname(inodep, node, inodenum, is_dir) then begin
		parent_inodenum := inumber(inodep);
		put_inode(inodep, [release]);
		inodep := get_inode(inodenum);
		is_dir := (iand(inodep^.mode, IFMT) = IFDIR);
		oldnode := node;
		oldpath := path;
		node := nextcmpnt;
	    end
	    else
		node := '';
	end;
report('tp loop end, oldpath is ' + oldpath);
d461 22
a482 1
	if oldpath <> '' then begin
d484 12
a495 2
	    basename := oldpath;
	    traverse_path := false;
d497 4
a500 10
	else begin
	    if (oldnode = '') or (oldnode = '.') then
		basename := dotname(inodep)
	    else
	    if oldnode = '..' then
		basename := dotdotname(inodep)
	    else
		basename := oldnode;
	    traverse_path := true;
	end;
d502 9
a510 3
	f.ftitle := basename;
reportn('tp basename ' + basename + ', iores ', ioresult);
reportn('tp parent_inodenum ', parent_inodenum);
d512 3
d517 18
a534 13

   function foundold(fname : string255; var inodenum : integer;
					var inodep : inode_ptr_type) : boolean;
   begin
    foundold := false;
    is_dir := false;
    foundold := traverse_path(inodenum,inodep, fname, is_dir);
   end;

   procedure finishfib(inodenum : integer; inodep : inode_ptr_type);
   begin
     with f do
      begin
d537 2
a538 2
       pathid    := inodenum;

d541 10
a550 11
       with fileinfo do        {was set up by foundold or createnew}
	begin
	  fileid        := ioffset;
	  feft          := ieft;
	  fkind         := ikind;
	  fstartaddress := istartaddress;
	  if fisnew then
	   fleof        := 0
	  else
	   fleof        := ilogicalsize;
	end;
d552 1
a552 1
       fb0       := (fkind = uxkind);
d555 13
a567 13
	 if strlen(ftitle) <= tidleng+passleng then
	  begin
	   ftid := str(ftitle,1,tidleng);
	   ffpw := str(ftitle,tidleng+1, strlen(ftid));
	  end
	 else begin
	   ioresult := ord(ibadtitle);
	   escape(-10);
	 end
	else begin
	    ftid := ftitle;
	    ffpw := '';
	end;
a568 2
       foldfileid := parent_inodenum;

d570 1
a570 1
	am := amtable^[untypedfile]
d572 6
a577 6
	if fistextvar then
	  am := amtable^[fkind]         {textfib}
	else
	 am := amtable^[datafile];      {not textfib}
      end;
   end;
d579 20
a857 5
   procedure doopendirectory(anyvar cat : catentry; openparent : boolean);
   var dname      : string255;
       i, pos     : integer;
       found      : boolean;
       saveprefix : integer;
d859 30
a888 3
   begin
    old_inodenum := start_path;       {set to requested startpath}
    old_inodep   := get_inode(old_inodenum);
d890 27
a916 3
    if ioresult = ord(inoerror) then
    with f do
     begin
d918 20
a937 19
      dname      := ftitle;
      saveprefix := pathid;
      fisnew     := false;
      freadable  := false;
      fwriteable := false;
      freadmode  := false;
      fbufvalid  := false;
      feof       := false;
      fmodified  := false;
      fileid     := 0;
      fpeof      := 0;
      fleof      := fpeof;
      fpos       := 0;
      fistextvar := false;
      am         := amtable^[datafile];
      freptcnt   := 0;
      flastpos   := -1;
      fbufchanged:= false;
      fbuffered  := true;
d939 11
a949 27
      found := traverse_path(old_inodenum,old_inodep, dname, is_dir);
      if found
       or
	 (not found and
	  ((ioresult=ord(inofile)) and (strpos('/',basename) = 0))
	 ) then
	begin
	 ioresult := ord(inoerror);
	 if found and is_dir then ftitle := '';
	 found := true;
	 ioresult := ord(inoerror);
	end;
      reportn('opendirectory, inodenum',old_inodenum);
       if found then
       with cat, superblock^ do
       begin
	if openparent or not is_dir then
	 begin
	  put_inode(old_inodep, [release]);
	  old_inodenum := parent_inodenum;
	  old_inodep := get_inode(old_inodenum);
	 end;
	getfileinfo(old_inodep,
		    fileinfo, FALSE); {don't want to check LIFheader}
	finishfib(old_inodenum, old_inodep);
	reportn('doopen, pathid',pathid);
	cname       := dotname(old_inodep);
d953 1
a953 1
	 cextra2    := fsize*(nbfree*frag + nffree);
d955 11
a965 12
	if not fb1 {fb1 = "statrec_requested"} then
	 begin
	  cpsize      := ueovbytes(unum);
	  cstart      := -1;
	  cextra1     := -1;
	  hfs_to_PWS_timedate(superblock^.time, clasttime, clastdate);
	  cinfo       := 'HFS ';
	  strwrite(cinfo,5,pos,octalmode(old_inodep^.mode):3,' ');
	  strwrite(cinfo,pos,pos,old_inodep^.uid:5,' ');
	  strwrite(cinfo,pos,pos,old_inodep^.gid:5);
	  cinfo       := strltrim(strrtrim(cinfo));
	 end
d967 21
a987 31
	 with old_inodep^ do
	 begin
	  cpsize := blocks*fsize;
	  cstart := old_inodenum;
	  cextra1 := nlink;
	  hfs_to_PWS_timedate(mtime,clasttime, clastdate);
	  with cinfo_statrecp(addr(cinfo))^ do
	   begin
	    setstrlen(cinfo,0);
	    c_mode  := mode;
	    c_uid   := uid;
	    c_gid   := gid;
	    c_rdev  := db[0];
	    c_atime := atime;
	    c_ctime := ctime;
	   end;
	  {
	  with cinfo_statrecp(addr(cinfo))^ do
	   begin
	    reportn('strlen(cinfo)',strlen(cinfo));
	    reportn('c_mode ',c_mode);
	    reportn('c_uid  ',c_uid);
	    reportn('c_gid  ',c_gid);
	    reportn('c_rdev ',c_rdev);
	   end;
	  }
	 end;
       end;
     end;
    put_inode(old_inodep, [release]);
   end;
d989 2
d1030 2
a1031 1
     if not foundold(dirname, old_inodenum, old_inodep) then
d1034 1
d1037 1
a1037 1
       reportn('in makedir, parent_inodenum',parent_inodenum);
d1040 3
a1042 2
	   good_file_name(basename);
	   new_inodenum := create_dir(basename, 511, old_inodep, offset);
d1058 134
a1191 25
   procedure docreate;  {create a new file}
   var dname : string255;
   begin
    dname        := f.ftitle;
    old_inodenum := start_path;       {set to unit prefix}
    old_inodep   := get_inode(old_inodenum);
    with f do
     if fisnew then        {redundant}
      if not foundold(dname, old_inodenum, old_inodep) then
       if ioresult = ord(inofile) then
       begin
	ioresult := ord(inoerror);
	reportn('calling w perm on inum ', inumber(old_inodep));
	if permission(old_inodep, w_permission) then
	  begin
	   with fileinfo do
	    begin
	     ieft := feft;
	     ikind := fkind;
	     if ikind = uxkind then      {fix more general}
	      ioffset := 0
	     else
	      ioffset := eftblocksize;
	     ilogicalsize := 0;          {fix for prealloc}
	     istartaddress := 0;         {fix for .SYSTM}
d1193 16
a1208 23
	   good_file_name(basename);
	   if fpos <= 0 then
	    new_inodenum := create_file(basename, 511, old_inodep, offset,
				     fileinfo.ioffset)
	   else
	    new_inodenum := create_file(basename, 511, old_inodep, offset,
				     fileinfo.ioffset+fpos);
	   if new_inodenum <> no_inode then
	    begin
	     new_inodep := get_inode(new_inodenum);
	     finishfib(new_inodenum, new_inodep);
	     if fpos > 0 then
	      fpeof := fpos
	     else
	      fpeof := 0;
	     fpos := 0;
	     if fkind <> uxkind then
	      put_wsheader(new_inodep);
	     put_inode(new_inodep,[release]);
	    end
	   else
	    begin
	     reportn('create_file failed, ioresult',ioresult);
d1210 16
a1225 9
	  end
	 else
	  begin
	   report('no permission in createfile');
	   ioresult := ord(inopermission);
	  end;
       end;
       put_inode(old_inodep, [release]);
   end;
a1226 27
   procedure doclosefile;
   begin
    with f do
     begin
      reportn('closefile, leof ',fleof);
      reportn('peof ',fpeof);
      if fisnew or fmodified then
       begin
	new_inodep := get_inode(pathid);
	if f.fkind <> uxkind then
	with fileinfo do
	 begin
	  ieft := feft;
	  ikind := fkind;
	  ioffset := fileid;
	  istartaddress := fstartaddress;
	  ilogicalsize := fleof;
	  put_wsheader(new_inodep);
	 end;
	new_inodep^.size.ls := fileid+fleof;
	put_inode(new_inodep,[dirty,immediate, release]);
       end;
      if fmodified then
       begin
       end;
     end;
   end;
d1228 49
a1324 1
    truebool: boolean;
d1334 1
a1334 1
    if not foundold(f.ftitle, old_inodenum, old_inodep) then
d1336 1
a1353 1
    truebool := true;
d1355 1
a1355 1
    if foundname(parent_inodep, linkname, parent_inodenum, truebool) then begin
d1365 1
a1365 1
    dummy := link_file(old_inodep, linkname, parent_inodep, offset);
a1383 1
    truebool: boolean;
d1397 1
a1397 1
    if not foundold(f.ftitle, old_inodenum, old_inodep) then
d1399 1
d1402 1
a1402 1
    diroffset := offset;
d1410 3
a1412 3
    { parent directory must be writeable }
    parent_inodep := get_inode(parent_inodenum);
    if not permission(parent_inodep, w_permission) then
d1416 1
a1416 2
    truebool := true;
    if foundname(parent_inodep, newname, parent_inodenum, truebool) then begin
d1461 2
a1462 2
      damstring := addr(f);
      setstrlen(damstring^, 0);
d1471 1
d1744 18
a1761 30
   procedure openold(openpermissions: permission_type);
    {opens an existing (non-directory) file}
   var dname : string255;
   begin
    dname        := f.ftitle;
    old_inodenum := start_path;
    old_inodep   := get_inode(old_inodenum);
    with f do
     if not fisnew then        {redundant}
      if foundold(dname, old_inodenum, old_inodep) then
       if not is_dir then
	if permission(old_inodep, openpermissions) then
	  begin
	   report('got foundold  & permissions');
	   getfileinfo(old_inodep,
		      fileinfo, false);       {set up fileinfo for finishfib}
	   finishfib(old_inodenum, old_inodep);
	   fpeof := old_inodep^.size.ls-fileinfo.ioffset;
	  end
	else
	 begin
	  report('no permission');
	  ioresult := ord(inopermission);
	 end
       else
	begin
	 ioresult := ord(inotondir)
	end;
    put_inode(old_inodep, [release]);
   end;
d1763 27
d1810 1
a1810 1
			  openold(r_permission);
d1818 1
a1818 1
			  openold(w_permission);
d1827 2
a1828 18
	closefile      : begin
			  doclosefile;
			 end;
	purgefile      : begin
			  f.fisnew := false;
			  openold(no_permission);
			  if ioresult = ord(inoerror) then
			   begin
			    f.fwriteable := false;
			    f.freadable := false;
			    f.fmodified := false;
			    f.fleof := 0;
			    f.fpeof := 0;
			    new_inodep := get_inode(parent_inodenum);
			    if not delete_file(old_inodep, new_inodep, offset)
			     then ;
			   end;
			 end;
d1833 5
a1837 1
	purgename      : ioresult := ord(ibadrequest);
d1844 1
a1844 3
	closedirectory : begin
			   f.pathid := no_inode;
			 end;
a1917 5
 check accuracy of parent_inodenum
 check TM recover block -- sync, invalidate, whatever.

}
{
d1929 18
@


1.29
log
@Change h_unitable^[x] to h_unitable^.tbl[x].
@
text
@d1479 1
a1479 1
			set_gid(ws_gid);
d1492 1
a1492 1
			  set_gid(ws_gid);
d1596 1
a1596 1
	      time_stamp(inode_ptr,ICHG);
@


1.28
log
@do a time_stamp in setpassword 
@
text
@d247 1
a247 1
      start_path := h_unitable^[funit].prefix
d463 1
a463 1
    if inodenum = h_unitable^[unum].prefix then
d892 1
a892 1
   with h_unitable^[unum] do
d1044 1
a1044 1
    with f, h_unitable^[unum], unitable^[unum] do
d1292 1
a1292 1
    old_inodenum := start_path; {h_unitable^[unum].prefix;}
d1502 1
a1502 1
		    h_unitable^[unum].umask := new_value;
d1511 1
a1511 1
		    old_inodenum := h_unitable^[unum].prefix;
d1623 1
a1623 1
	    cat_umask := h_unitable^[unum].umask;
@


1.27
log
@remove of temporary stuff for new system turn
@
text
@d1445 1
d1467 1
d1580 1
d1594 5
a1598 1
	  put_inode(inode_ptr,[release,dirty]);
@


1.26
log
@add implementation of stripname
@
text
@a62 22
   {this include has to be here until the next system turn}
   {this declaration is part of MISC}
(**********************************)
type
  ushort = 0..65535;
  h_catpasswd_ids = packed record
	  cat_uid: ushort;
	  cat_gid: ushort;
	  case integer of
	    0: (cat_mode: ushort);
	    1: (cat_umask: integer);
	  end;
  h_setpasswd_command = (login, umask,
			open,
			chmod, chown, chgrp,
			chatime, chmtime, chctime);
  h_setpasswd_entry = packed record
		command: h_setpasswd_command;
		new_value: integer;
		end;
(**********************************)

d1476 2
a1477 2
			set_uid(PAWS_UID);
			set_gid(WS_GID);
d1489 2
a1490 2
			  {set_uid(PAWS_UID);
			  set_gid(WS_GID);
d1500 1
a1500 2
		    {h_unitable^[unum].umask := new_value;
		    }
d1616 1
a1616 1
	    {umask := h_unitable^[unum].umask;}
@


1.25
log
@Use dir scanner (in hfsalloc) to scan directories; docatalog, findname,
and findino are now completely new.  Move bytes_claimed out one level.
Add itype for inode type.  Redo getfileinfo.  Add pac_to_string so

can delete low-level string manipulation.
@
text
@a106 1
			  stripname,
d1390 57
d1760 1
a1760 1
	stripname       : f.ftid := '';
@


1.24
log
@fix typos in last version.
@
text
@d29 3
d45 2
a46 1
       catarray = array[1..maxint] of catentry;
d137 12
a148 18
  {
  { Tell whether user has given permission on given inode.
  { Sets ioresult to inopermission if not.
  { Uses HP-UX algorithm: look at the "most privileged" category
  {     only, with no second or third try.
  }
  function permission(inodep : inode_ptr_type;
		  perm_needed : permission_type) : boolean;
   var
     themode : packed record case boolean of
		true : (num : ushort);
		false: (pad  : 0..127;
			usr  : 0..7;
			grp  : 0..7;
			oth  : 0..7);
	       end;
     sameuser, samegroup : boolean;
     tmp_perm: boolean;
d150 8
a157 4
   begin
    themode.num    := inodep^.mode;
    sameuser       := get_uid = inodep^.uid;
    samegroup      := get_gid = inodep^.gid;
a158 8
    if sameuser then
     tmp_perm := (iand(themode.usr, perm_needed) = perm_needed)
    else
    if samegroup then
      tmp_perm:= (iand(themode.grp, perm_needed) = perm_needed)
    else
      tmp_perm := (iand(themode.oth, perm_needed) = perm_needed);
    permission := tmp_perm;
d160 19
a178 3
    if not tmp_perm then
      ioresult := ord(inopermission);
   end;
d180 18
a197 1
{HAL}
d207 24
a230 20

   {for getfileinfo, caller sets checklif if he wants to read (possible) LIF
    header. Not setting checklif leaves fileinfo looking like it's an HPUX
    non-LIF file, whether it is or not. This is faster for short listings, etc,
    but note that logical record size is returned as inodep^.size.ls, which
    is not the real logical size in the case of a (pre-allocated) LIF mapped
    file}

   procedure getfileinfo(inodep : inode_ptr_type ; nochecklif : boolean);
   const
    hpux_fileinfo = fileinfotype
	  [
	  ikind             : untypedfile,  {reset according to inode}
	  ieft              : 0,            {reset according to inode}
	  ioffset           : 0,            {reset if LIFheader}
	  ilogicalsize      : 0,    {reset according to inode or LIFheader}
	  istartaddress     : 0     {reset if LIFheader}
	  ];

   begin
d232 1
d234 2
a235 3
    with fileinfo do
     begin
      ilogicalsize := inodep^.size.ls;
d237 7
a243 10
      if ((iand(inodep^.mode, IFMT)) = IFREG) then
       begin
	ikind := uxkind;       {it's an HP-UX "regular" file}
	ieft := efttable^[ikind];
       end
      else
       if ((iand(inodep^.mode, IFMT)) = IFDIR) then
	begin   {it's a directory}
	 ieft   := 3;
	 ikind  := untypedfile;
d245 11
a255 2
       else
	ikind := uxkind;        {pipes, fifos, char/block special, etc}
d257 22
a278 6
      if not(nochecklif) and (ikind = uxkind) and (ieft <> 0) then
       {LIF info requested, so read LIFheader if it's there}
       begin
	get_wsheader(inodep);
       end;
     end;
a279 25
   end;

   {
   { Find the starting inode for a relative path.  The bizarre rules,
   { deduced from the FILER (see the change name sequence, e.g.) are:
   { 1) if the FIB is open (pathid <> no_inode),
   {            then start at that pathid
   {            BUT the name (ftitle) can't have slashes
   { 2) if the FIB is closed,
   {            then start at the prefix
   }
   function start_path: integer;
   begin
     with f do
       if pathid = no_inode then
	 start_path := h_unitable^[funit].prefix
       else
       if (pathid <> raw_inode) and (strpos('/', ftitle) <> 0) then begin
	 ioresult := ord(ibadtitle);
	 escape(-10);
       end
       else
	  start_path := pathid;
   end;

a288 15
   function foundobject(tofind : objectkind;
		      var name : string; inodep : inode_ptr_type;
		  var inodenum : integer ; var is_dir : boolean) : boolean;
   label 2;
   var bytesleft        : {quad} integer;
       pos              : integer;
       direntry         : ^direntrytype;
       dirbyte          : shortint;
       devblocknum      : shortint;
       i                : shortint;
       bytesindevblock  : shortint;
       found            : boolean;
       devblockp        : dev_block_ptr_type;
       filename         : string[255 {DIRSIZ}];
       tempinodep       : inode_ptr_type;
d290 14
a303 8
   begin
    foundobject  := false;
    found        := false;
    if not is_dir then
     begin
      ioresult := ord(ifilenotdir);
      goto 2;
     end;
a304 1
    with inodep^ do
d306 58
a363 5
    {
    writeln('in foundobject inodep^.mode ', mode:1,
	    '  size ',size.ls:1,'  uid ',uid:1,'  gid ',gid:1);
    writeln('and inodenum ',inodenum:1);
    }
d365 1
a365 14
    if not permission(inodep, x_permission) then
     begin
      {
      release_inode(inodep);
      }
      report('Found object failed permission');
      ioresult := ord(inopermission);
      goto 2;
     end;
    devblocknum    := 0;
    pos            := 0;
    offset         :=-1; {no offset yet computed}
    bytesleft      := inodep^.size.ls; {get_superblock already checked disc
					size in range}
d367 2
a368 4
    while (bytesleft > 0) and (not found) do
     begin
      devblockp    := get_data(get_dbnum(inodep, pos, b_read, dev_bsize),
			       devblocknum);
d370 1
a370 3
      devblocknum  := devblocknum + 1;
      if devblocknum = superblock^.bsize div DEV_BSIZE then
	devblocknum    := 0;
d372 4
a375 39
      bytesindevblock := DEV_BSIZE;
      if bytesleft < bytesindevblock then
       bytesindevblock := bytesleft;
      dirbyte := 0;
      while (dirbyte < bytesindevblock) and (not found) do
       begin
	direntry := anyptr(integer(devblockp)+dirbyte);
	if (tofind = inodeobject) and (inodenum = direntry^.ino) or
	   (tofind = nameobject) then
	 begin
	  found := (tofind = inodeobject);
	  setstrlen(filename, direntry^.namlen);
	  for i:=0 to direntry^.namlen-1 do
	   filename[i+1] := direntry^.name[i];
	 end;
	if (tofind = nameobject) and (name = filename)
	   and (direntry^.ino <> 0) then
	 begin
	  found  := true;
	  offset := pos + dirbyte;      {keep location for create_xxx}
	 end;
	with direntry^ do
	 begin
	  if offset = -1 then
	   if (reclen > sizeof(direntry^)) or (ino = 0) then
	    begin
	    offset := pos + dirbyte {+ sizeof(direntry^)};
	     end;
	      {found "hole", and have not found one previously}
	  if offset <> -1 then
	   begin
	   end;
	  dirbyte := dirbyte + reclen;
	 end;
       end;
      bytesleft := bytesleft - bytesindevblock;
      pos       := pos + bytesindevblock;
      put_datablk(cache_blk_ptr_type(devblockp), [release]);
     end;       {while (bytesleft > 0) and (not found) do}
d377 38
a414 16
    if found then
     begin
      parent_inodenum := inodenum;
      inodenum  := direntry^.ino;
      tempinodep := get_inode(inodenum);
      is_dir := (iand(tempinodep^.mode, IFMT)) = IFDIR;
      reportn('ord(is_dir) in foundobject',ord(is_dir));
      put_inode(tempinodep, [release]);
      foundobject := true;
      name   := filename;
     end
    else begin
     if offset = -1 then
      offset := inodep^.size.ls; {no hole so return size of directory}
     {HAL}
     ioresult := ord(inofile);
d416 3
a418 2
   2:
   end;
d420 2
a421 5
   function foundname(var name : string; inodep : inode_ptr_type;
		  var inodenum : integer ; var is_dir : boolean) : boolean;
   begin
    foundname := foundobject(nameobject, name, inodep, inodenum, is_dir);
   end;
d423 1
d425 4
d462 1
a462 1
    if foundobject(nameobject, tempname, inodep, inodenum, is_dir) then
d492 1
a492 1
      if foundobject(inodeobject, tempname, dotdotinodep, inodenum, is_dir)
d577 1
a577 1
	    if foundname(node, inodep, inodenum, is_dir) then begin
d707 31
d739 1
a739 16
   procedure docatalog(anyvar cat : catarray);
   label 3;
   type filetypechartype = packed array [0..15] of char;
   const filetypechar = filetypechartype['-pc-d-b- nl-s---'];
	{
	filetypechar meanings
		- undefined
		p pipe
		c character special
		d directory
		b block special
		  (space) regular data file
		n network special file
		l symbolic link fie
		s socket
	 }
d741 4
a744 16
   var dirinodep,
       fileinodep       : inode_ptr_type;
       dstart,
       dnum,
       dirpos,
       pos              : integer;
       done             : boolean;
       bytesleft        : {quad} integer;
       direntry         : ^direntrytype;
       datablockindex   : shortint;
       dirbyte          : shortint;
       devblocknum      : shortint;
       i                : shortint;
       bytesindevblock  : shortint;
       devblockp        : dev_block_ptr_type;
       filename         : string[255 {DIRSIZ}];
d746 8
d755 6
d762 2
a763 5
   begin
    dstart      := f.fpos;
    dnum        := f.fpeof;
    f.fpeof     := 0;
    done        := false;
d765 3
a767 1
    dirinodep   := get_inode(f.pathid);
d769 3
a771 86
    if not ((iand(dirinodep^.mode, IFMT)) = IFDIR) then
     begin
      ioresult := ord(ifilenotdir);
      goto 3;
     end;

    if not permission(dirinodep, r_permission) then
     begin
      ioresult := ord(inopermission);
      goto 3;
     end;

    devblocknum    := 0;
    dirpos         := 0;
    bytesleft      := dirinodep^.size.ls; {get_superblock has already
					   checked disc size in range}

    while (bytesleft > 0) and (not done) do
    with f do
     begin
      devblockp    := get_data(get_dbnum(dirinodep, dirpos, b_read, dev_bsize),
			       devblocknum);

      bytesindevblock := DEV_BSIZE;
      if bytesleft < bytesindevblock then
       bytesindevblock := bytesleft;
      dirbyte := 0;
      while (dirbyte < bytesindevblock) and (not done) do
       begin
	direntry := anyptr(integer(devblockp)+dirbyte);
	dirbyte  := dirbyte + direntry^.reclen;
	if (dstart <= 0) and (direntry^.ino <> 0) then
	 with cat[fpeof+1] do  {report this entry unless it's . or .. }
	  begin
	   setstrlen(filename, direntry^.namlen);
	   for i:=0 to direntry^.namlen-1 do
	    filename[i+1] := direntry^.name[i];
	   if (filename <> '.') and (filename <> '..') then
	    begin
	     cstart := direntry^.ino*superblock^.fsize; {see FILER for why}
	     if strlen(filename) <= tidleng then
	      cname := filename
	     else
	      cname := str(filename,1,tidleng);

	     fileinodep := get_inode(direntry^.ino);

	     getfileinfo(fileinodep, f.fb0);   {set up fileinfo. fb0 indicates
						FALSE full info, TRUE short
						info}
	     fpeof  := fpeof+1;
	     with fileinfo do
	      begin
	       reportn('ilogicalsize',ilogicalsize);
	       clsize  := ilogicalsize;
	       ceft    := ieft;
	       ckind   := ikind;
	      end;

	     cblocksize := superblock^.fsize;
	     cpsize  := ((clsize+cblocksize-1)div cblocksize)*cblocksize;
	     cextra1 := fileinodep^.nlink;
	     cextra2 := -1;
	     hfs_to_PWS_timedate(fileinodep^.mtime, clasttime, clastdate);
	     zerotimedate(ccreatetime, ccreatedate);

	     if  not  fb1 then
	      begin
	       cinfo   := '                   ';
	       i := (binlsr(fileinodep^.mode,12)) mod 16;
	       pos := 1;
	       strwrite(cinfo,pos,pos,filetypechar[i]:1);
	       strwrite(cinfo,pos,pos,octalmode(fileinodep^.mode):3,'m ');
	       i := 2;
	       while cinfo[i] = ' ' do
		begin
		 cinfo[i] := '0';
		 i := i + 1;
		end;
	       strwrite(cinfo,pos,pos,fileinodep^.uid:5,'u ');
	       strwrite(cinfo,pos,pos,fileinodep^.gid:5,'g');
	      end
	     else
	      with cinfo_statrecp(addr(cinfo))^, fileinodep^ do
	       begin
		setstrlen(cinfo,0);
d775 1
a775 1
		c_rdev  := db[0];
d778 7
a784 11
	       end;
	     {
	     with cinfo_statrecp(addr(cinfo))^ do
	      begin
	       reportn('strlen(cinfo)',strlen(cinfo));
	       reportn('c_mode ',c_mode);
	       reportn('c_uid  ',c_uid);
	       reportn('c_gid  ',c_gid);
	       reportn('c_rdev ',c_rdev);
	      end;
	     }
d786 3
a788 7
	     put_inode(fileinodep, [release]);
	     done := (dnum = f.fpeof);
	    end; {reporting non-. and non-.. files}
	  end {with cat[fpeof+1] do}
	else
	 dstart := dstart - 1;
       end;     {while (dirbyte < bytesindevblock) and (not done) do}
d790 8
a797 1
       put_datablk(cache_blk_ptr_type(devblockp), [release]);
d799 7
d807 50
d858 2
d861 2
d864 34
a897 3
      devblocknum  := devblocknum + 1;
      if devblocknum = superblock^.bsize div DEV_BSIZE then
	devblocknum    := 0;
d899 5
a903 2
      bytesleft := bytesleft - bytesindevblock;
      dirpos    := dirpos + bytesindevblock;
d905 5
a909 1
     end;       {while (bytesleft > 0) and (not done) do}
a910 2
   3:put_inode(dirinodep, [release]);
   end;
d912 1
d988 2
a989 1
	getfileinfo(old_inodep, FALSE); {don't want to check LIFheader}
a1078 1
    writeln('makedir, dirname ',catentryp(f.fwindow)^.cname);
a1198 1
   function bytes_claimed(size: integer): integer;
a1199 7
       if lblkno(superblock, size) < NDADDR then
	   bytes_claimed := roundup(size, superblock^.fsize)
       else
	   bytes_claimed := roundup(size, superblock^.bsize)
   end;

   begin
d1274 1
a1274 1
    if foundname(linkname, parent_inodep, parent_inodenum, truebool) then begin
d1336 1
a1336 1
    if foundname(newname, parent_inodep, parent_inodenum, truebool) then begin
d1614 2
a1615 1
	   getfileinfo(old_inodep, false);       {set up fileinfo for finishfib}
d1694 1
a1694 1
	catalog        : docatalog(f.fwindow^);
@


1.23
log
@added good file name check for creating file or dir.
fixed bug where 0 inode in dir, not covered by reclen of prev entry, failed.
finishfib sets ffpw to '' if name short enough.
opendirectory puts dotname into cname (used by FILER for
pseudo-volume name in confirmation output).
fixed bug in close that caused wshdr with uxkind file.
fixed bug in bytes_claimed calculations.
rearranged preamble for better debugging.
postamble: pass all escapes through (except -10 and 0).
@
text
@d254 1
a254 1
     if strlen(fname) > MAXNAMLEN) or (strpos(#0, fname) <> 0) then begin
d609 1
a609 1
	   ioresult := ord(ibadtitle)
@


1.22
log
@set ioresult in permission.
@
text
@d9 1
a9 1
$debug ON $                  {debug OFF when finished}
d252 7
d260 1
d333 2
a334 1
	if (tofind = nameobject) and (name = filename) then
d342 1
a342 1
	   if (reclen > sizeof(direntry^)) then
a344 5
	    end
	   else
	    if ino = no_inode then
	     begin
	     offset := pos;
d608 1
a608 1
	 else
d610 6
a615 2
       else
	ftid := ftitle;
d916 1
a916 1
	cname       := {HAL} dotname(old_inodep); {basename;}
d1015 1
d1058 1
d1101 1
a1101 1
	if fileinfo.ikind <> uxkind then
a1123 1
   {HAL}
d1126 1
a1126 4
       if size = 0 then
	   bytes_claimed := 0
       else
       if lblkno(superblock, size-1) < NDADDR then
d1564 2
a1566 1
    reportn('in dam request ',ord(request));
a1568 1
    ioresult := ord(inoerror);
d1650 7
a1656 5
	if escapecode <> 0 then begin
	  reportn('ESCAPED HFSDAM',ESCAPECODE);
	  if escapecode = -10 then
	    reportn('IORESULT ', ioresult);
	  freeze;
d1697 26
@


1.21
log
@implementation of catpasswords and setpasswords
@
text
@d47 7
a53 7
	  pad          : shortint;
	  st_mode      : ushort;
	  st_uid       : ushort;
	  st_gid       : ushort;
	  st_rdev      : integer;
	  st_atime     : integer;
	  st_ctime     : integer;
d61 19
a79 1
   $INCLUDE 'passwd_hdr'$
d166 2
d786 6
a791 6
		st_mode  := mode;
		st_uid   := uid;
		st_gid   := gid;
		st_rdev  := db[0];
		st_atime := atime;
		st_ctime := ctime;
d797 4
a800 4
	       reportn('st_mode ',st_mode);
	       reportn('st_uid  ',st_uid);
	       reportn('st_gid  ',st_gid);
	       reportn('st_rdev ',st_rdev);
d936 6
a941 6
	    st_mode  := mode;
	    st_uid   := uid;
	    st_gid   := gid;
	    st_rdev  := db[0];
	    st_atime := atime;
	    st_ctime := ctime;
d947 4
a950 4
	    reportn('st_mode ',st_mode);
	    reportn('st_uid  ',st_uid);
	    reportn('st_gid  ',st_gid);
	    reportn('st_rdev ',st_rdev);
@


1.20
log
@partial_eval on.  new traverse_path, octal_mode.
@
text
@d59 4
d1298 209
d1611 2
a1612 2
	setpasswords    : ioresult := ord(ibadrequest);
	catpasswords    : ioresult := ord(ibadrequest);
@


1.19
log
@fix typo in last delta
@
text
@d10 1
a456 1

a458 1
   label 456;
d462 1
d464 4
d469 15
a483 3
    parent_inodenum := inodenum;
    basename := path;
    is_dir := (iand(inodep^.mode, IFMT)) = IFDIR;
a484 10
    if path = '' then
     begin
      traverse_path := true;
      basename      := unitable^[unum].uvid;
      {no change to inodenum/inodep, it is the end of the path}
     end
    else
     begin
      traverse_path := false;
      slashpos      := strpos('/', path);
d486 9
a494 8
      tempinum := inodenum;

      while slashpos = 1 do          {absolute pathname, form '/name...' where
				      "/" implies any number of '/'s}
	begin
	  tempinum  := root_inode;
	  path      := str(path, 2, strlen(path)-1);
	  slashpos  := strpos('/', path);
d497 2
a498 6
      if tempinum <> inodenum then
       begin
	inodenum := tempinum;
	put_inode(inodep, [release]);
	inodep := get_inode(inodenum);
       end;
d500 18
a517 1
      is_dir := (iand(inodep^.mode, IFMT)) = IFDIR;
d519 1
a519 38
      if path = '' then
       begin    {path consisted of only leading '/'s}
	traverse_path := true;
	basename      := rootname;      {geli}
	goto 456;
       end;

      basename := path;                 {geli}

      while slashpos <> 0 do
       begin
	node   := str(path, 1, slashpos-1);
	path   := str(path, slashpos+1, strlen(path)-slashpos);
	$partial_eval on$ {remove multiple adjacent '/'s from path}
	 while (path <> '') and (path[1] = '/') do
	  path := str(path, 2, strlen(path)-1);
	$partial_eval off$

	basename := path;

       {if strlen(node) > DIRSIZ then     {removed to allow >14 char names for read}
       {
	 begin
	  ioresult := ord(ibadtitle);
	  goto 456;
	 end;
       }

	if foundname(node, inodep, inodenum, is_dir) then
	 begin
	  put_inode(inodep, [release]);
	  inodep := get_inode(inodenum);
	  slashpos := strpos('/', path);
	 end
	else
	 begin
	  if ioresult <> ord(inoerror) then
	   begin
d521 2
a522 14
	    {inodenum :=  no_inode;      {invalid inodenum}
	    goto 456;
	   end;
	 end;
       end;     {while slashpos <> 0}

      reportn('traverse, before last node, inodenum',inodenum);
      if (path <> '') then
       if foundname(path, inodep, inodenum, is_dir) then
	begin
	 reportn('found basename, inodenum',inodenum);
	 put_inode(inodep, [release]);
	 inodep := get_inode(inodenum);
	 traverse_path := true;
d524 9
a532 5
       else
	begin
	 report('could not find basename');
	 ioresult := ord(inofile);
	 goto 456;
a533 1
     end;
d535 3
a537 7
    reportn('inodenum after path exhausted',inodenum);
    if inodenum = 2 then        {at root}
     basename := rootname;
    if path = '.' then
     basename := dotname(inodep);
    if path = '..' then
     basename := dotdotname(inodep);
d539 1
a539 3
    456:f.ftitle := basename;
    reportn('end traverse_path, ioresult',ioresult);
  end;
d541 1
a624 7
     const
	 n_octal_digits = 3;
     var oct,
	 i,
	 mult,
	 temp : integer;        {store unsigned shortint in LSBs}
	 sip  : ^shortint;
d626 3
a628 12
      temp := 0;
      sip  := addr(temp,2);
      sip^ := decmode;
      oct  := 0;
      mult := 1;
      for i:=1 to n_octal_digits do
       begin
	oct := oct + (temp mod 8) * mult;
	temp := temp div 8;
	mult := mult * 10;
       end;
      octalmode := oct;
d631 1
d1011 1
@


1.18
log
@Scott's fixes to stretchit (allocbytes comparison), 
doclosedir (set pathid to no_inode).
@
text
@d1081 1
a1081 1
	      fpeof := fpos;
@


1.17
log
@display mode of directory in FILER listing.
fix bug in bytes_claimed -- could not handle size 0.
fix bug in changename -- needed to reset ioresult.
@
text
@d1112 1
d1120 1
a1122 2
	if fileinfo.ikind <> uxkind then
	 put_wsheader(new_inodep);
d1153 1
a1153 1
      if allocbytes >= fpos+fileid then
d1436 1
@


1.16
log
@mode, uid and gid are now declared as ushort.
use get_uid, set_uid, get_gid and set_id instead of
directly the id_unitable.
@
text
@d655 23
a712 22
     function octalmode(decmode : integer) : integer;
     const
	 n_octal_digits = 3;
     var oct,
	 i,
	 mult,
	 temp : integer;        {store unsigned shortint in LSBs}
	 sip  : ^shortint;
     begin
      temp := 0;
      sip  := addr(temp,2);
      sip^ := decmode;
      oct  := 0;
      mult := 1;
      for i:=1 to n_octal_digits do
       begin
	oct := oct + (temp mod 8) * mult;
	temp := temp div 8;
	mult := mult * 10;
       end;
      octalmode := oct;
     end;
d942 4
a945 3
	  cinfo       := 'HFS   ';
	  strwrite(cinfo,7,pos,get_uid:5,'u ');
	  strwrite(cinfo,pos,pos,get_gid:5,'g');
a1055 1
	{HAL}
a1079 1
	     fpeof := 0;        {check this sfb}
d1082 2
a1098 1
	put_inode(old_inodep, [release]);
d1100 1
d1138 3
d1288 1
@


1.15
log
@revive rootname, check_disc_present, check_root_uvid.
redo dogetvolumename because of weakened get_superblock.
@
text
@d47 3
a49 3
	  st_mode      : shortint;
	  st_uid       : shortint;
	  st_gid       : shortint;
d75 1
d120 1
a120 1
		true : (num : shortint);
d131 2
a132 2
    sameuser       := h_unitable^[unum].user_id = inodep^.uid;
    samegroup      := h_unitable^[unum].group_id = inodep^.gid;
d942 2
a943 2
	  strwrite(cinfo,7,pos,h_unitable^[unum].user_id:5,'u ');
	  strwrite(cinfo,pos,pos,h_unitable^[unum].group_id:5,'g');
@


1.14
log
@hfsalloc_init -> init_hfsalloc
@
text
@d354 24
d410 1
a410 1
     dotname := rootname(superblock, unum)
d501 1
a501 1
	basename      := rootname(superblock, unum);      {geli}
d562 1
a562 1
     basename := rootname(superblock, unum);
a758 1
	     fpeof  := fpeof+1;
d770 1
a773 2
	       reportn('ieft',ieft);
	       reportn('ikind',ord(ikind));
d850 19
a1196 1
report('duplink -- old file exists');
a1211 1
reportn('duplink -- parent inum is ', inumber(parent_inodep));
a1219 1
    reportn('duplink -- foundname false, ioresult ', ioresult);
a1223 2
report('duplink -- new file does not exist');
reportn('calling link_file with parent ', inumber(parent_inodep));
a1229 1
reportn('duplink ioresult ', ioresult);
a1284 1
    reportn('blocknum ', blocknum);
a1291 1
	reportn('old name length in dir entry ', namlen);
a1307 1
reportn('change name ioresult ', ioresult);
d1313 7
a1319 6
  if (superblock <> nil) and not medium_changed then begin
    { must look at the disk }
    report('calling check_disc_present');
    check_disc_present;
    if ioresult <> ord(inoerror) then
      superblock := nil;
d1321 4
a1324 2
  if (superblock <> NIL) then
    strtoany(unitable^[unum].uvid,f)
d1326 2
a1327 3
    setstrlen(unitable^[unum].uvid,0);
    damstring := addr(f);
    setstrlen(damstring^, 0);
d1366 1
d1369 3
a1378 1
    try
d1460 4
a1463 1
	  check_cache;
@


1.13
log
@activated duplink, now working.  added inumber(), simplified parent_inode,
dotname, dotdotname.  moved rootname() to support.  added dogetvolumename,
which now forces a disc read.  redid preamble (disc touched checks)
and postamble (regularized structure, some changes for recovery).
@
text
@d1442 1
a1442 1
   hfsalloc_init;
@


1.12
log
@Fix typos in previous revs so file will compile.
@
text
@d61 1
d65 17
d83 2
d144 8
a151 21
   function rootname : vid;
   const
    nilname = fs_name_type[#0#0#0#0#0#0];
   var
    tempname : string[6];
    i        : integer;
   begin
    if superblock^.fname = nilname then
     begin
      tempname := 'hfs';
      strwrite(tempname,4,i,unum:1);
     end
    else
     begin
      setstrlen(tempname, 6);
      for i:=1 to 6 do
       tempname[i] := superblock^.fname[i-1];
      tempname := strltrim(strrtrim(tempname));
     end;
    rootname := tempname;
   end;
d154 1
d339 1
a339 1
    else
d342 3
d354 2
a355 2
   function parent_inode(inodep : inode_ptr_type; inodenum : integer)
								    : integer;
d359 1
d361 1
a361 1
    parent_inode := no_inode;
d366 1
a366 1
    else
d370 2
d374 2
a375 1
   function dotname(inodep : inode_ptr_type; inodenum : integer) : string255;
d381 1
d383 1
a383 1
    dotname := '';
d386 1
a386 1
     dotname := rootname
d388 3
d392 1
a392 1
      dotdotinode  := parent_inode(inodep, inodenum);
d397 1
a397 1
      else
d399 3
d406 2
a407 1
   function dotdotname(inodep : inode_ptr_type; inodenum : integer) : string255;
d409 1
a409 4
    tempname : string255;
    dotdotinode  : integer;
    dotdotinodep : inode_ptr_type;
    is_dir   : boolean;
d411 3
a413 25
    dotdotname := '';
    is_dir := (iand(inodep^.mode, IFMT)) = IFDIR;
    dotdotinode  := parent_inode(inodep, inodenum);
    if dotdotinode = root_inode then
     dotdotname := rootname
    else
     begin
      dotdotinodep := get_inode(dotdotinode);
      dotdotinode := parent_inode(dotdotinodep, dotdotinode);
      if dotdotinode = root_inode then
       dotdotname := rootname
      else
       begin
	put_inode(dotdotinodep, [release]);
	dotdotinodep := get_inode(dotdotinode);
	if foundobject(inodeobject, tempname, dotdotinodep, dotdotinode,
		       is_dir) then
	 BEGIN
	 dotdotname := tempname;
	 END
	ELSE
	 report('dotdot not found');
	put_inode(dotdotinodep, [release]);
       end;
     end;
d416 1
d477 1
a477 1
	basename      := rootname;      {geli}
d538 1
a538 1
     basename := rootname;
d540 1
a540 1
     basename := dotname(inodep, inodenum);
d542 1
a542 1
     basename := dotdotname(inodep, inodenum);
d887 1
a887 1
	cname       := basename;
d1012 2
a1013 3
	{
	old_inodep := get_inode(old_inodenum);
	}
a1129 1
{ THIS ROUTINE DOES NOT WORK YET
d1172 1
d1176 1
d1181 1
d1187 1
d1279 19
a1329 6
   {
    mediavalid := unitable^[unum].umediavalid;
    unitable^[unum].umediavalid    := true;
    unitable^[unum].ureportchange  := false;
   }

d1334 6
a1339 8
    superblock := get_superblock(unum);
    if ioresult = ord(zmediumchanged) then
     begin
      report('ZMEDIUMCHANGED IN DAM');
      invalidate_unit(unum);
      put_superblock(superblock, [release]);
      superblock := get_superblock(unum);
     end;
a1340 7
    if (superblock = NIL) then
     begin
      h_unitable^[unum].prefix := root_inode;
      ioresult := ord(ilostunit);
      goto 1;
     end;

d1382 1
a1382 4
	getvolumename  : if superblock <> NIL then
			  strtoany(unitable^[unum].uvid,f)
			 else
			  setstrlen(unitable^[unum].uvid,0);
d1400 1
a1400 1
	duplicatelink   : ioresult := ord(ibadrequest);
d1407 2
d1411 24
a1434 11
	reportn('ESCAPED HFSDAM',ESCAPECODE);
	freeze;
	put_superblock(superblock, [release]);
	sync;
	if (escapecode < 0) and (escapecode <> -10) then
	 begin
	   {
	   lockdown;
	   escape(escapecode);
	   }
	 end;
a1435 13
  1:
  try
   temperr := ioresult;
     put_superblock(superblock, [release]);
     check_cache;
     sync;
     lockdown;
    recover
     report('lockdown failed');
   if temperr <> 0 then
    reportn('dam done ',temperr);
   ioresult := temperr;
   freeze;
@


1.11
log
@Return inopermission in permission routine.
Add start_path; if fib open, start at pathid.  
Fix a few opendirectory checks.
Add changename (works), duplink (doesn't work, not called).
Drop superblock at end, call check_cache.
Remove release_* routines.
@
text
@d119 1
a119 1
      tmp_perm := (iand(themode.oth, perm_needed) = perm_needed;
a217 2
   function foundname(var name : string; inodep : inode_ptr_type;
		  var inodenum : integer ; var is_dir : boolean) : boolean;
d581 2
a582 2
       if strlen(ftitle) > tidlen then
	 if strlen(ftitle) <= tidlen+passlen then
d584 2
a585 2
	   ftid := str(ftitle,1,tidlen);
	   ffpw := str(ftitle,tidlen+1, strlen(ftid));
d588 1
a588 1
	   ioresult := ibadtitle;
d1094 1
a1094 1
   function bytes_claimed(size: integer);
@


1.10
log
@changed minor things--ioresult, etc
@
text
@d89 6
d106 1
d114 1
a114 1
     permission := (iand(themode.usr, perm_needed) = perm_needed)
d117 1
a117 1
     permission := (iand(themode.grp, perm_needed) = perm_needed)
d119 3
a121 1
     permission := (iand(themode.oth, perm_needed) = perm_needed)
d195 26
d319 1
a319 1
      release_data(devblockp);
d329 1
a329 1
      release_inode(tempinodep);
d382 1
a382 1
      release_inode(dotdotinodep);
d406 1
a406 1
	release_inode(dotdotinodep);
d415 1
a415 1
	release_inode(dotdotinodep);
d471 1
a471 1
	release_inode(inodep);
a472 2
	if inodep = NIL then
	 reportn('get_inode got NIL in traverse path, inodenum ',inodenum);
d507 1
a507 1
	  release_inode(inodep);
d527 1
a527 1
	 release_inode(inodep);
a697 5
    if dirinodep = NIL then
     begin
      ioresult := ord(ilostfile);
      goto 3;
     end;
d805 1
a805 1
	     release_inode(fileinodep);
d813 1
a813 1
      release_data(devblockp);
d828 1
a828 1
   3:release_inode(dirinodep);
d838 1
a838 2
    f.pathid     := h_unitable^[unum].prefix;
    old_inodenum := f.pathid;       {set to requested startpath}
d873 3
a875 2
	 ftitle   := basename;
	 pathid   := old_inodenum;
d878 1
a878 1
      if found and (openparent or is_dir) then
d881 1
a881 1
	if openparent then
d883 1
a883 1
	  release_inode(old_inodep);
d937 1
a937 2
    if old_inodep <> nil then
     release_inode(old_inodep);
d977 1
a977 1
    old_inodenum := f.pathid;       {set to unit prefix}
a985 5
       {
       release_inode(old_inodep);
       old_inodenum := parent_inodenum;
       old_inodep := get_inode(old_inodenum);
       }
d999 1
a999 1
       release_inode(old_inodep);
d1008 1
a1008 1
    old_inodenum := h_unitable^[unum].prefix;       {set to unit prefix}
d1059 1
a1059 1
	release_inode(old_inodep);
d1094 3
d1098 7
d1109 1
a1109 2
      allocbytes := old_inodep^.blocks * DEV_BSIZE; {bytes currently allocated
						     to file}
d1115 1
a1115 1
	 allocbytes := old_inodep^.blocks * DEV_BSIZE;
d1128 1
a1128 1
      release_inode(old_inodep);
d1132 148
d1285 1
a1285 1
    old_inodenum := h_unitable^[unum].prefix;       {set to unit prefix}
d1307 1
a1307 1
    release_inode(old_inodep);
d1327 1
a1327 1
      release_superblock(superblock);
d1378 1
a1378 1
	changename     : ioresult := ord(ibadrequest);
d1411 1
d1424 2
@


1.9
log
@diffs from 3.2c build
@
text
@d165 1
a165 1
	ikind := fkind7;       {it's an HP-UX "regular" file}
d175 1
a175 1
	ikind := fkind7;        {pipes, fifos, char/block special, etc}
d177 1
a177 1
      if not(nochecklif) and (ikind = fkind7) and (ieft <> 0) then
d447 1
a447 1
	basename      := unitable^[unum].uvid;
d451 2
d548 1
a548 1
       fb0       := (fkind = fkind7);
d550 13
d821 1
a821 1
      freadable  := true;
d1002 1
a1002 1
	     if ikind = fkind7 then      {fix more general}
d1023 1
a1023 1
	     if fkind <> fkind7 then
d1059 1
a1059 1
	if fileinfo.ikind <> fkind7 then
@


1.8
log
@corrections from "newest" dam received 23.06.86 from Scott
@
text
@d37 2
d87 3
a89 1
   function permission(inodep : inode_ptr_type;
a90 1
   label 1;
a350 1
   {
a383 1
   }
d521 1
a521 1
    foundold := traverse_path(inodenum,inodep, fname, is_dir) then
d833 1
a833 1
	end
d1065 1
a1065 1
	changed := true;
d1074 1
a1074 1
	if old_inodep.size.ls <> allocbytes then
d1139 1
a1139 1
      h_unitable^.[unum].prefix := root_inode;
@


1.7
log
@correction from 3.2b build
@
text
@d39 1
a39 1
    catarray = array[1..maxint] of catentry;
d41 1
a41 1
    objectkind = (nameobject, inodeobject);
d43 9
a51 9
  type statrec = packed record
	 pad           : shortint;
	 st_mode       : shortint;
	 st_uid        : shortint;
	 st_gid        : shortint;
	 st_rdev       : integer;
	 st_atime      : integer;
	 st_ctime      : integer;
       end;
d53 1
a53 1
       statrecp = ^statrec;
a54 1
$INCLUDE 'wsheader'$
d61 1
a61 1
      eftblocksize = 512;
d67 4
a70 3
      x_permission = 1;
      w_permission = 2;
      r_permission = 4;
d82 1
a82 1

d87 1
d96 2
a98 1
    permission     := FALSE;
d100 2
d103 2
a104 2
    if iand(themode.oth, perm_needed) <> 0 then
     permission := TRUE         {have "other" permission}
d106 4
a109 8
     if h_unitable^[unum].user_id = inodep^.uid then
      if iand(themode.usr, perm_needed) <> 0 then
       permission := TRUE         {have "user" permission}
      else      {not usr permission}
     else       {try group permission}
      if h_unitable^[unum].group_id = inodep^.gid then
       if iand(themode.grp, perm_needed) <> 0 then
	permission := TRUE;         {have "group" permission}
a133 1
$INCLUDE 'wsbody'$
a158 1
      reportn('ilogicalsize at entry to getfileinfo',ilogicalsize);
a176 1
	report('call get_wsheader');
a178 5
      reportn('after get_wsheader ilogicalsize',ilogicalsize);
      freeze;
       {
       lifheader(inodep);
       }
a189 1
       datablockindex   : shortint;
d203 5
a207 1
     goto 2;
d222 1
a222 1
      ioresult := ord(ibadpass);
a224 1
    datablockindex := 0;
a237 1
       begin
a238 2
	datablockindex := datablockindex + 1;
       end;
d268 1
a268 1
	    if ino = 0 then
d286 1
d290 1
d313 1
a313 1
    parent_inode := 0;
d348 1
d382 1
d396 1
a396 1
    ioresult = inotondir (failure higher up the path will not give this error)
d407 1
d409 2
a415 1
      is_dir        := (iand(inodep^.mode, IFMT)) = IFDIR;
d480 1
a480 1
	    inodenum := 0;      {invalid inodenum}
d486 1
d490 1
d497 2
a498 1
	 ioresult := ord(inotondir);
d503 1
d512 1
d520 1
a520 8
    if traverse_path(inodenum,inodep, fname, is_dir) then
     if not is_dir then
      foundold := true
     else
      ioresult := ord(inoaccess)
    else
     if ioresult <> ord(ibadpass) then
      ioresult := ord(inofile);
a573 1
   var t, yr, dd, mm, k, k1, k2 : integer;
a579 4
   const
       TZ = 28800;      {8 hours}
   var t, yr, dd, mm, k, k1, k2 : integer;
       ltime : integer {rtctime};
d581 1
a581 44
    with time, date do
     begin
      {convert hfstime to 8042 format in vars t, ltime, then process with
       standard workstation algorithms}

      hfstime := hfstime - TZ - 60*24*3600;
		   {account for Time Zone TZ,
		    and monthdate offset between HPUX basedate (1-jan-70)
		    and pws basedate (1-mar-00), but not year offset yet}

      t := 100*(hfstime mod (24*3600));
      ltime {.packeddate} := hfstime div (24*3600);

      {see clock module for where following originated}
      k := ltime {.packeddate} + 1;
      k1 := k*4 - 1;
      yr := k1 div 1461;
      dd := (k1-(1461*yr)+4) div 4;
      k2 := (5*dd - 3);
      mm := k2 div 153;
      dd := k2 - 153*mm;
      dd := (dd+5) div 5;
      if mm < 10 then
       mm := mm + 3
      else
       begin
	mm := mm - 9;
	yr := yr + 1;
       end;

      with date do
       begin
	year        := 70 {year offset HPUX to PWs dating} + (yr mod 100);
	month       := mm;
	day         := dd;
       end;

      with time do
       begin
	hour        := t div 360000;
	minute      := (t - (hour*360000)) div 6000;
	centisecond := t mod 6000;
       end;
     end;
d663 1
a663 1
      ioresult := ord(ibadpass);
a666 1
    datablockindex := 0;
a702 1
	     report('call getfileinfo');
a705 2
	     report('done getfileinfo');

a717 1
	     reportn('nlink',fileinodep^.nlink);
d722 19
a740 9
	     if not fb1 then
	     begin
	      cinfo   := '                   ';
	      i := (binlsr(fileinodep^.mode,12)) mod 16;
	      pos := 1;
	      strwrite(cinfo,pos,pos,filetypechar[i]:1);
	      strwrite(cinfo,pos,pos,octalmode(fileinodep^.mode):3,'m ');
	      i := 2;
	      while cinfo[i] = ' ' do
d742 7
a748 2
		cinfo[i] := '0';
		i := i + 1;
d750 2
a751 5
	      strwrite(cinfo,pos,pos,fileinodep^.uid:5,'u ');
	      strwrite(cinfo,pos,pos,fileinodep^.gid:5,'g');
	     end
	    else
	     with statrecp(addr(cinfo))^, fileinodep^ do
d753 5
a757 7
	       setstrlen(cinfo,0);
	       st_mode := mode;
	       st_uid  := uid;
	       st_gid  := gid;
	       st_rdev := db[0];
	       st_atime := atime;
	       st_ctime := ctime;
d759 1
a759 8
	    with statrecp(addr(cinfo))^ do
	     begin
	      reportn('strlen(cinfo)',strlen(cinfo));
	      reportn('st_mode ',st_mode);
	      reportn('st_uid  ',st_uid);
	      reportn('st_gid  ',st_gid);
	      reportn('st_rdev ',st_rdev);
	     end;
d771 4
a776 1
       begin
a777 2
	datablockindex := datablockindex + 1;
       end;
d787 1
a787 1
   procedure doopendirectory(anyvar cat : catentry);
a796 2
    saveprefix := ioresult;
    ioresult := saveprefix;
d823 5
a827 2
      if not found then
       if (ioresult=ord(inotondir)) and (strpos('/',basename) = 0) then
d831 1
d833 2
a834 4
       else
      else
       ftitle      := '' {basename};
      if found and is_dir then
d837 6
d845 1
d852 1
a852 1
	if not fb1 then
d869 2
a870 2
	  hfs_to_PWS_timedate(mtime, clasttime, clastdate);
	  with statrecp(addr(cinfo))^ do
d873 4
a876 4
	    st_mode := mode;
	    st_uid  := uid;
	    st_gid  := gid;
	    st_rdev := db[0];
d880 2
a881 1
	  with statrecp(addr(cinfo))^ do
d889 1
d913 1
a913 1
    flush_superblock(superblock);
d919 1
a919 1
    doopendirectory(acatentry);
d928 38
d975 1
a981 1
	 { getfileinfo(old_inodep, TRUE);       {set up fileinfo for finishfib}
d999 1
a999 1
	   if new_inodenum <> 0 then
a1005 3
	     {
	     new_inodep^.mtime := new_inodep^.ctime;
	     }
d1013 1
a1013 2
	     report('create_file failed');
	     ioresult := ord(isrmcatchall);
d1019 1
a1019 1
	   ioresult := ord(ibadpass);
d1031 1
a1031 1
      if fisnew then
d1042 1
d1054 2
d1059 6
a1064 6
      old_inodep   := get_inode(pathid);
      if old_inodep^.size.ls >= fpos+fileid then
       begin
	fpeof := fpos;
	fmodified := true;
       end
d1066 6
a1071 1
      if change_file_size(old_inodep, fpos+fileid) then
d1073 5
a1077 1
	fpeof := fpos;
d1079 1
d1085 2
a1086 1
   procedure openold;   {opens an existing (non-directory) file}
d1095 8
a1102 6
       if permission(old_inodep, r_permission) then
	 begin
	  getfileinfo(old_inodep, false);       {set up fileinfo for finishfib}
	  finishfib(old_inodenum, old_inodep);
	  fpeof := old_inodep^.size.ls-fileinfo.ioffset;
	 end
d1106 1
a1106 1
	  ioresult := ord(ibadpass);
d1110 1
a1110 1
	 ioresult := ord(inofile);
d1135 1
d1137 5
a1141 1
     ioresult := ord(ilostunit);
a1142 3
    if ioresult <> ord(inoerror) then
     goto 1;

d1147 1
a1147 1
			  openold;
d1153 11
a1163 1
	overwritefile  : ioresult := ord(ibadrequest);
d1167 15
a1181 1
	purgefile      : ioresult := ord(inoerror);
d1194 2
a1195 1
	opendirectory  : doopendirectory(f.fwindow^);
d1198 2
a1199 2
	makedirectory,
	openunit,
d1203 4
a1206 4
	setpasswords,
	catpasswords,
	duplicatelink,
	lockfile,
d1214 1
a1214 1
	WRITELN('ESCAPED HFSDAM ',ESCAPECODE);
a1216 2
	if superblock <> NIL then
	 release_superblock(superblock);
a1228 2
     if superblock <> nil then
      release_superblock(superblock);
@


1.6
log
@corrections from the second hfsdam received from bayes on Jun 7
@
text
@d797 1
a797 1
	     with statrecp(addr(cinfo)^, fileinodep^ do
d807 1
a807 1
	    with statrecp(addr(cinfo)^ do
d809 1
a809 1
	      reportn('strlen(cinfo)',strlen(cinfo);
d917 1
a917 1
	  with statrecp(addr(cinfo)^ do
d927 1
a927 1
	  with statrecp(addr(cinfo)^ do
d929 1
a929 1
	    reportn('strlen(cinfo)',strlen(cinfo);
@


1.5
log
@corrections made during first pws build with hfs integrated
@
text
@d43 12
a135 43
procedure lifheader(inodep : inode_ptr_type);
   type
     magictype = integer {packed array[0..3] of char};
   const
     LIFmagic = 16909060 {#1#2#3#4};
   type
     LIFheadertype = packed record
	magic           : magictype;
	h_eft           : shortint;
	loglen          : shortint;
	logsize         : integer;
	startaddr       : integer;
	txt             : packed array[1..20] of char;
	pads            : packed array[0..511-36] of char;
       end;
     header_ptrtype = ^LIFheadertype;
   var
     devblockp     : dev_block_ptr_type;

   begin
    if inodep^.size.ls >= eftblocksize then
     begin      {file is big enough to have LIFheader}
      devblockp := get_data(get_dbnum(inodep, 0, b_read, 0), 0);
      with header_ptrtype(devblockp)^ do
       if magic = LIFmagic then
	with fileinfo do
	 begin
	  ioffset := eftblocksize;
	  ieft    := h_eft;    {see LIFDAM liftofkind for the rest of this}
	  ikind   := untypedfile;      {initialize for while loop}
	  while (ikind <> lastfkind) and (efttable^[ikind] <> ieft) do
	   ikind := succ(ikind);
	  if efttable^[ikind] <> ieft then
	   ikind := datafile;
	  {
	  ilogicalsize  := logsize + eftblocksize;    {debug}{
	  }
	  istartaddress := startaddr;
	 end;
      release_data(devblockp);
     end;       {file is big enough}
   end;

d587 1
a587 1
       TZ = 25200;      {7 hours}
a745 6
	   {
	   with direntry^ do
	    writeln('filename ',name,'  namlen ',namlen:1,
		    '  inode ',ino:1,
		    '  reclen ',reclen:1);
	   }
d778 20
a797 9
	     cinfo   := '                   ';
	     reportn('fileinodep^.mode',fileinodep^.mode);
	     i := (binlsr(fileinodep^.mode,12)) mod 16;
	     reportn('filetype',i);
	     pos := 1;
	     strwrite(cinfo,pos,pos,filetypechar[i]:1);
	     strwrite(cinfo,pos,pos,octalmode(fileinodep^.mode):3,'m ');
	     i := 2;
	     while cinfo[i] = ' ' do
d799 7
a805 2
	       cinfo[i] := '0';
	       i := i + 1;
d807 1
a807 10
	     strwrite(cinfo,pos,pos,fileinodep^.uid:5,'u ');
	     strwrite(cinfo,pos,pos,fileinodep^.gid:5,'g');
	     zerotimedate(ccreatetime, ccreatedate);
	     with fileinodep^ do
	      {
	      if mtime < ctime then
	       hfs_to_PWS_timedate(ctime, clasttime, clastdate)

	      else
	      }
d809 5
a813 1
	       hfs_to_PWS_timedate(mtime, clasttime, clastdate);
a893 1
	cstart      := -1;
a894 1
	cpsize      := ueovbytes(unum);
a895 1
	cextra1     := -1;
a897 1
	hfs_to_PWS_timedate(superblock^.time, clasttime, clastdate);
d899 37
a935 4
	cinfo       := 'HFS   ';
	strwrite(cinfo,7,pos,h_unitable^[unum].user_id:5,'u ');
	strwrite(cinfo,pos,pos,h_unitable^[unum].group_id:5,'g');
	cinfo       := strltrim(strrtrim(cinfo));
@


1.4
log
@change bit shift routine names from bit_* to bin*
@
text
@d43 1
a43 1
$INCLUDE 'wsheader.TEXT'$
d122 1
a122 1
$INCLUDE 'wsbody.TEXT'$
@


1.3
log
@removal of cbit dependencies
@
text
@d817 1
a817 1
	     i := (bit_lsr(fileinodep^.mode,12)) mod 16;
@


1.2
log
@removed wsbody.p and wsheader.p code since backup also uses this
code.  compiler includes are used to bring it in.
@
text
@d17 2
a18 2
import $SEARCH 'hfs'$ hfstuff, hfsupport, hfsalloc, hfscalc, hfscache, cbit,
       sysglobals, sysdevs,
@


1.1
log
@Initial revision
@
text
@d39 1
a39 7
    fileinfotype = record    {info gleaned from wsheader}
	 ieft           : shortint;
	 ikind          : filekind;
	 ioffset        : shortint;
	 ilogicalsize   : integer;
	 istartaddress  : integer;
       end;
d41 1
a41 1
       catarray = array[1..maxint] of catentry;
d43 1
a43 1
       objectkind = (nameobject, inodeobject);
a44 41
   const
     LIFmagic = -32768 {#1#2};
     entrysize = 32;
   type
    vname   = packed array[1..6] of char;
    lifname = packed array[1..10] of char;
    bcd     = 0..15;
    word15  = 0..32767;
    tdate   = packed array[1..12] of bcd;
    {}
    wsheader=packed record      {volume header sector 0}
	       WSdiscid         : shortint;
	       WSvolname        : vname;
	       WSdstart         : integer;
	       WSoct_10000      : shortint;
	       WSdummy          : shortint;
	       WSdsize          : integer;
	       WSversion        : shortint;
	       WSzero           : shortint;
	       WStps            : integer;      {tracks/surface}
	       WSspm            : integer;      {surfaces/medium}
	       WSspt            : integer;      {sectors/track}
	       WScdate          : tdate;        {volume create time}
	       WSfiller         : packed array[21..123] of shortint;
	       WSsdate          : tdate;
	       WSdummy4         : shortint;
	     end;
    wsheader_ptrtype = ^wsheader;
    wsdirentry = packed record
	       fname            : lifname;
	       ftype            : shortint;
	       fstart           : integer;
	       fsize            : integer;
	       fdate            : tdate;
	       lastvol          : boolean;
	       volnumber        : word15;
	       extension        : integer; { loader execution address }
	     end;
    wsdirarray = packed array [0..7] of wsdirentry;
    wsdirarray_ptrtype = ^wsdirarray;

d122 1
a122 139
   function iswsheader(devblockp     : dev_block_ptr_type):boolean;
   begin
    with wsheader_ptrtype(devblockp)^ do
	 { Check LIFvolume header WStype file }
	    ok := ((WSdiscid = LIFmagic)        {LIF Magic # }
	    and (WSvolname = 'HFSLIF')  { volume name }
	    and (WSdstart =1)       { directory starts in byte 256}
	    and (WSoct_10000=4096)
	    and (WSdummy=0)
	    and (WSzero=0)
	    and (WSdsize = 1)       { directory is 256 bytes long}
	    );
    if ok then
	begin
	dirblockp := addr (devblockp^, sizeof(wsheader));
	if (dirblockp^[1].ftype <> -1) then
	    ok := false
	else
	    begin
	    if (dirblockp^[0].ftype = -1)
		then ok := false
		else ok := true;
	    end;
	end;
    iswsheader := ok;
   end;

procedure makews_header(devblockp   : dev_block_ptr_type;
			fileinfo        : fileinfotype);

   type iarray = packed array [0..63] of integer;

   var
     dirblockp     : wsdirarray_ptrtype;
     i  : integer;
     iptr   : ^iarray;

    begin
    dirblockp := addr (devblockp^, sizeof(wsheader));
    if not (iswsheader(devblockp)) then
	with wsheader_ptrtype(devblockp)^ do
	    begin       {set up lif volume header}
	    WSdiscid := LIFmagic;       {LIF Magic # }
	    WSvolname := 'HFSLIF';  { volume name }
	    WSdstart :=1;       { directory starts in byte 256}
	    WSoct_10000:=4096;
	    WSdummy:=0;
	    WSdsize := 1;       { directory is 256 bytes long}
	    WSversion := 0;
	    WSzero:=0;
	    WStps := 1;      {tracks/surface}
	    WSspm := 1;      {surfaces/medium}
	    WSspt := fileinfo.ilogicalsize div 256;      {sectors/track}
	    for i := 1 to 12 do WScdate[i] := 1;        {volume create time}
	    for i := 21 to 123 do WSfiller[i] := 0;
	    for i := 1 to 12 do WSsdate[i] := 1;
	    WSdummy4 := 0;
	    iptr := addr (dirblockp^);
	    for i := 0 to 63 do iptr^[i] := 0;
	    with dirblockp^[0] do
		begin
		fname := 'WS_FILE   ';
		for i := 1 to 12 do fdate[i] := 1;
		lastvol := true;
		volnumber := 1;
		end;
	    dirblockp^[1].ftype := -1;
	end;
    with dirblockp^[0], f do
    begin
    ftype := feft;
    fstart := 2;
    fsize := (fleof+255) div 256; {changed sfb from (fpeof div 256) + 2;}
    if fkind = datafile then
     extension := fleof
    else
     extension := fstartaddress;
    end;
   end;

function read_wsheader (devblockp : dev_block_ptr_type;
		  var  l_fileinfo : fileinfotype) : boolean;

   var
     dirblockp     : wsdirarray_ptrtype;
	 ok                             : boolean;

    begin
    dirblockp := addr (devblockp^, sizeof(wsheader));
    try
    ok := iswsheader(devblockp);
    recover report('escape in iswsheader');
    if (ok) then
	    with wsheader_ptrtype(devblockp)^, dirblockp^[0], l_fileinfo do
		begin
		ieft := ftype;
		ikind := untypedfile;
		while ((ikind <> lastfkind) and (efttable^[ikind] <> ieft)) do
		    ikind := succ(ikind);
		if efttable^[ikind] <> ieft then ikind := datafile;
		if ikind <> datafile then
		 begin
		  ilogicalsize := fsize * 256;
		  istartaddress := extension;
		 end
		else
		 begin
		  ilogicalsize := extension;
		  istartaddress := 0;
		 end;
		ioffset := 512;
		end;
    read_wsheader := ok;
    end;

procedure get_wsheader (inodep : inode_ptr_type);

   var
     devblockp : dev_block_ptr_type;
     l_fileinfo     : fileinfotype;
     ok : boolean;

    begin
    devblockp := get_data(get_dbnum(inodep, 0, b_read, dev_bsize), 0);
    ok := read_wsheader(devblockp, fileinfo);
    release_data (devblockp);
    end;

procedure put_wsheader (inodep : inode_ptr_type);

    var
	devblockp   : dev_block_ptr_type;
	dirblockp   : wsdirarray_ptrtype;

    begin
    devblockp := get_data(get_dbnum(inodep, 0, b_read, dev_bsize), 0);
    makews_header (devblockp, fileinfo);
    put_datablk(cache_blk_ptr_type(devblockp),[dirty,immediate,release]);
    end;
@
