3 IMPORT S
:= SYSTEM
, Kernel
, HostLang
, Files
, Log
, stdlib
:= C99stdlib
,
4 unistd
:= C99unistd
, dirent
:= C99dirent
, fcntl
:= C99fcntl
,
5 sysstat
:= C99sys_stat
, stdio
:= C99stdio
, errno
:= C99errno
,
6 macro
:= C99macro
, libgen
:= C99libgen
, time
:= C99time
;
8 (* !!! add buffer cache *)
11 closed
= 0; new
= 1; temp
= 2; shared
= 3; exclusive
= 4;
14 FullName
* = Files
.Name
;
15 NativeName
* = ARRAY 1024 OF SHORTCHAR
;
17 Locator
= POINTER TO RECORD (Files
.Locator
)
18 path
-: FullName (* pathname # "" *)
21 Directory
= POINTER TO RECORD (Files
.Directory
) END;
23 File
= POINTER TO RECORD (Files
.File
)
31 Reader
= POINTER TO RECORD (Files
.Reader
)
36 Writer
= POINTER TO RECORD (Files
.Writer
)
41 InodeIdentifier
= RECORD (Kernel
.Identifier
)
49 PROCEDURE (VAR id
: InodeIdentifier
) Identified (): BOOLEAN;
53 RETURN (f
.state
# closed
) & (f
.ino
= id
.ino
)
56 PROCEDURE GetFileByInode (ino
: sysstat
.ino_t
): File
;
57 VAR id
: InodeIdentifier
; obj
: ANYPTR
; f
: File
;
60 id
.typ
:= S
.TYP(File
);
62 obj
:= Kernel
.ThisFinObj(id
);
63 IF obj
# NIL THEN f
:= obj(File
)
69 PROCEDURE GetError (OUT res
: INTEGER);
74 | errno
.ENAMETOOLONG
, errno
.ENOTDIR
: res
:= 1 (* invalid name/location *)
75 | errno
.ENOENT
: res
:= 2 (* file/dir not found *)
76 | errno
.EEXIST
: res
:= 3 (* file/dir already exists *)
77 | errno
.EROFS
: res
:= 4 (* write-protection *)
78 | errno
.EIO
: res
:= 5 (* io error *)
79 | errno
.EACCES
, errno
.EPERM
: res
:= 6 (* access denied *)
80 | errno
.ENOMEM
: res
:= 80 (* not enough memory *)
81 | errno
.ENFILE
, errno
.ENOBUFS
, errno
.ENOSPC
: res
:= 81 (* not enough system resources *)
88 PROCEDURE NewLocator
* (IN path
: ARRAY OF CHAR): Locator
;
89 VAR l
: Locator
; ch
: SHORTCHAR
;
92 IF path
= "" THEN l
.path
:= "."
98 PROCEDURE (l
: Locator
) This (IN path
: ARRAY OF CHAR): Locator
;
101 IF path
= "" THEN NEW(loc
); loc^
:= l^
102 ELSIF path
[0] = "/" THEN loc
:= NewLocator(path
)
103 ELSE loc
:= NewLocator(l
.path
+ "/" + path
)
110 PROCEDURE (f
: File
) Length (): INTEGER;
115 PROCEDURE (f
: File
) NewReader (old
: Files
.Reader
): Reader
;
118 ASSERT(f
.state
# closed
, 20);
119 IF (old
# NIL) & (old
.Base() = f
) THEN
121 IF r
.pos
> f
.len
THEN r
.pos
:= 0 END;
123 ELSE NEW(r
); r
.f
:= f
; r
.pos
:= 0
128 PROCEDURE (f
: File
) NewWriter (old
: Files
.Writer
): Writer
;
131 ASSERT(f
.state
# closed
, 20);
132 ASSERT(f
.state
# shared
, 21);
133 IF (old
# NIL) & (old
.Base() = f
) THEN
135 IF w
.pos
> f
.len
THEN w
.pos
:= 0 END
136 ELSE NEW(w
); w
.f
:= f
; w
.pos
:= 0
141 PROCEDURE (f
: File
) Flush
;
144 IF f
.state
= exclusive
THEN
145 res
:= unistd
.fsync(f
.fd
);
150 PROCEDURE IsName (IN name
: Files
.Name
): BOOLEAN;
154 WHILE (name
[i
] # "/") & (name
[i
] # 0X
) DO INC(i
) END;
158 PROCEDURE DirName (VAR path
: ARRAY OF CHAR);
159 VAR i
, j
, k
: INTEGER;
161 IF path
[0] = "/" THEN i
:= 1; j
:= 1; k
:= 1
162 ELSE i
:= 0; j
:= 0; k
:= 0
164 WHILE path
[i
] # 0X
DO
165 IF path
[i
] = "/" THEN
166 k
:= j
; j
:= i
; INC(i
);
167 WHILE (path
[i
] # 0X
) & (path
[i
] = "/") DO INC(i
) END;
168 IF path
[i
] = 0X
THEN j
:= k
END
176 PROCEDURE (f
: File
) Register (name
: Files
.Name
; type
: Files
.Type
; ask
: BOOLEAN; OUT res
: INTEGER);
177 VAR i
, err
: INTEGER; dir
: FullName
; p0
, p1
: NativeName
; s
: sysstat
.struct_stat
; x
: unistd
.int
;
179 ASSERT(f
.state
= new
, 20);
180 ASSERT(name
# "", 21);
181 ASSERT(IsName(name
), 22);
182 HostLang
.StringToHost(f
.pathname
, p0
, FALSE
, err
);
186 HostLang
.StringToHost(dir
+ "/" + name
, p1
, FALSE
, err
);
188 x
:= stdio
.rename(p0
, p1
);
189 IF x
= 0 THEN res
:= 0 (* no error *)
192 f
.state
:= exclusive
;
195 res
:= 1 (* invalid name (too long?) *)
198 res
:= 1 (* invalid name (too long?) *)
202 PROCEDURE (f
: File
) Close
;
203 VAR res
: unistd
.int
; path
: NativeName
; err
: INTEGER;
205 IF f
.state
# closed
THEN
207 IF f
.state
= new
THEN
208 HostLang
.StringToHost(f
.pathname
, path
, FALSE
, err
);
209 ASSERT(err
= 0, 100);
210 res
:= unistd
.unlink(path
);
211 ASSERT(res
= 0, 101);
214 res
:= unistd
.close(f
.fd
);
215 ASSERT(res
= 0, 102);
220 PROCEDURE (f
: File
) Closed (): BOOLEAN;
222 RETURN f
.state
= closed
225 PROCEDURE (f
: File
) Shared (): BOOLEAN;
227 RETURN f
.state
= shared
230 PROCEDURE (f
: File
) FINALIZE
;
237 PROCEDURE (r
: Reader
) Base (): File
;
242 PROCEDURE (r
: Reader
) Pos (): INTEGER;
247 PROCEDURE (r
: Reader
) SetPos (pos
: INTEGER);
249 ASSERT(pos
>= 0, 20);
250 ASSERT(pos
<= r
.f
.len
, 21);
255 PROCEDURE (r
: Reader
) ReadByte (OUT x
: BYTE);
256 VAR res
: unistd
.int
; offset
: unistd
.off_t
;
258 ASSERT(r
.f
.state
# closed
, 20);
259 offset
:= unistd
.lseek(r
.f
.fd
, r
.pos
, unistd
.SEEK_SET
);
260 ASSERT(offset
= r
.pos
, 100);
261 res
:= unistd
.read(r
.f
.fd
, S
.ADR(x
), 1);
262 ASSERT(res
# -1, 101);
263 IF res
= 0 THEN x
:= 0 END;
264 r
.pos
:= r
.pos
+ res
;
268 PROCEDURE (r
: Reader
) ReadBytes (VAR x
: ARRAY OF BYTE; beg
, len
: INTEGER);
269 VAR res
: unistd
.int
; offset
: unistd
.off_t
;
271 ASSERT(beg
>= 0, 20);
273 ASSERT(beg
+ len
<= LEN(x
), 22);
274 ASSERT(r
.f
.state
# closed
, 23);
275 offset
:= unistd
.lseek(r
.f
.fd
, r
.pos
, unistd
.SEEK_SET
);
276 ASSERT(offset
= r
.pos
, 100);
277 res
:= unistd
.read(r
.f
.fd
, S
.ADR(x
[beg
]), len
);
278 ASSERT(res
# -1, 101);
279 r
.pos
:= r
.pos
+ res
;
285 PROCEDURE (w
: Writer
) Base (): File
;
290 PROCEDURE (w
: Writer
) Pos (): INTEGER;
295 PROCEDURE (w
: Writer
) SetPos (pos
: INTEGER);
297 ASSERT(pos
>= 0, 20);
298 ASSERT(pos
<= w
.f
.len
, 21);
302 PROCEDURE (w
: Writer
) WriteByte (x
: BYTE);
303 VAR res
: unistd
.int
; offset
: unistd
.off_t
;
305 ASSERT(w
.f
.state
# closed
, 20);
306 offset
:= unistd
.lseek(w
.f
.fd
, w
.pos
, unistd
.SEEK_SET
);
307 ASSERT(offset
= w
.pos
, 100);
308 res
:= unistd
.write(w
.f
.fd
, S
.ADR(x
), 1);
309 ASSERT(res
# -1, 101);
310 w
.pos
:= w
.pos
+ res
;
311 w
.f
.len
:= MAX(w
.f
.len
, w
.pos
);
315 PROCEDURE (w
: Writer
) WriteBytes (IN x
: ARRAY OF BYTE; beg
, len
: INTEGER);
316 VAR res
: unistd
.int
; offset
: unistd
.off_t
;
318 ASSERT(beg
>= 0, 20);
319 ASSERT(len
>= 0, 21);
320 ASSERT(beg
+ len
<= LEN(x
), 22);
321 ASSERT(w
.f
.state
# closed
, 23);
322 offset
:= unistd
.lseek(w
.f
.fd
, w
.pos
, unistd
.SEEK_SET
);
323 ASSERT(offset
= w
.pos
, 100);
324 res
:= unistd
.write(w
.f
.fd
, S
.ADR(x
[beg
]), len
);
325 ASSERT(res
# -1, 101);
326 w
.pos
:= w
.pos
+ res
;
327 w
.f
.len
:= MAX(w
.f
.len
, w
.pos
);
328 ASSERT(res
= len
, 60)
333 PROCEDURE (d
: Directory
) This (IN path
: ARRAY OF CHAR): Locator
;
335 RETURN root
.This(path
)
338 PROCEDURE MakeDir (path
: ARRAY OF SHORTCHAR
; OUT res
: unistd
.int
);
339 VAR i
: INTEGER; sep
: BOOLEAN; err
: unistd
.int
; s
: sysstat
.struct_stat
; mode
: sysstat
.mode_t
;
342 mode
:= ORD(BITS(511(*a=rwx*)) - BITS(sysstat
.umask(0)));
343 WHILE (err
= 0) & (path
[i
] # 0X
) DO
344 WHILE (path
[i
] # "/") & (path
[i
] # 0X
) DO INC(i
) END;
345 sep
:= path
[i
] = "/";
346 IF sep
THEN path
[i
] := 0X
END;
347 err
:= sysstat
.mkdir(path
, mode
);
351 (* already exists, continue make dirs *)
355 IF sep
THEN path
[i
] := "/" END;
361 PROCEDURE (d
: Directory
) New (loc
: Files
.Locator
; ask
: BOOLEAN): File
;
362 VAR err
: INTEGER; f
: File
; s
: sysstat
.struct_stat
; fd
, res
: unistd
.int
; pathname
: NativeName
;
364 ASSERT(loc
# NIL, 20);
366 HostLang
.StringToHost(loc
.path
, pathname
, FALSE
, err
);
368 MakeDir(pathname
, res
);
370 (* use fcntl.open() with O_TMPFILE for Linux 3.11+? *)
371 pathname
:= pathname
+ "/" + ".newXXXXXX";
372 fd
:= stdlib
.mkstemp(pathname
);
374 NEW(f
); HostLang
.HostToString(pathname
, f
.pathname
, FALSE
, err
);
376 (* !!! get valid inode? *)
377 f
.fd
:= fd
; f
.len
:= 0; f
.state
:= new
; f
.ino
:= 0;
378 loc
.res
:= 0 (* no errors *)
381 res
:= unistd
.close(fd
);
382 ASSERT(res
= 0, 100);
383 res
:= unistd
.unlink(pathname
);
384 ASSERT(res
= 0, 101);
385 loc
.res
:= 1 (* invalid name *)
394 loc
.res
:= 1 (* invalid name *)
397 loc
.res
:= 1 (* invalid locator *)
402 PROCEDURE IsRegFile (IN s
: sysstat
.struct_stat
): BOOLEAN;
404 RETURN BITS(s
.st_mode
) * BITS(sysstat
.S_IFMT
) = BITS(sysstat
.S_IFREG
)
407 PROCEDURE (d
: Directory
) Old (loc
: Files
.Locator
; name
: Files
.Name
; isShared
: BOOLEAN): File
;
409 VAR err
: INTEGER; f
, if
: File
; s
: sysstat
.struct_stat
; fd
, flags
, res
: unistd
.int
;
410 pathname
: NativeName
; mode
: sysstat
.mode_t
; lock
: fcntl
.struct_flock
;
415 res
:= unistd
.close(fd
);
420 ASSERT(loc
# NIL, 20);
421 ASSERT(name
# "", 21);
424 HostLang
.StringToHost(loc
.path
+ "/" + name
, pathname
, FALSE
, err
);
426 res
:= macro
.stat(pathname
, s
);
429 if
:= GetFileByInode(s
.st_ino
);
430 IF (if
= NIL) OR isShared
& (if
.state
= shared
) THEN
431 mode
:= ORD(BITS(rwrwrw
) - BITS(sysstat
.umask(0)));
432 IF isShared
THEN flags
:= fcntl
.O_RDONLY
433 ELSE flags
:= fcntl
.O_RDWR
435 fd
:= fcntl
.open(pathname
, flags
, mode
);
437 IF isShared
THEN lock
.l_type
:= fcntl
.F_RDLCK
438 ELSE lock
.l_type
:= fcntl
.F_WRLCK
440 lock
.l_whence
:= unistd
.SEEK_SET
;
444 res
:= fcntl
.fcntl(fd
, fcntl
.F_SETLK
, S
.ADR(lock
));
446 NEW(f
); HostLang
.HostToString(pathname
, f
.pathname
, FALSE
, err
);
448 f
.fd
:= fd
; f
.len
:= s
.st_size
; f
.ino
:= s
.st_ino
;
449 IF isShared
THEN f
.state
:= shared
450 ELSE f
.state
:= exclusive
452 loc
.res
:= 0 (* no errors *)
454 loc
.res
:= 1; (* invalid name *)
458 GetError(loc
.res
); (* already locked *)
462 GetError(loc
.res
) (* failed to open *)
465 loc
.res
:= 6 (* already opened / locked *)
468 loc
.res
:= 6 (* access denied (not a regular file) *)
471 loc
.res
:= 2 (* file not found *)
474 loc
.res
:= 1 (* invalid name *)
477 loc
.res
:= 1 (* invalid name *)
480 loc
.res
:= 1 (* invalid locator *)
485 PROCEDURE (d
: Directory
) Temp (): File
;
486 VAR f
: File
; fd
: unistd
.int
; name
: ARRAY 12 OF SHORTCHAR
;
488 (* use fcntl.open() with O_TMPFILE for Linux 3.11+? *)
489 name
:= ".tmpXXXXXX";
490 fd
:= stdlib
.mkstemp(name
);
491 ASSERT(fd
# -1, 100);
492 (* !!! get pathname and unlink it here *)
493 NEW(f
); f
.fd
:= fd
; f
.pathname
:= ""; f
.len
:= 0; f
.ino
:= 0; f
.state
:= temp
;
497 PROCEDURE (d
: Directory
) Delete (loc
: Files
.Locator
; name
: Files
.Name
);
498 VAR pathname
: NativeName
; err
: INTEGER; res
: unistd
.int
;
500 ASSERT(loc
# NIL, 20);
501 ASSERT(IsName(name
), 21);
504 HostLang
.StringToHost(loc
.path
+ "/" + name
, pathname
, FALSE
, err
);
506 res
:= unistd
.unlink(pathname
);
507 IF res
= 0 THEN loc
.res
:= 0 (* no error *)
508 ELSE GetError(loc
.res
)
511 loc
.res
:= 1 (* invalid name *)
514 loc
.res
:= 1 (* invalid name *)
517 loc
.res
:= 1 (* invalid locator *)
521 PROCEDURE (d
: Directory
) Rename (loc
: Files
.Locator
; old
, new
: Files
.Name
; ask
: BOOLEAN);
522 VAR p0
, p1
: NativeName
; res
: stdio
.int
; err
: INTEGER;
524 ASSERT(loc
# NIL, 20);
525 ASSERT(old
# "", 21);
526 ASSERT(new
# "", 22);
528 IF IsName(old
) & IsName(new
) THEN
529 HostLang
.StringToHost(loc
.path
+ "/" + old
, p0
, FALSE
, err
);
531 HostLang
.StringToHost(loc
.path
+ "/" + new
, p1
, FALSE
, err
);
533 res
:= stdio
.rename(p0
, p1
);
534 IF res
= 0 THEN loc
.res
:= 0 (* no error *)
535 ELSE GetError(loc
.res
)
538 loc
.res
:= 1 (* invalid name *)
541 loc
.res
:= 1 (* invalid name *)
544 loc
.res
:= 1 (* invalid name *)
547 loc
.res
:= 1 (* invalid locator *)
551 PROCEDURE (d
: Directory
) SameFile (loc0
: Files
.Locator
; name0
: Files
.Name
; loc1
: Files
.Locator
; name1
: Files
.Name
): BOOLEAN;
552 VAR ok
: BOOLEAN; a0
, a1
: NativeName
; s0
, s1
: sysstat
.struct_stat
; err
: INTEGER;
554 ASSERT(loc0
# NIL, 20);
555 ASSERT(name0
# "", 21);
556 ASSERT(loc1
# NIL, 22);
557 ASSERT(name1
# "", 23);
559 WITH loc0
: Locator
DO
560 WITH loc1
: Locator
DO
561 IF IsName(name0
) & IsName(name1
) THEN
562 HostLang
.StringToHost(loc0
.path
+ "/" + name0
, a0
, FALSE
, err
);
564 err
:= macro
.stat(a0
, s0
);
566 HostLang
.StringToHost(loc1
.path
+ "/" + name1
, a1
, FALSE
, err
);
568 err
:= macro
.stat(a1
, s1
);
570 ok
:= s0
.st_ino
= s1
.st_ino
576 ELSE (* don't trap *)
578 ELSE (* don't trap *)
583 PROCEDURE IsDir (IN s
: sysstat
.struct_stat
): BOOLEAN;
585 RETURN BITS(s
.st_mode
) * BITS(sysstat
.S_IFMT
) = BITS(sysstat
.S_IFDIR
)
588 PROCEDURE GetAttr (IN path
: NativeName
; IN name
: FullName
; s
: sysstat
.struct_stat
): SET;
592 IF name
[0] = "." THEN INCL(attr
, Files
.hidden
) END;
593 IF BITS(s
.st_mode
) * BITS(sysstat
.S_IXOTH
) # {} THEN INCL(attr
, 16) END;
594 IF BITS(s
.st_mode
) * BITS(sysstat
.S_IWOTH
) # {} THEN INCL(attr
, 17) END;
595 IF BITS(s
.st_mode
) * BITS(sysstat
.S_IROTH
) # {} THEN INCL(attr
, 18) END;
596 IF BITS(s
.st_mode
) * BITS(sysstat
.S_IXGRP
) # {} THEN INCL(attr
, 19) END;
597 IF BITS(s
.st_mode
) * BITS(sysstat
.S_IWGRP
) # {} THEN INCL(attr
, 20) END;
598 IF BITS(s
.st_mode
) * BITS(sysstat
.S_IRGRP
) # {} THEN INCL(attr
, 21) END;
599 IF BITS(s
.st_mode
) * BITS(sysstat
.S_IXUSR
) # {} THEN INCL(attr
, 22) END;
600 IF BITS(s
.st_mode
) * BITS(sysstat
.S_IWUSR
) # {} THEN INCL(attr
, 23) END;
601 IF BITS(s
.st_mode
) * BITS(sysstat
.S_IRUSR
) # {} THEN INCL(attr
, 24) END;
602 IF BITS(s
.st_mode
) * BITS(sysstat
.S_ISVTX
) # {} THEN INCL(attr
, 25) END;
603 IF BITS(s
.st_mode
) * BITS(sysstat
.S_ISGID
) # {} THEN INCL(attr
, 26) END;
604 IF BITS(s
.st_mode
) * BITS(sysstat
.S_ISUID
) # {} THEN INCL(attr
, 27) END;
605 (* !!! better to check real access? *)
606 IF BITS(s
.st_mode
) * BITS(sysstat
.S_IRUSR
) # {} THEN INCL(attr
, Files
.readOnly
) END;
610 PROCEDURE (d
: Directory
) FileList (loc
: Files
.Locator
): Files
.FileInfo
;
612 pathname
: NativeName
;
616 ent
: dirent
.Pstruct_dirent
;
617 s
: sysstat
.struct_stat
;
620 h
, t
: Files
.FileInfo
;
622 ASSERT(loc
# NIL, 20);
624 HostLang
.StringToHost(loc
.path
, pathname
, FALSE
, err
);
626 p
:= dirent
.opendir(pathname
);
628 ent
:= dirent
.readdir(p
);
630 HostLang
.HostToString(ent
.d_name
, name
, FALSE
, err
);
632 HostLang
.StringToHost(loc
.path
+ "/" + name
, pathname
, FALSE
, err
);
634 res
:= macro
.stat(pathname
, s
);
635 IF (res
= 0) & ~
IsDir(s
) THEN
636 IF h
= NIL THEN NEW(h
); t
:= h
637 ELSE NEW(t
.next
); t
:= t
.next
640 t
.type
:= ""; (* ??? *)
641 t
.length
:= s
.st_size
;
642 tm
:= time
.localtime(s
.st_mtim
.tv_sec
);
644 t
.modified
.year
:= tm
.tm_year
+ 1900;
645 t
.modified
.month
:= tm
.tm_mon
+ 1;
646 t
.modified
.day
:= tm
.tm_mday
;
647 t
.modified
.hour
:= tm
.tm_hour
;
648 t
.modified
.minute
:= tm
.tm_min
;
649 t
.modified
.second
:= tm
.tm_sec
651 t
.attr
:= GetAttr(pathname
, name
, s
)
655 ent
:= dirent
.readdir(p
)
657 res
:= dirent
.closedir(p
);
658 ASSERT(res
= 0, 100);
659 loc
.res
:= 0 (* no error *)
664 loc
.res
:= 1 (* invalid name *)
667 loc
.res
:= 1 (* invalid locator *)
672 PROCEDURE (d
: Directory
) LocList (loc
: Files
.Locator
): Files
.LocInfo
;
674 pathname
: NativeName
;
678 ent
: dirent
.Pstruct_dirent
;
679 s
: sysstat
.struct_stat
;
684 ASSERT(loc
# NIL, 20);
686 HostLang
.StringToHost(loc
.path
, pathname
, FALSE
, err
);
688 p
:= dirent
.opendir(pathname
);
690 ent
:= dirent
.readdir(p
);
692 HostLang
.HostToString(ent
.d_name
, name
, FALSE
, err
);
694 HostLang
.StringToHost(loc
.path
+ "/" + name
, pathname
, FALSE
, err
);
696 res
:= macro
.stat(pathname
, s
);
697 IF (res
= 0) & IsDir(s
) & (name
# ".") & (name
# "..") THEN
698 IF h
= NIL THEN NEW(h
); t
:= h
699 ELSE NEW(t
.next
); t
:= t
.next
702 t
.attr
:= GetAttr(pathname
, name
, s
)
706 ent
:= dirent
.readdir(p
)
708 res
:= dirent
.closedir(p
);
709 ASSERT(res
= 0, 100);
710 loc
.res
:= 0 (* no error *)
715 loc
.res
:= 1 (* invlid name *)
718 loc
.res
:= 1 (* invalid locator *)
723 PROCEDURE (d
: Directory
) GetFileName (name
: Files
.Name
; type
: Files
.Type
; OUT filename
: Files
.Name
);
725 filename
:= name
+ "." + type
730 (* !!! implement NofFiles *)
731 (* !!! implement GetModDate & GetName *)
733 PROCEDURE SetRootDir
* (x
: ARRAY OF CHAR);
735 root
:= NewLocator(x
)
743 PROCEDURE IgnoreAsk
*;
752 NEW(d
); Files
.SetDir(d
)