Copyright (C) 1994, Digital Equipment Corp.
Portions Copyright 1996, Critical Mass, Inc.
UNSAFE MODULE FSWin32 EXPORTS FS;
IMPORT Ctypes, File, FileWin32, M3toC, OSError, OSErrorWin32, OSWin32,
Pathname, RegularFile, Text, Time, TimeWin32, WinBase, WinDef,
WinError, WinNT, Word;
CONST
False: WinDef.BOOL = 0;
True: WinDef.BOOL = 1;
EXCEPTION InternalError; <* FATAL InternalError *>
PROCEDURE GetAbsolutePathname(p: Pathname.T): Pathname.T
RAISES {OSError.E} =
VAR lpFileName := M3toC.TtoS(p);
PROCEDURE DoIt(VAR chars: ARRAY OF CHAR): WinDef.DWORD
RAISES {OSError.E} =
VAR filePart: WinNT.LPSTR;
BEGIN
WITH n = WinBase.GetFullPathName(
lpFileName := lpFileName,
nBufferLength := NUMBER(chars),
lpBuffer := ADR(chars[0]),
lpFilePart := ADR(filePart)) DO
IF n = 0 THEN OSErrorWin32.Raise() END;
RETURN n
END
END DoIt;
VAR chars: ARRAY [0..63] OF CHAR; n := DoIt(chars);
BEGIN
IF n < NUMBER(chars) THEN
RETURN Text.FromChars(SUBARRAY(chars, 0, n))
END;
WITH refChars = NEW(REF ARRAY OF CHAR, n + 1) DO
n := DoIt(refChars^);
IF n > NUMBER(refChars^) THEN RAISE InternalError END;
RETURN Text.FromChars(SUBARRAY(refChars^, 0, n))
END
END GetAbsolutePathname;
TYPE ABD = ARRAY BOOLEAN OF WinDef.DWORD;
VAR createMode := ARRAY CreateOption OF ABD{
(* truncate = FALSE TRUE *)
(* Never *) ABD{WinBase.OPEN_EXISTING, WinBase.TRUNCATE_EXISTING},
(* Ok *) ABD{WinBase.OPEN_ALWAYS, WinBase.CREATE_ALWAYS },
(* Always *) ABD{WinBase.CREATE_NEW, WinBase.CREATE_NEW }
};
PROCEDURE OpenFile(
p: Pathname.T;
truncate: BOOLEAN := TRUE;
create: CreateOption := CreateOption.Ok;
template: File.T := NIL;
accessOption: AccessOption := AccessOption.Default)
: File.T RAISES {OSError.E} =
VAR
attrs: WinDef.DWORD;
handle, handleTemplate: WinNT.HANDLE;
rsd: REF ARRAY OF WinDef.BYTE;
sd: ARRAY [0..WinNT.SECURITY_DESCRIPTOR_MIN_LENGTH-1] OF WinDef.BYTE;
acl: ARRAY [0..100] OF WinDef.BYTE;
sid: ARRAY [0..100] OF WinDef.BYTE;
nSid: WinDef.DWORD := BYTESIZE(sid);
user, domain: ARRAY [0..80-1] OF CHAR;
nUser: WinDef.DWORD := NUMBER(user);
nDomain: WinDef.DWORD := NUMBER(domain);
use: WinNT.SID_NAME_USE;
sa: WinBase.SECURITY_ATTRIBUTES;
lpsa: WinBase.LPSECURITY_ATTRIBUTES;
BEGIN
IF template # NIL THEN
handleTemplate := template.handle;
attrs := GetFileAttributes(handleTemplate);
rsd := GetFileSecurityDescriptor(p);
IF (rsd = NIL) OR (NUMBER (rsd^) < 1) THEN
(* we must be on Win95... *)
handleTemplate := NIL;
attrs := WinNT.FILE_ATTRIBUTE_NORMAL;
lpsa := NIL;
ELSE
sa.nLength := BYTESIZE(sa);
sa.lpSecurityDescriptor := ADR(rsd[0]);
sa.bInheritHandle := False;
lpsa := ADR(sa)
END;
ELSE
handleTemplate := NIL;
IF OSWin32.Win95() AND accessOption = AccessOption.OnlyOwnerCanRead THEN
(* No "owner" under Win95 - WinBase.InitializeSecurityDescriptor
not implemented *)
accessOption := AccessOption.Default;
END;
CASE accessOption OF
| AccessOption.OnlyOwnerCanRead =>
IF WinBase.InitializeSecurityDescriptor(
pSecurityDescriptor := ADR(sd),
dwRevision := WinNT.SECURITY_DESCRIPTOR_REVISION) = False THEN
OSErrorWin32.Raise()
END;
IF WinBase.InitializeAcl(
pAcl := ADR(acl),
nAclLength := BYTESIZE(acl),
dwAclRevision := WinNT.ACL_REVISION) = False THEN
OSErrorWin32.Raise()
END;
IF WinBase.GetUserName(
lpBuffer := ADR(user[0]),
nSize := ADR(nUser)) = False THEN
OSErrorWin32.Raise()
END;
<* ASSERT nUser <= NUMBER(user) *>
IF WinBase.LookupAccountName(
lpSystemName := NIL, (* local system *)
lpAccountName := ADR(user[0]),
Sid := ADR(sid),
cbSid := ADR(nSid),
ReferencedDomainName := ADR(domain[0]),
cbReferencedDomainName := ADR(nDomain),
peUse := ADR(use)) = False THEN
OSErrorWin32.Raise()
END;
<* ASSERT nSid <= BYTESIZE(sid) *>
IF WinBase.AddAccessAllowedAce(
pAcl := ADR(acl),
dwAceRevision := WinNT.ACL_REVISION,
AccessMask := WinNT.GENERIC_ALL,
pSid := ADR(sid)) = False THEN
OSErrorWin32.Raise()
END;
IF WinBase.SetSecurityDescriptorDacl(
pSecurityDescriptor := ADR(sd),
bDaclPresent := True,
pDacl := ADR(acl),
bDaclDefaulted := False) = False
THEN OSErrorWin32.Raise()
END;
| AccessOption.ReadOnly => attrs := WinNT.FILE_ATTRIBUTE_READONLY;
| AccessOption.Default => attrs := WinNT.FILE_ATTRIBUTE_NORMAL
END;
lpsa := NIL
END;
(* I believe the only reason for passing a non-NIL "hTemplate" to
"CreateFile" is to supply OS/2-style ``extended attributes''
for the file being created. PMcJ 7/3/93 *)
handle := WinBase.CreateFile(
lpFileName := M3toC.TtoS(p),
dwDesiredAccess := WinNT.GENERIC_READ + WinNT.GENERIC_WRITE,
dwShareMode := WinNT.FILE_SHARE_READ + WinNT.FILE_SHARE_WRITE,
lpSecurityAttributes := lpsa,
dwCreationDisposition := createMode[create, truncate],
dwFlagsAndAttributes := attrs,
hTemplateFile := handleTemplate);
IF LOOPHOLE(handle, INTEGER) = WinBase.INVALID_HANDLE_VALUE THEN
OSErrorWin32.Raise()
END;
RETURN FileWin32.New(handle, FileWin32.ReadWrite)
END OpenFile;
PROCEDURE GetFileAttributes(handle: WinNT.HANDLE): WinDef.DWORD
RAISES {OSError.E} =
VAR info: WinBase.BY_HANDLE_FILE_INFORMATION;
BEGIN
IF WinBase.GetFileInformationByHandle(handle, ADR(info)) = False THEN
OSErrorWin32.Raise()
END;
RETURN info.dwFileAttributes;
END GetFileAttributes;
PROCEDURE GetFileSecurityDescriptor(pn: Pathname.T): REF ARRAY OF WinDef.BYTE
RAISES {OSError.E} =
VAR rsd: REF ARRAY OF WinDef.BYTE; n, nNeeded: WinDef.DWORD;
CONST Info = WinNT.OWNER_SECURITY_INFORMATION +
WinNT.GROUP_SECURITY_INFORMATION +
WinNT.DACL_SECURITY_INFORMATION +
WinNT.SACL_SECURITY_INFORMATION;
BEGIN
IF OSWin32.Win95() THEN RETURN NIL END;
(* WinBase.GetFileSecurity not implement in Win95 *)
n := 64;
LOOP
rsd := NEW(REF ARRAY OF WinDef.BYTE, n);
IF WinBase.GetFileSecurity(
lpFileName := M3toC.TtoS(pn),
RequestedInformation := Info,
pSecurityDescriptor := ADR(rsd[0]),
nLength := n,
lpnLengthNeeded := ADR(nNeeded)) = False THEN OSErrorWin32.Raise()
END;
IF nNeeded = 0 THEN EXIT END;
n := nNeeded
END;
RETURN rsd
END GetFileSecurityDescriptor;
PROCEDURE OpenFileReadonly(p: Pathname.T): File.T RAISES {OSError.E}=
VAR handle: WinNT.HANDLE;
BEGIN
handle := WinBase.CreateFile(
lpFileName := M3toC.TtoS(p),
dwDesiredAccess := WinNT.GENERIC_READ,
dwShareMode := WinNT.FILE_SHARE_READ,
lpSecurityAttributes := NIL,
dwCreationDisposition := WinBase.OPEN_EXISTING,
dwFlagsAndAttributes := 0,
hTemplateFile := NIL);
IF LOOPHOLE(handle, INTEGER) = WinBase.INVALID_HANDLE_VALUE THEN
OSErrorWin32.Raise()
END;
RETURN FileWin32.New(handle, FileWin32.Read)
END OpenFileReadonly;
PROCEDURE CreateDirectory(p: Pathname.T) RAISES {OSError.E}=
VAR sa := WinBase.SECURITY_ATTRIBUTES{
nLength := BYTESIZE(WinBase.SECURITY_ATTRIBUTES),
lpSecurityDescriptor := NIL, (* use caller's default *)
bInheritHandle := 0};
BEGIN
IF WinBase.CreateDirectory(M3toC.TtoS(p), ADR(sa)) = False THEN
OSErrorWin32.Raise()
END
END CreateDirectory;
PROCEDURE DeleteDirectory(p: Pathname.T) RAISES {OSError.E}=
BEGIN
IF WinBase.RemoveDirectory(M3toC.TtoS(p)) = False THEN
OSErrorWin32.Raise()
END
END DeleteDirectory;
PROCEDURE DeleteFile(p: Pathname.T) RAISES {OSError.E}=
BEGIN
IF WinBase.DeleteFile(M3toC.TtoS(p)) = False THEN
OSErrorWin32.Raise()
END
END DeleteFile;
PROCEDURE Rename(p0, p1: Pathname.T) RAISES {OSError.E} =
VAR err: INTEGER;
BEGIN
IF WinBase.MoveFileEx(M3toC.TtoS(p0), M3toC.TtoS(p1),
WinBase.MOVEFILE_REPLACE_EXISTING) = 0 THEN
err := WinBase.GetLastError();
IF (err = WinError.ERROR_CALL_NOT_IMPLEMENTED) THEN
(* MoveFileEx is not implemented on Win95 *)
IF WinBase.MoveFile(M3toC.TtoS(p0), M3toC.TtoS(p1)) = 0 THEN
OSErrorWin32.Raise();
END;
RETURN;
END;
OSErrorWin32.Raise0(err)
END
END Rename;
REVEAL Iterator = PublicIterator BRANDED OBJECT
handle: WinNT.HANDLE;
done := FALSE;
first := TRUE;
ffd: WinBase.WIN32_FIND_DATA
OVERRIDES
next := IterNext;
nextWithStatus := IterNextWithStatus;
close := IterClose
END;
PROCEDURE Iterate(p: Pathname.T): Iterator RAISES {OSError.E} =
VAR
iter := NEW(Iterator);
allFiles := p & "\\*";
handle := WinBase.FindFirstFile(M3toC.TtoS(allFiles), ADR(iter.ffd));
BEGIN
IF LOOPHOLE(handle, INTEGER) = WinBase.INVALID_HANDLE_VALUE THEN
OSErrorWin32.Raise()
END;
iter.handle := handle;
RETURN iter;
END Iterate;
PROCEDURE IterNext(iter: Iterator; VAR (*out*) name: TEXT): BOOLEAN =
VAR s: Ctypes.char_star;
BEGIN
IF IterRaw(iter, s) THEN name := M3toC.CopyStoT(s); RETURN TRUE END;
RETURN FALSE
END IterNext;
PROCEDURE IterNextWithStatus(
iter: Iterator;
VAR (*out*) name: TEXT;
VAR (*out*) status: File.Status)
: BOOLEAN =
VAR s: Ctypes.char_star;
BEGIN
IF IterRaw(iter, s) THEN
name := M3toC.CopyStoT(s);
BuildStatus (iter.ffd, status);
RETURN TRUE
END;
RETURN FALSE
END IterNextWithStatus;
EXCEPTION IterClosed; <* FATAL IterClosed *>
PROCEDURE IterRaw(iter: Iterator; VAR (*out*) s: Ctypes.char_star): BOOLEAN =
BEGIN
LOOP (* to ignore "." and ".." *)
IF iter.done THEN RAISE IterClosed END;
IF iter.handle = NIL THEN RETURN FALSE END;
IF iter.first THEN iter.first := FALSE;
ELSE
WITH rc = WinBase.FindNextFile(iter.handle, ADR(iter.ffd)) DO
IF rc = 0 THEN
WITH e = WinBase.GetLastError() DO
IF e = WinError.ERROR_NO_MORE_FILES THEN
EVAL WinBase.FindClose(iter.handle);
iter.handle := NIL;
RETURN FALSE
ELSE
<* FATAL OSError.E *> BEGIN OSErrorWin32.Raise() END
END
END
END
END;
s := ADR(iter.ffd.cFileName);
IF NOT DotOrDotDot(LOOPHOLE(s, UNTRACED REF CHAR)) THEN
RETURN TRUE
END
(* else continue to next entry *)
END
END
END IterRaw;
PROCEDURE IterClose(iter: Iterator) =
BEGIN
IF iter.handle # NIL THEN
EVAL WinBase.FindClose(iter.handle); iter.handle := NIL
END;
iter.done := TRUE
END IterClose;
PROCEDURE DotOrDotDot(n: UNTRACED REF CHAR): BOOLEAN =
BEGIN
IF n^ # '.' THEN RETURN FALSE END;
INC(n);
IF n^ = '\000' THEN RETURN TRUE; (* "." *)
ELSIF n^ # '.' THEN RETURN FALSE (* ".x" *)
END;
INC(n);
RETURN n^ = '\000' (* ".." or "..x" *)
END DotOrDotDot;
PROCEDURE Status(p: Pathname.T): File.Status RAISES {OSError.E} =
VAR
ffd : WinBase.WIN32_FIND_DATA;
stat : File.Status;
handle := WinBase.FindFirstFile(M3toC.TtoS(p), ADR(ffd));
BEGIN
IF LOOPHOLE(handle, INTEGER) = WinBase.INVALID_HANDLE_VALUE THEN
OSErrorWin32.Raise()
END;
BuildStatus (ffd, stat);
RETURN stat;
END Status;
PROCEDURE BuildStatus (READONLY ffd : WinBase.WIN32_FIND_DATA;
VAR(*OUT*) stat : File.Status) =
BEGIN
stat.size := ffd.nFileSizeLow;
stat.modificationTime := TimeWin32.FromFileTime(ffd.ftLastWriteTime);
IF Word.And(ffd.dwFileAttributes, WinNT.FILE_ATTRIBUTE_DIRECTORY) # 0
THEN stat.type := DirectoryFileType;
ELSE stat.type := RegularFile.FileType; (* more or less... *)
END;
END BuildStatus;
PROCEDURE SetModificationTime(p: Pathname.T; READONLY t: Time.T)
RAISES {OSError.E} =
VAR h: File.T; lastWrite := TimeWin32.ToFileTime(t);
BEGIN
h := OpenFileReadonly(p);
TRY
IF WinBase.SetFileTime(
hFile := h.handle,
lpCreationTime := NIL,
lpLastAccessTime := NIL,
lpLastWriteTime := ADR(lastWrite)) = 0 THEN OSErrorWin32.Raise()
END
FINALLY h.close()
END
END SetModificationTime;
BEGIN
END FSWin32.